diff --git a/servant-docs/servant-docs.cabal b/servant-docs/servant-docs.cabal index ee6f71bf..b88bc612 100644 --- a/servant-docs/servant-docs.cabal +++ b/servant-docs/servant-docs.cabal @@ -29,8 +29,11 @@ library exposed-modules: Servant.Docs , Servant.Docs.Internal + , Servant.Docs.Internal.Pretty build-depends: base >=4.7 && <5 + , aeson + , aeson-pretty , bytestring , bytestring-conversion , case-insensitive diff --git a/servant-docs/src/Servant/Docs.hs b/servant-docs/src/Servant/Docs.hs index 2f081127..193b4e60 100644 --- a/servant-docs/src/Servant/Docs.hs +++ b/servant-docs/src/Servant/Docs.hs @@ -23,7 +23,7 @@ -- See example/greet.hs for an example. module Servant.Docs ( -- * 'HasDocs' class and key functions - HasDocs(..), docs, markdown + HasDocs(..), docs, pretty, markdown -- * Generating docs with extra information , docsWith, docsWithIntros, docsWithOptions , ExtraInfo(..), extraInfo @@ -53,4 +53,5 @@ module Servant.Docs , single ) where -import Servant.Docs.Internal +import Servant.Docs.Internal +import Servant.Docs.Internal.Pretty diff --git a/servant-docs/src/Servant/Docs/Internal/Pretty.hs b/servant-docs/src/Servant/Docs/Internal/Pretty.hs new file mode 100644 index 00000000..7de722be --- /dev/null +++ b/servant-docs/src/Servant/Docs/Internal/Pretty.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} + +module Servant.Docs.Internal.Pretty where + +import Data.Aeson (ToJSON(..)) +import Data.Aeson.Encode.Pretty (encodePretty) +import Data.Proxy (Proxy(Proxy)) +import Network.HTTP.Media ((//)) +import Servant.API +import Servant.API.ContentTypes +import Servant.Utils.Links + +-- | PrettyJSON content type. +data PrettyJSON + +instance Accept PrettyJSON where + contentType _ = "application" // "json" + +instance ToJSON a => MimeRender PrettyJSON a where + mimeRender _ = encodePretty + +-- | Prettify generated JSON documentation. +-- +-- @ +-- 'docs' ('pretty' ('Proxy' :: 'Proxy' MyAPI)) +-- @ +pretty :: Proxy layout -> Proxy (Pretty layout) +pretty Proxy = Proxy + +-- | Replace all JSON content types with PrettyJSON. +-- Kind-polymorphic so it can operate on kinds @*@ and @[*]@. +type family Pretty (layout :: k) :: k where + Pretty (x :<|> y) = Pretty x :<|> Pretty y + Pretty (x :> y) = Pretty x :> Pretty y + Pretty (Get cs r) = Get (Pretty cs) r + Pretty (Post cs r) = Post (Pretty cs) r + Pretty (Put cs r) = Put (Pretty cs) r + Pretty (Delete cs r) = Delete (Pretty cs) r + Pretty (Patch cs r) = Patch (Pretty cs) r + Pretty (ReqBody cs r) = ReqBody (Pretty cs) r + Pretty (JSON ': xs) = PrettyJSON ': xs + Pretty (x ': xs) = x ': Pretty xs + Pretty x = x