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