git.iko.soy/typeable/servant
on master help sign in
Move 'pretty' to its own module
commitf1a6a2a151cd178f36569c3212e8fcf89591a59a authorMitchell Rosen <mitchellwrosen@gmail.com> dateThu 10 Dec 2015, 12:27 (11 years ago) parent702c2ce
4 files changed+53−34
compare with master
unifiedsplit
servant-docs/servant-docs.cabal+1 servant-docs/src/Servant/Docs.hs+2−1 servant-docs/src/Servant/Docs/Internal.hs−33 servant-docs/src/Servant/Docs/Internal/Pretty.hs+50
servant-docs/servant-docs.cabal+1
@@ -29,6 +29,7 @@ library
2929 exposed-modules:
3030 Servant.Docs
3131 , Servant.Docs.Internal
32+ , Servant.Docs.Internal.Pretty
3233 build-depends:
3334 base >=4.7 && <5
3435 , aeson
servant-docs/src/Servant/Docs.hs+2−1
@@ -53,4 +53,5 @@ module Servant.Docs
5353 , single
5454 ) where
5555
56−import Servant.Docs.Internal
56+import Servant.Docs.Internal
57+import Servant.Docs.Internal.Pretty
servant-docs/src/Servant/Docs/Internal.hs−33
@@ -26,8 +26,6 @@ import Control.Arrow (second)
2626import Control.Lens (makeLenses, over, traversed, (%~),
2727 (&), (.~), (<>~), (^.), (|>))
2828import qualified Control.Monad.Omega as Omega
29−import Data.Aeson (ToJSON(..))
30−import Data.Aeson.Encode.Pretty (encodePretty)
3129import Data.ByteString.Conversion (ToByteString, toByteString)
3230import Data.ByteString.Lazy.Char8 (ByteString)
3331import qualified Data.CaseInsensitive as CI
@@ -369,37 +367,6 @@ docsWith opts intros (ExtraInfo endpoints) p =
369367docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
370368docsWithIntros intros = docsWith defaultDocOptions intros mempty
371369
372−-- | Prettify generated JSON documentation.
373−--
374−-- @
375−-- 'docs' ('pretty' ('Proxy' :: 'Proxy' MyAPI))
376−-- @
377−pretty :: Proxy layout -> Proxy (Pretty layout)
378−pretty Proxy = Proxy
379−
380−data PrettyJSON
381−
382−instance Accept PrettyJSON where
383− contentType _ = "application" M.// "json"
384−
385−instance ToJSON a => MimeRender PrettyJSON a where
386− mimeRender _ = encodePretty
387−
388−-- | Replace all JSON content types with PrettyJSON.
389−-- Kind-polymorphic so it can operate on kinds * and [*].
390−type family Pretty (layout :: k) :: k where
391− Pretty (x :<|> y) = Pretty x :<|> Pretty y
392− Pretty (x :> y) = Pretty x :> Pretty y
393− Pretty (Get cs r) = Get (Pretty cs) r
394− Pretty (Post cs r) = Post (Pretty cs) r
395− Pretty (Put cs r) = Put (Pretty cs) r
396− Pretty (Delete cs r) = Delete (Pretty cs) r
397− Pretty (Patch cs r) = Patch (Pretty cs) r
398− Pretty (ReqBody cs r) = ReqBody (Pretty cs) r
399− Pretty (JSON ': xs) = PrettyJSON ': xs
400− Pretty (x ': xs) = x ': Pretty xs
401− Pretty x = x
402−
403370-- | The class that abstracts away the impact of API combinators
404371-- on documentation generation.
405372class HasDocs layout where
servant-docs/src/Servant/Docs/Internal/Pretty.hsnew file+50
@@ -0,0 +1,50 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE KindSignatures #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE PolyKinds #-}
7+{-# LANGUAGE TypeOperators #-}
8+{-# LANGUAGE TypeFamilies #-}
9+
10+module Servant.Docs.Internal.Pretty where
11+
12+import Data.Aeson (ToJSON(..))
13+import Data.Aeson.Encode.Pretty (encodePretty)
14+import Data.Proxy (Proxy(Proxy))
15+import Network.HTTP.Media ((//))
16+import Servant.API
17+import Servant.API.ContentTypes
18+import Servant.Utils.Links
19+
20+-- | PrettyJSON content type.
21+data PrettyJSON
22+
23+instance Accept PrettyJSON where
24+ contentType _ = "application" // "json"
25+
26+instance ToJSON a => MimeRender PrettyJSON a where
27+ mimeRender _ = encodePretty
28+
29+-- | Prettify generated JSON documentation.
30+--
31+-- @
32+-- 'docs' ('pretty' ('Proxy' :: 'Proxy' MyAPI))
33+-- @
34+pretty :: Proxy layout -> Proxy (Pretty layout)
35+pretty Proxy = Proxy
36+
37+-- | Replace all JSON content types with PrettyJSON.
38+-- Kind-polymorphic so it can operate on kinds @*@ and @[*]@.
39+type family Pretty (layout :: k) :: k where
40+ Pretty (x :<|> y) = Pretty x :<|> Pretty y
41+ Pretty (x :> y) = Pretty x :> Pretty y
42+ Pretty (Get cs r) = Get (Pretty cs) r
43+ Pretty (Post cs r) = Post (Pretty cs) r
44+ Pretty (Put cs r) = Put (Pretty cs) r
45+ Pretty (Delete cs r) = Delete (Pretty cs) r
46+ Pretty (Patch cs r) = Patch (Pretty cs) r
47+ Pretty (ReqBody cs r) = ReqBody (Pretty cs) r
48+ Pretty (JSON ': xs) = PrettyJSON ': xs
49+ Pretty (x ': xs) = x ': Pretty xs
50+ Pretty x = x