From f1a6a2a151cd178f36569c3212e8fcf89591a59a Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Thu, 10 Dec 2015 12:27:15 -0800
Subject: [PATCH] Move 'pretty' to its own module

---
 servant-docs/servant-docs.cabal               |  1 +
 servant-docs/src/Servant/Docs.hs              |  3 +-
 servant-docs/src/Servant/Docs/Internal.hs     | 33 ------------
 .../src/Servant/Docs/Internal/Pretty.hs       | 50 +++++++++++++++++++
 4 files changed, 53 insertions(+), 34 deletions(-)
 create mode 100644 servant-docs/src/Servant/Docs/Internal/Pretty.hs

diff --git a/servant-docs/servant-docs.cabal b/servant-docs/servant-docs.cabal
index 7f1f0025..b88bc612 100644
--- a/servant-docs/servant-docs.cabal
+++ b/servant-docs/servant-docs.cabal
@@ -29,6 +29,7 @@ library
   exposed-modules:
       Servant.Docs
     , Servant.Docs.Internal
+    , Servant.Docs.Internal.Pretty
   build-depends:
       base >=4.7 && <5
     , aeson
diff --git a/servant-docs/src/Servant/Docs.hs b/servant-docs/src/Servant/Docs.hs
index a14a4f34..193b4e60 100644
--- a/servant-docs/src/Servant/Docs.hs
+++ b/servant-docs/src/Servant/Docs.hs
@@ -53,4 +53,5 @@ module Servant.Docs
   , single
   ) where
 
-import           Servant.Docs.Internal
+import Servant.Docs.Internal
+import Servant.Docs.Internal.Pretty
diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs
index 4b79e9f2..33cb86a0 100644
--- a/servant-docs/src/Servant/Docs/Internal.hs
+++ b/servant-docs/src/Servant/Docs/Internal.hs
@@ -26,8 +26,6 @@ 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
@@ -369,37 +367,6 @@ 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
diff --git a/servant-docs/src/Servant/Docs/Internal/Pretty.hs b/servant-docs/src/Servant/Docs/Internal/Pretty.hs
new file mode 100644
index 00000000..7de722be
--- /dev/null
+++ b/servant-docs/src/Servant/Docs/Internal/Pretty.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE PolyKinds             #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE TypeFamilies          #-}
+
+module Servant.Docs.Internal.Pretty where
+
+import Data.Aeson               (ToJSON(..))
+import Data.Aeson.Encode.Pretty (encodePretty)
+import Data.Proxy               (Proxy(Proxy))
+import Network.HTTP.Media       ((//))
+import Servant.API
+import Servant.API.ContentTypes
+import Servant.Utils.Links
+
+-- | PrettyJSON content type.
+data PrettyJSON
+
+instance Accept PrettyJSON where
+    contentType _ = "application" // "json"
+
+instance ToJSON a => MimeRender PrettyJSON a where
+    mimeRender _ = encodePretty
+
+-- | Prettify generated JSON documentation.
+--
+-- @
+-- 'docs' ('pretty' ('Proxy' :: 'Proxy' MyAPI))
+-- @
+pretty :: Proxy layout -> Proxy (Pretty layout)
+pretty Proxy = Proxy
+
+-- | 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