Move 'pretty' to its own module

This commit is contained in:
Mitchell Rosen 2015-12-10 12:27:15 -08:00
parent 702c2cec7d
commit f1a6a2a151
4 changed files with 53 additions and 34 deletions

View file

@ -29,6 +29,7 @@ library
exposed-modules:
Servant.Docs
, Servant.Docs.Internal
, Servant.Docs.Internal.Pretty
build-depends:
base >=4.7 && <5
, aeson

View file

@ -54,3 +54,4 @@ module Servant.Docs
) where
import Servant.Docs.Internal
import Servant.Docs.Internal.Pretty

View file

@ -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

View 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