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
build-depends:
base >=4.7 && <5
, aeson
, aeson-pretty
, bytestring
, bytestring-conversion
, case-insensitive

View file

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

View file

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