From 702c2cec7d297e42f680697c61ecdfa01a0dff3a Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Wed, 9 Dec 2015 18:04:47 -0800
Subject: [PATCH] Add 'pretty'

---
 servant-docs/servant-docs.cabal           |  2 ++
 servant-docs/src/Servant/Docs.hs          |  2 +-
 servant-docs/src/Servant/Docs/Internal.hs | 33 +++++++++++++++++++++++
 3 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/servant-docs/servant-docs.cabal b/servant-docs/servant-docs.cabal
index ee6f71bf..7f1f0025 100644
--- a/servant-docs/servant-docs.cabal
+++ b/servant-docs/servant-docs.cabal
@@ -31,6 +31,8 @@ library
     , Servant.Docs.Internal
   build-depends:
       base >=4.7 && <5
+    , aeson
+    , aeson-pretty
     , bytestring
     , bytestring-conversion
     , case-insensitive
diff --git a/servant-docs/src/Servant/Docs.hs b/servant-docs/src/Servant/Docs.hs
index 2f081127..a14a4f34 100644
--- a/servant-docs/src/Servant/Docs.hs
+++ b/servant-docs/src/Servant/Docs.hs
@@ -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
diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs
index 33cb86a0..4b79e9f2 100644
--- a/servant-docs/src/Servant/Docs/Internal.hs
+++ b/servant-docs/src/Servant/Docs/Internal.hs
@@ -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