Move 'pretty' to its own module
This commit is contained in:
parent
702c2cec7d
commit
f1a6a2a151
4 changed files with 53 additions and 34 deletions
|
@ -29,6 +29,7 @@ library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Servant.Docs
|
Servant.Docs
|
||||||
, Servant.Docs.Internal
|
, Servant.Docs.Internal
|
||||||
|
, Servant.Docs.Internal.Pretty
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.7 && <5
|
base >=4.7 && <5
|
||||||
, aeson
|
, aeson
|
||||||
|
|
|
@ -53,4 +53,5 @@ module Servant.Docs
|
||||||
, single
|
, single
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Servant.Docs.Internal
|
import Servant.Docs.Internal
|
||||||
|
import Servant.Docs.Internal.Pretty
|
||||||
|
|
|
@ -26,8 +26,6 @@ import Control.Arrow (second)
|
||||||
import Control.Lens (makeLenses, over, traversed, (%~),
|
import Control.Lens (makeLenses, over, traversed, (%~),
|
||||||
(&), (.~), (<>~), (^.), (|>))
|
(&), (.~), (<>~), (^.), (|>))
|
||||||
import qualified Control.Monad.Omega as Omega
|
import qualified Control.Monad.Omega as Omega
|
||||||
import Data.Aeson (ToJSON(..))
|
|
||||||
import Data.Aeson.Encode.Pretty (encodePretty)
|
|
||||||
import Data.ByteString.Conversion (ToByteString, toByteString)
|
import Data.ByteString.Conversion (ToByteString, toByteString)
|
||||||
import Data.ByteString.Lazy.Char8 (ByteString)
|
import Data.ByteString.Lazy.Char8 (ByteString)
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
|
@ -369,37 +367,6 @@ docsWith opts intros (ExtraInfo endpoints) p =
|
||||||
docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
|
docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
|
||||||
docsWithIntros intros = docsWith defaultDocOptions intros mempty
|
docsWithIntros intros = docsWith defaultDocOptions intros mempty
|
||||||
|
|
||||||
-- | Prettify generated JSON documentation.
|
|
||||||
--
|
|
||||||
-- @
|
|
||||||
-- 'docs' ('pretty' ('Proxy' :: 'Proxy' MyAPI))
|
|
||||||
-- @
|
|
||||||
pretty :: Proxy layout -> Proxy (Pretty layout)
|
|
||||||
pretty Proxy = Proxy
|
|
||||||
|
|
||||||
data PrettyJSON
|
|
||||||
|
|
||||||
instance Accept PrettyJSON where
|
|
||||||
contentType _ = "application" M.// "json"
|
|
||||||
|
|
||||||
instance ToJSON a => MimeRender PrettyJSON a where
|
|
||||||
mimeRender _ = encodePretty
|
|
||||||
|
|
||||||
-- | 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
|
|
||||||
|
|
||||||
-- | The class that abstracts away the impact of API combinators
|
-- | The class that abstracts away the impact of API combinators
|
||||||
-- on documentation generation.
|
-- on documentation generation.
|
||||||
class HasDocs layout where
|
class HasDocs layout where
|
||||||
|
|
50
servant-docs/src/Servant/Docs/Internal/Pretty.hs
Normal file
50
servant-docs/src/Servant/Docs/Internal/Pretty.hs
Normal file
|
@ -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
|
Loading…
Reference in a new issue