Add 'pretty'

This commit is contained in:
Mitchell Rosen 2015-12-09 18:04:47 -08:00
parent 69c9ca437a
commit 702c2cec7d
3 changed files with 36 additions and 1 deletions

View file

@ -31,6 +31,8 @@ library
, Servant.Docs.Internal , Servant.Docs.Internal
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, aeson
, aeson-pretty
, bytestring , bytestring
, bytestring-conversion , bytestring-conversion
, case-insensitive , case-insensitive

View file

@ -23,7 +23,7 @@
-- See example/greet.hs for an example. -- See example/greet.hs for an example.
module Servant.Docs module Servant.Docs
( -- * 'HasDocs' class and key functions ( -- * 'HasDocs' class and key functions
HasDocs(..), docs, markdown HasDocs(..), docs, pretty, markdown
-- * Generating docs with extra information -- * Generating docs with extra information
, docsWith, docsWithIntros, docsWithOptions , docsWith, docsWithIntros, docsWithOptions
, ExtraInfo(..), extraInfo , ExtraInfo(..), extraInfo

View file

@ -26,6 +26,8 @@ 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
@ -367,6 +369,37 @@ 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