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:
|
||||
Servant.Docs
|
||||
, Servant.Docs.Internal
|
||||
, Servant.Docs.Internal.Pretty
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
, aeson
|
||||
|
|
|
@ -54,3 +54,4 @@ module Servant.Docs
|
|||
) where
|
||||
|
||||
import Servant.Docs.Internal
|
||||
import Servant.Docs.Internal.Pretty
|
||||
|
|
|
@ -26,8 +26,6 @@ import Control.Arrow (second)
|
|||
import Control.Lens (makeLenses, over, traversed, (%~),
|
||||
(&), (.~), (<>~), (^.), (|>))
|
||||
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.Lazy.Char8 (ByteString)
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
@ -369,37 +367,6 @@ docsWith opts intros (ExtraInfo endpoints) p =
|
|||
docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
|
||||
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
|
||||
-- on documentation generation.
|
||||
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