From 7fa44d3769059769b34d79cb34c65ecae521f834 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Thu, 27 Nov 2014 18:28:01 +0100
Subject: [PATCH 01/54] first shot at splitting servant into servant,
 servant-client and servant-docs

---
 example/greet.hs    |  62 +++++
 servant-docs.cabal  |  37 +++
 src/Servant/Docs.hs | 588 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 687 insertions(+)
 create mode 100644 example/greet.hs
 create mode 100644 servant-docs.cabal
 create mode 100644 src/Servant/Docs.hs

diff --git a/example/greet.hs b/example/greet.hs
new file mode 100644
index 00000000..aac8052b
--- /dev/null
+++ b/example/greet.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+import Data.Aeson
+import Data.Text
+import GHC.Generics
+import Servant
+import Servant.Docs
+
+-- * Example
+
+-- | A greet message data type
+newtype Greet = Greet { msg :: Text }
+  deriving (Generic, Show)
+
+instance FromJSON Greet
+instance ToJSON Greet
+
+-- We add some useful annotations to our captures,
+-- query parameters and request body to make the docs
+-- really helpful.
+instance ToCapture (Capture "name" Text) where
+  toCapture _ = DocCapture "name" "name of the person to greet"
+
+instance ToCapture (Capture "greetid" Text) where
+  toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
+
+instance ToParam (QueryParam "capital" Bool) where
+  toParam _ =
+    DocQueryParam "capital"
+                  ["true", "false"]
+                  "Get the greeting message in uppercase (true) or not (false). Default is false."
+                  Normal
+
+instance ToSample Greet where
+  toSample = Just $ Greet "Hello, haskeller!"
+
+-- API specification
+type TestApi =
+       -- GET /hello/:name?capital={true, false}  returns a Greet as JSON
+       "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
+
+       -- POST /greet with a Greet as JSON in the request body,
+       --             returns a Greet as JSON
+  :<|> "greet" :> ReqBody Greet :> Post Greet
+
+       -- DELETE /greet/:greetid
+  :<|> "greet" :> Capture "greetid" Text :> Delete
+
+testApi :: Proxy TestApi
+testApi = Proxy
+
+-- Generate the data that lets us have API docs. This
+-- is derived from the type as well as from
+-- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
+docsGreet :: API
+docsGreet = docs testApi
+
+main :: IO ()
+main = putStrLn $ markdown docsGreet
\ No newline at end of file
diff --git a/servant-docs.cabal b/servant-docs.cabal
new file mode 100644
index 00000000..473eda11
--- /dev/null
+++ b/servant-docs.cabal
@@ -0,0 +1,37 @@
+name:                servant-docs
+version:             0.2
+-- synopsis:
+-- description:
+license:             BSD3
+license-file:        LICENSE
+author:              Alp Mestanogullari, Sönke Hahn, Julian K. Arni
+maintainer:          alpmestan@gmail.com
+copyright:           2014 Zalora South East Asia Pte Ltd
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.10
+tested-with:         GHC >= 7.8
+
+library
+  exposed-modules:
+    Servant.Docs
+  build-depends:
+      base >=4.7 && <5
+    , aeson
+    , bytestring
+    , hashable
+    , lens
+    , servant
+    , string-conversions
+    , system-filepath
+    , unordered-containers
+  hs-source-dirs: src
+  default-language: Haskell2010
+  ghc-options: -O0 -Wall
+
+executable greet-docs
+  main-is: greet.hs
+  hs-source-dirs: example
+  ghc-options: -O0 -Wall
+  build-depends: base, aeson, servant, servant-docs, text
+  default-language: Haskell2010
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
new file mode 100644
index 00000000..f8e08c83
--- /dev/null
+++ b/src/Servant/Docs.hs
@@ -0,0 +1,588 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-------------------------------------------------------------------------------
+-- | This module lets you get API docs for free. It lets generate
+-- an 'API' from the type that represents your API using 'docs':
+--
+-- @docs :: 'HasDocs' api => 'Proxy' api -> 'API'@
+--
+-- You can then call 'markdown' on it:
+--
+-- @markdown :: 'API' -> String@
+--
+-- or define a custom pretty printer:
+--
+-- @yourPrettyDocs :: 'API' -> String -- or blaze-html's HTML, or ...@
+--
+-- The only thing you'll need to do will be to implement some classes
+-- for your captures, get parameters and request or response bodies.
+--
+-- Here's a little (but complete) example that you can run to see the
+-- markdown pretty printer in action:
+--
+-- > {-# LANGUAGE DataKinds #-}
+-- > {-# LANGUAGE PolyKinds #-}
+-- > {-# LANGUAGE TypeFamilies #-}
+-- > {-# LANGUAGE DeriveGeneric #-}
+-- > {-# LANGUAGE TypeOperators #-}
+-- > {-# LANGUAGE FlexibleInstances #-}
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- >
+-- > import Data.Proxy
+-- > import Data.Text
+-- > import Servant
+-- >
+-- > -- our type for a Greeting message
+-- > data Greet = Greet { _msg :: Text }
+-- >   deriving (Generic, Show)
+-- >
+-- > -- we get our JSON serialization for free
+-- > instance FromJSON Greet
+-- > instance ToJSON Greet
+-- >
+-- > -- we provide a sample value for the 'Greet' type
+-- > instance ToSample Greet where
+-- >   toSample = Just g
+-- >
+-- >     where g = Greet "Hello, haskeller!"
+-- >
+-- > instance ToParam (QueryParam "capital" Bool) where
+-- >   toParam _ =
+-- >     DocQueryParam "capital"
+-- >                   ["true", "false"]
+-- >                   "Get the greeting message in uppercase (true) or not (false). Default is false."
+-- >
+-- > instance ToCapture (Capture "name" Text) where
+-- >   toCapture _ = DocCapture "name" "name of the person to greet"
+-- >
+-- > instance ToCapture (Capture "greetid" Text) where
+-- >   toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
+-- >
+-- > -- API specification
+-- > type TestApi =
+-- >        "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
+-- >   :<|> "greet" :> RQBody Greet :> Post Greet
+-- >   :<|> "delete" :> Capture "greetid" Text :> Delete
+-- >
+-- > testApi :: Proxy TestApi
+-- > testApi = Proxy
+-- >
+-- > -- Generate the Documentation's ADT
+-- > greetDocs :: API
+-- > greetDocs = docs testApi
+-- >
+-- > main :: IO ()
+-- > main = putStrLn $ markdown greetDocs
+module Servant.Docs
+  ( -- * 'HasDocs' class and key functions
+    HasDocs(..), docs, markdown
+
+  {- , -- * Serving the documentation
+    serveDocumentation -}
+
+  , -- * Classes you need to implement for your types
+    ToSample(..)
+  , sampleByteString
+  , ToParam(..)
+  , ToCapture(..)
+
+  , -- * ADTs to represent an 'API'
+    Method(..)
+  , Endpoint, path, method, defEndpoint
+  , API, emptyAPI
+  , DocCapture(..), capSymbol, capDesc
+  , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
+  , Response, respStatus, respBody, defResponse
+  , Action, captures, params, rqbody, response, defAction
+  , single
+
+  , -- * Useful modules when defining your doc printers
+    module Control.Lens
+  , module Data.Monoid
+  ) where
+
+import Control.Lens hiding (Action)
+import Data.Aeson
+import Data.ByteString.Lazy.Char8 (ByteString)
+import Data.Hashable
+import Data.HashMap.Strict (HashMap)
+import Data.List
+import Data.Monoid
+import Data.Proxy
+import Data.String.Conversions
+import GHC.Generics
+import GHC.TypeLits
+import Servant
+
+import qualified Data.HashMap.Strict as HM
+
+-- | Supported HTTP request methods
+data Method = DocDELETE -- ^ the DELETE method
+            | DocGET    -- ^ the GET method
+            | DocPOST   -- ^ the POST method
+            | DocPUT    -- ^ the PUT method
+  deriving (Eq, Generic)
+
+instance Show Method where
+  show DocGET = "GET"
+  show DocPOST = "POST"
+  show DocDELETE = "DELETE"
+  show DocPUT = "PUT"
+
+instance Hashable Method
+
+-- | An 'Endpoint' type that holds the 'path' and the 'method'.
+--
+-- Gets used as the key in the 'API' hashmap. Modify 'defEndpoint'
+-- or any 'Endpoint' value you want using the 'path' and 'method'
+-- lenses to tweak.
+--
+-- @
+-- λ> 'defEndpoint'
+-- GET /
+-- λ> 'defEndpoint' & 'path' '<>~' "foo"
+-- GET /foo
+-- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST'
+-- POST /foo
+-- @
+data Endpoint = Endpoint
+  { _path   :: String -- type collected
+  , _method :: Method -- type collected
+  } deriving (Eq, Generic)
+
+instance Show Endpoint where
+  show (Endpoint p m) =
+    show m ++ " " ++ p
+
+-- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'
+--
+-- Here's how you can modify it:
+--
+-- @
+-- λ> 'defEndpoint'
+-- GET /
+-- λ> 'defEndpoint' & 'path' '<>~' "foo"
+-- GET /foo
+-- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST'
+-- POST /foo
+-- @
+defEndpoint :: Endpoint
+defEndpoint = Endpoint "/" DocGET
+
+instance Hashable Endpoint
+
+-- | Our API type, a good old hashmap from 'Endpoint' to 'Action'
+type API = HashMap Endpoint Action
+
+-- | An empty 'API'
+emptyAPI :: API
+emptyAPI = HM.empty
+
+-- | A type to represent captures. Holds the name of the capture
+--   and a description.
+--
+-- Write a 'ToCapture' instance for your captured types.
+data DocCapture = DocCapture
+  { _capSymbol :: String -- type supplied
+  , _capDesc   :: String -- user supplied
+  } deriving (Eq, Show)
+
+-- | A type to represent a /GET/ parameter from the Query String. Holds its name,
+--   the possible values (leave empty if there isn't a finite number of them),
+--   and a description of how it influences the output or behavior.
+--
+-- Write a 'ToParam' instance for your GET parameter types
+data DocQueryParam = DocQueryParam
+  { _paramName   :: String   -- type supplied
+  , _paramValues :: [String] -- user supplied
+  , _paramDesc   :: String   -- user supplied
+  , _paramKind   :: ParamKind
+  } deriving (Eq, Show)
+
+-- | Type of GET parameter:
+--
+-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
+-- - List corresponds to @QueryParams@, i.e GET parameters with multiple values
+-- - Flag corresponds to @QueryFlag@, i.e a value-less GET parameter
+data ParamKind = Normal | List | Flag
+  deriving (Eq, Show)
+
+-- | A type to represent an HTTP response. Has an 'Int' status and
+-- a 'Maybe ByteString' response body. Tweak 'defResponse' using
+-- the 'respStatus' and 'respBody' lenses if you want.
+--
+-- If you want to respond with a non-empty response body, you'll most likely
+-- want to write a 'ToSample' instance for the type that'll be represented
+-- as some JSON in the response.
+--
+-- Can be tweaked with two lenses.
+--
+-- > λ> defResponse
+-- > Response {_respStatus = 200, _respBody = Nothing}
+-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
+-- > Response {_respStatus = 204, _respBody = Just "[]"}
+data Response = Response
+  { _respStatus :: Int
+  , _respBody   :: Maybe ByteString
+  } deriving (Eq, Show)
+
+-- | Default response: status code 200, no response body.
+--
+-- Can be tweaked with two lenses.
+--
+-- > λ> defResponse
+-- > Response {_respStatus = 200, _respBody = Nothing}
+-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
+-- > Response {_respStatus = 204, _respBody = Just "[]"}
+defResponse :: Response
+defResponse = Response 200 Nothing
+
+-- | A datatype that represents everything that can happen
+-- at an endpoint, with its lenses:
+--
+-- - List of captures ('captures')
+-- - List of GET parameters ('params')
+-- - What the request body should look like, if any is requested ('rqbody')
+-- - What the response should be if everything goes well ('response')
+--
+-- You can tweak an 'Action' (like the default 'defAction') with these lenses
+-- to transform an action and add some information to it.
+data Action = Action
+  { _captures :: [DocCapture]        -- type collected + user supplied info
+  , _params   :: [DocQueryParam]     -- type collected + user supplied info
+  , _rqbody   :: Maybe ByteString    -- user supplied
+  , _response :: Response            -- user supplied
+  } deriving (Eq, Show)
+
+-- Default 'Action'. Has no 'captures', no GET 'params', expects
+-- no request body ('rqbody') and the typical response is 'defResponse'.
+--
+-- Tweakable with lenses.
+--
+-- > λ> defAction
+-- > Action {_captures = [], _params = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
+-- > λ> defAction & response.respStatus .~ 201
+-- > Action {_captures = [], _params = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
+defAction :: Action
+defAction =
+  Action []
+         []
+         Nothing
+         defResponse
+
+-- | Create an API that's comprised of a single endpoint.
+--   'API' is a 'Monoid', so combine multiple endpoints with
+--   'mappend' or '<>'.
+single :: Endpoint -> Action -> API
+single = HM.singleton
+
+-- gimme some lenses
+makeLenses ''Endpoint
+makeLenses ''DocCapture
+makeLenses ''DocQueryParam
+makeLenses ''Response
+makeLenses ''Action
+
+-- | Generate the docs for a given API that implements 'HasDocs'.
+docs :: HasDocs layout => Proxy layout -> API
+docs p = docsFor p (defEndpoint, defAction)
+
+-- | The class that abstracts away the impact of API combinators
+--   on documentation generation.
+class HasDocs layout where
+  docsFor :: Proxy layout -> (Endpoint, Action) -> API
+
+-- | The class that lets us display a sample JSON input or output
+--   when generating documentation for endpoints that either:
+--
+-- - expect a request body, or
+-- - return a non empty response body
+--
+-- Example of an instance:
+--
+-- > {-# LANGUAGE DeriveGeneric #-}
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- >
+-- > import Data.Aeson
+-- > import Data.Text
+-- > import GHC.Generics
+-- >
+-- > data Greet = Greet { _msg :: Text }
+-- >   deriving (Generic, Show)
+-- >
+-- > instance FromJSON Greet
+-- > instance ToJSON Greet
+-- >
+-- > instance ToSample Greet where
+-- >   toSample = Just g
+-- >
+-- >     where g = Greet "Hello, haskeller!"
+class ToJSON a => ToSample a where
+  toSample :: Maybe a
+
+instance ToSample () where
+  toSample = Just ()
+
+sampleByteString :: forall a . ToSample a => Proxy a -> Maybe ByteString
+sampleByteString Proxy = fmap encode (toSample :: Maybe a)
+
+-- | The class that helps us automatically get documentation
+--   for GET parameters.
+--
+-- Example of an instance:
+--
+-- > instance ToParam (QueryParam "capital" Bool) where
+-- >   toParam _ =
+-- >     DocQueryParam "capital"
+-- >                   ["true", "false"]
+-- >                   "Get the greeting message in uppercase (true) or not (false). Default is false."
+class ToParam t where
+  toParam :: Proxy t -> DocQueryParam
+
+-- | The class that helps us automatically get documentation
+--   for URL captures.
+--
+-- Example of an instance:
+--
+-- > instance ToCapture (Capture "name" Text) where
+-- >   toCapture _ = DocCapture "name" "name of the person to greet"
+class ToCapture c where
+  toCapture :: Proxy c -> DocCapture
+
+-- | Generate documentation in Markdown format for
+--   the given 'API'.
+markdown :: API -> String
+markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
+
+  where printEndpoint :: Endpoint -> Action -> [String]
+        printEndpoint endpoint action =
+          str :
+          replicate len '-' :
+          "" :
+          capturesStr (action ^. captures) ++
+          paramsStr (action ^. params) ++
+          rqbodyStr (action ^. rqbody) ++
+          responseStr (action ^. response) ++
+          []
+
+          where str = show (endpoint^.method) ++ " " ++ endpoint^.path
+                len = length str
+
+        capturesStr :: [DocCapture] -> [String]
+        capturesStr [] = []
+        capturesStr l =
+          "**Captures**: " :
+          "" :
+          map captureStr l ++
+          "" :
+          []
+        captureStr cap =
+          "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
+
+        paramsStr :: [DocQueryParam] -> [String]
+        paramsStr [] = []
+        paramsStr l =
+          "**GET Parameters**: " :
+          "" :
+          map paramStr l ++
+          "" :
+          []
+        paramStr param = unlines $
+          (" - " ++ param ^. paramName) :
+          (if (not (null values) || param ^. paramKind /= Flag)
+            then ["     - **Values**: *" ++ intercalate ", " values ++ "*"]
+            else []) ++
+          ("     - **Description**: " ++ param ^. paramDesc) :
+          (if (param ^. paramKind == List)
+            then ["     - This parameter is a **list**. All GET parameters with the name "
+                  ++ param ^. paramName ++ "[] will forward their values in a list to the handler."]
+            else []) ++
+          (if (param ^. paramKind == Flag)
+            then ["     - This parameter is a **flag**. This means no value is expected to be associated to this parameter."]
+            else []) ++
+          []
+
+          where values = param ^. paramValues
+
+        rqbodyStr :: Maybe ByteString -> [String]
+        rqbodyStr Nothing = []
+        rqbodyStr (Just b) =
+          "**Request Body**: " :
+          jsonStr b
+
+        jsonStr b =
+          "" :
+          "``` javascript" :
+          cs b :
+          "```" :
+          "" :
+          []
+
+        responseStr :: Response -> [String]
+        responseStr resp =
+          "**Response**: " :
+          "" :
+          (" - Status code " ++ show (resp ^. respStatus)) :
+          (resp ^. respBody &
+            maybe [" - No response body\n"]
+                  (\b -> " - Response body as below." : jsonStr b))
+
+-- * Instances
+
+-- | The generated docs for @a ':<|>' b@ just appends the docs
+--   for @a@ with the docs for @b@.
+instance (HasDocs layout1, HasDocs layout2)
+      => HasDocs (layout1 :<|> layout2) where
+
+  docsFor Proxy (ep, action) = docsFor p1 (ep, action) <> docsFor p2 (ep, action)
+
+    where p1 :: Proxy layout1
+          p1 = Proxy
+
+          p2 :: Proxy layout2
+          p2 = Proxy
+
+-- | @"books" :> 'Capture' "isbn" Text@ will appear as
+-- @/books/:isbn@ in the docs.
+instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
+      => HasDocs (Capture sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          captureP = Proxy :: Proxy (Capture sym a)
+
+          action' = over captures (|> toCapture captureP) action
+          endpoint' = over path (\p -> p++"/:"++symbolVal symP) endpoint
+          symP = Proxy :: Proxy sym
+
+
+instance HasDocs Delete where
+  docsFor Proxy (endpoint, action) =
+    single endpoint' action'
+
+    where endpoint' = endpoint & method .~ DocDELETE
+
+          action' = action & response.respBody .~ Nothing
+                           & response.respStatus .~ 204
+
+instance ToSample a => HasDocs (Get a) where
+  docsFor Proxy (endpoint, action) =
+    single endpoint' action'
+
+    where endpoint' = endpoint & method .~ DocGET
+          action' = action & response.respBody .~ sampleByteString p
+          p = Proxy :: Proxy a
+
+instance ToSample a => HasDocs (Post a) where
+  docsFor Proxy (endpoint, action) =
+    single endpoint' action'
+
+    where endpoint' = endpoint & method .~ DocPOST
+
+          action' = action & response.respBody .~ sampleByteString p
+                           & response.respStatus .~ 201
+
+          p = Proxy :: Proxy a
+
+instance ToSample a => HasDocs (Put a) where
+  docsFor Proxy (endpoint, action) =
+    single endpoint' action'
+
+    where endpoint' = endpoint & method .~ DocPUT
+
+          action' = action & response.respBody .~ sampleByteString p
+                           & response.respStatus .~ 200
+
+          p = Proxy :: Proxy a
+
+
+instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
+      => HasDocs (QueryParam sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint, action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          paramP = Proxy :: Proxy (QueryParam sym a)
+          action' = over params (|> toParam paramP) action
+
+instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs sublayout)
+      => HasDocs (QueryParams sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint, action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          paramP = Proxy :: Proxy (QueryParams sym a)
+          action' = over params (|> toParam paramP) action
+
+
+instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
+      => HasDocs (QueryFlag sym :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint, action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          paramP = Proxy :: Proxy (QueryFlag sym)
+          action' = over params (|> toParam paramP) action
+
+instance HasDocs Raw where
+  docsFor _proxy (endpoint, action) =
+    single endpoint action
+
+instance (ToSample a, HasDocs sublayout)
+      => HasDocs (ReqBody a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint, action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+
+          action' = action & rqbody .~ sampleByteString p
+          p = Proxy :: Proxy a
+
+instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action)
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          endpoint' = endpoint & path <>~ symbolVal pa
+          pa = Proxy :: Proxy path
+
+{-
+
+-- | Serve your API's docs as markdown embedded in an html \<pre> tag.
+--
+-- > type MyApi = "users" :> Get [User]
+-- >         :<|> "docs   :> Raw
+-- >
+-- > apiProxy :: Proxy MyApi
+-- > apiProxy = Proxy
+-- >
+-- > server :: Server MyApi
+-- > server = listUsers
+-- >     :<|> serveDocumentation apiProxy
+serveDocumentation :: HasDocs api => Proxy api -> Server Raw
+serveDocumentation proxy _request respond =
+  respond $ responseLBS ok200 [] $ cs $ toHtml $ markdown $ docs proxy
+
+toHtml :: String -> String
+toHtml md =
+  "<html>" ++
+  "<body>" ++
+  "<pre>" ++
+  md ++
+  "</pre>" ++
+  "</body>" ++
+  "</html>"
+-}
\ No newline at end of file

From d39d1f1d0a1676354f0792d95fe84e6fc71652d6 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Mon, 1 Dec 2014 16:29:42 +0100
Subject: [PATCH 02/54] fix travis script...

---
 servant-docs.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/servant-docs.cabal b/servant-docs.cabal
index 473eda11..0d76f305 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -21,7 +21,7 @@ library
     , bytestring
     , hashable
     , lens
-    , servant
+    , servant >= 0.2
     , string-conversions
     , system-filepath
     , unordered-containers

From 4dafc4efb44bfe0dff91229f032bed875a417725 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Mon, 1 Dec 2014 16:38:43 +0100
Subject: [PATCH 03/54] add LICENSE files to all projects

---
 LICENSE | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)
 create mode 100644 LICENSE

diff --git a/LICENSE b/LICENSE
new file mode 100644
index 00000000..bfee8018
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2014, Zalora South East Asia Pte Ltd
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Zalora South East Asia Pte Ltd nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

From 426c59078cdd4e3a55037ada443bf4760a3b908d Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Tue, 2 Dec 2014 17:25:52 +0100
Subject: [PATCH 04/54] add travis file

---
 .travis.yml | 12 ++++++++++++
 1 file changed, 12 insertions(+)
 create mode 100644 .travis.yml

diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 00000000..03aca3f5
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,12 @@
+language: haskell
+
+notifications:
+  irc:
+    channels:
+      - "irc.freenode.org#servant"
+    template:
+      - "%{repository}#%{build_number} - %{commit} on %{branch} by %{author}: %{message}"
+      - "Build details: %{build_url} - Change view: %{compare_url}"
+    skip_join: true
+    on_success: change
+    on_failure: always

From d517bfa69cc72fe2e5d7128ea23d7aead47ea15d Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Tue, 2 Dec 2014 17:49:25 +0100
Subject: [PATCH 05/54] travis: buidl with ghc 7.8 and clone servant from git
 before building

---
 .travis.yml | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/.travis.yml b/.travis.yml
index 03aca3f5..41be6fa3 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -1,5 +1,13 @@
 language: haskell
 
+ghc:
+  - 7.8
+
+before_install:
+  - git clone https://github.com/haskell-servant/servant.git
+  - cabal sandbox init
+  - cabal sandbox add-source servant/
+
 notifications:
   irc:
     channels:

From 22615210024a354d1a5e4308bb1a1a507dd7f861 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Mon, 8 Dec 2014 11:25:52 +0100
Subject: [PATCH 06/54] polish up cabal file, add README and output of the
 example

---
 README.md          | 67 ++++++++++++++++++++++++++++++++++++++++++++
 example/greet.md   | 52 ++++++++++++++++++++++++++++++++++
 servant-docs.cabal | 70 +++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 185 insertions(+), 4 deletions(-)
 create mode 100644 README.md
 create mode 100644 example/greet.md

diff --git a/README.md b/README.md
new file mode 100644
index 00000000..23ac3ea3
--- /dev/null
+++ b/README.md
@@ -0,0 +1,67 @@
+# servant-docs
+
+[![Build Status](https://secure.travis-ci.org/haskell-servant/servant-docs.svg)](http://travis-ci.org/haskell-servant/servant-docs)
+
+![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)
+
+Generate API docs for your *servant* webservice.
+
+## Example
+
+See [here](https://github.com/haskell-servant/servant-docs/blob/master/example/greet.md) for the output of the following program.
+
+``` haskell
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+import Data.Proxy
+import Data.Text
+import Servant
+
+-- our type for a Greeting message
+data Greet = Greet { _msg :: Text }
+  deriving (Generic, Show)
+
+-- we get our JSON serialization for free
+instance FromJSON Greet
+instance ToJSON Greet
+
+-- we provide a sample value for the 'Greet' type
+instance ToSample Greet where
+  toSample = Just g
+
+    where g = Greet "Hello, haskeller!"
+
+instance ToParam (QueryParam "capital" Bool) where
+  toParam _ =
+    DocQueryParam "capital"
+                  ["true", "false"]
+                  "Get the greeting message in uppercase (true) or not (false). Default is false."
+
+instance ToCapture (Capture "name" Text) where
+  toCapture _ = DocCapture "name" "name of the person to greet"
+
+instance ToCapture (Capture "greetid" Text) where
+  toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
+
+-- API specification
+type TestApi =
+       "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
+  :<|> "greet" :> RQBody Greet :> Post Greet
+  :<|> "delete" :> Capture "greetid" Text :> Delete
+
+testApi :: Proxy TestApi
+testApi = Proxy
+
+-- Generate the Documentation's ADT
+greetDocs :: API
+greetDocs = docs testApi
+
+main :: IO ()
+main = putStrLn $ markdown greetDocs
+```
diff --git a/example/greet.md b/example/greet.md
new file mode 100644
index 00000000..149c3d59
--- /dev/null
+++ b/example/greet.md
@@ -0,0 +1,52 @@
+POST /greet
+-----------
+
+**Request Body**: 
+
+``` javascript
+{"msg":"Hello, haskeller!"}
+```
+
+**Response**: 
+
+ - Status code 201
+ - Response body as below.
+
+``` javascript
+{"msg":"Hello, haskeller!"}
+```
+
+GET /hello/:name
+----------------
+
+**Captures**: 
+
+- *name*: name of the person to greet
+
+**GET Parameters**: 
+
+ - capital
+     - **Values**: *true, false*
+     - **Description**: Get the greeting message in uppercase (true) or not (false). Default is false.
+
+
+**Response**: 
+
+ - Status code 200
+ - Response body as below.
+
+``` javascript
+{"msg":"Hello, haskeller!"}
+```
+
+DELETE /greet/:greetid
+----------------------
+
+**Captures**: 
+
+- *greetid*: identifier of the greet msg to remove
+
+**Response**: 
+
+ - Status code 204
+ - No response body
diff --git a/servant-docs.cabal b/servant-docs.cabal
index 0d76f305..6da9280e 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -1,7 +1,64 @@
 name:                servant-docs
 version:             0.2
--- synopsis:
--- description:
+synopsis:            generate API docs for your servant webservice
+description:
+  Library for generating API docs from a servant API definition.
+  .
+  Runnable example below that prints API docs in markdown.
+  .
+  > {-# LANGUAGE DataKinds #-}
+  > {-# LANGUAGE PolyKinds #-}
+  > {-# LANGUAGE TypeFamilies #-}
+  > {-# LANGUAGE DeriveGeneric #-}
+  > {-# LANGUAGE TypeOperators #-}
+  > {-# LANGUAGE FlexibleInstances #-}
+  > {-# LANGUAGE OverloadedStrings #-}
+  >
+  > import Data.Proxy
+  > import Data.Text
+  > import Servant
+  >
+  > -- our type for a Greeting message
+  > data Greet = Greet { _msg :: Text }
+  >   deriving (Generic, Show)
+  >
+  > -- we get our JSON serialization for free
+  > instance FromJSON Greet
+  > instance ToJSON Greet
+  >
+  > -- we provide a sample value for the 'Greet' type
+  > instance ToSample Greet where
+  >   toSample = Just g
+  >
+  >     where g = Greet "Hello, haskeller!"
+  >
+  > instance ToParam (QueryParam "capital" Bool) where
+  >   toParam _ =
+  >     DocQueryParam "capital"
+  >                   ["true", "false"]
+  >                   "Get the greeting message in uppercase (true) or not (false). Default is false."
+  >
+  > instance ToCapture (Capture "name" Text) where
+  >   toCapture _ = DocCapture "name" "name of the person to greet"
+  >
+  > instance ToCapture (Capture "greetid" Text) where
+  >   toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
+  >
+  > -- API specification
+  > type TestApi =
+  >        "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
+  >   :<|> "greet" :> RQBody Greet :> Post Greet
+  >   :<|> "delete" :> Capture "greetid" Text :> Delete
+  >
+  > testApi :: Proxy TestApi
+  > testApi = Proxy
+  >
+  > -- Generate the Documentation's ADT
+  > greetDocs :: API
+  > greetDocs = docs testApi
+  >
+  > main :: IO ()
+  > main = putStrLn $ markdown greetDocs
 license:             BSD3
 license-file:        LICENSE
 author:              Alp Mestanogullari, Sönke Hahn, Julian K. Arni
@@ -11,6 +68,11 @@ category:            Web
 build-type:          Simple
 cabal-version:       >=1.10
 tested-with:         GHC >= 7.8
+homepage:            http://haskell-servant.github.io/
+Bug-reports:         http://github.com/haskell-servant/servant-docs/issues
+source-repository head
+  type: git
+  location: http://github.com/haskell-servant/servant-docs.git
 
 library
   exposed-modules:
@@ -27,11 +89,11 @@ library
     , unordered-containers
   hs-source-dirs: src
   default-language: Haskell2010
-  ghc-options: -O0 -Wall
+  ghc-options: -Wall
 
 executable greet-docs
   main-is: greet.hs
   hs-source-dirs: example
-  ghc-options: -O0 -Wall
+  ghc-options: -Wall
   build-depends: base, aeson, servant, servant-docs, text
   default-language: Haskell2010

From d831cf944f793081e5c971a31a565ca7ccb52a40 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Mon, 8 Dec 2014 13:07:34 +0100
Subject: [PATCH 07/54] add docs support for Header

---
 servant-docs.cabal  |  1 +
 src/Servant/Docs.hs | 20 ++++++++++++++++++++
 2 files changed, 21 insertions(+)

diff --git a/servant-docs.cabal b/servant-docs.cabal
index 6da9280e..3a48559f 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -86,6 +86,7 @@ library
     , servant >= 0.2
     , string-conversions
     , system-filepath
+    , text
     , unordered-containers
   hs-source-dirs: src
   default-language: Haskell2010
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index f8e08c83..99d619d8 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -115,6 +115,7 @@ import Data.HashMap.Strict (HashMap)
 import Data.List
 import Data.Monoid
 import Data.Proxy
+import Data.Text (Text, pack, unpack)
 import Data.String.Conversions
 import GHC.Generics
 import GHC.TypeLits
@@ -255,6 +256,7 @@ defResponse = Response 200 Nothing
 -- to transform an action and add some information to it.
 data Action = Action
   { _captures :: [DocCapture]        -- type collected + user supplied info
+  , _headers  :: [Text]              -- type collected
   , _params   :: [DocQueryParam]     -- type collected + user supplied info
   , _rqbody   :: Maybe ByteString    -- user supplied
   , _response :: Response            -- user supplied
@@ -272,6 +274,7 @@ data Action = Action
 defAction :: Action
 defAction =
   Action []
+         []
          []
          Nothing
          defResponse
@@ -366,6 +369,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
           replicate len '-' :
           "" :
           capturesStr (action ^. captures) ++
+          headersStr (action ^. headers) ++
           paramsStr (action ^. params) ++
           rqbodyStr (action ^. rqbody) ++
           responseStr (action ^. response) ++
@@ -385,6 +389,13 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
         captureStr cap =
           "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
 
+        headersStr :: [Text] -> [String]
+        headersStr [] = []
+        headersStr l = [""] ++ map headerStr l ++ [""]
+
+          where headerStr hname = "- This endpoint is sensitive to the value of the **"
+                               ++ unpack hname ++ "** HTTP header."
+
         paramsStr :: [DocQueryParam] -> [String]
         paramsStr [] = []
         paramsStr l =
@@ -481,6 +492,15 @@ instance ToSample a => HasDocs (Get a) where
           action' = action & response.respBody .~ sampleByteString p
           p = Proxy :: Proxy a
 
+instance (KnownSymbol sym, HasDocs sublayout)
+      => HasDocs (Header sym a :> sublayout) where
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint, action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          action' = over headers (|> headername) action
+          headername = pack $ symbolVal (Proxy :: Proxy sym)
+
 instance ToSample a => HasDocs (Post a) where
   docsFor Proxy (endpoint, action) =
     single endpoint' action'

From 2d2c46ea121d46d71df64fc623fa6880b25123d2 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Wed, 10 Dec 2014 16:43:43 +0100
Subject: [PATCH 08/54] adapt to the servant/servant-server split

---
 Setup.hs            |  2 ++
 docs.sh             | 52 +++++++++++++++++++++++++++++++++++++++
 example/greet.hs    |  3 ++-
 servant-docs.cabal  | 60 +++------------------------------------------
 src/Servant/Docs.hs |  2 +-
 5 files changed, 60 insertions(+), 59 deletions(-)
 create mode 100644 Setup.hs
 create mode 100644 docs.sh

diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 00000000..9a994af6
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/docs.sh b/docs.sh
new file mode 100644
index 00000000..e4723d66
--- /dev/null
+++ b/docs.sh
@@ -0,0 +1,52 @@
+SERVANT_DIR=/tmp/servant-docs-gh-pages
+
+# Make a temporary clone
+
+rm -rf $SERVANT_DIR
+
+git clone . $SERVANT_DIR
+
+cd $SERVANT_DIR
+
+# Make sure to pull the latest
+
+git remote add haskell-servant git@github.com:haskell-servant/servant-docs.git
+
+git fetch haskell-servant
+
+git reset --hard haskell-servant/gh-pages
+
+# Clear everything away
+
+git rm -rf $SERVANT_DIR/*
+
+# Switch back and build the haddocks
+
+cd -
+
+cabal configure --builddir=$SERVANT_DIR
+
+cabal haddock --hoogle --hyperlink-source --html-location='https://hackage.haskell.org/package/$pkg-$version/docs' --builddir=$SERVANT_DIR
+
+commit_hash=$(git rev-parse HEAD)
+
+# Move the HTML docs to the root
+
+cd $SERVANT_DIR
+
+rm *
+rm -rf build
+mv doc/html/servant-docs/* .
+rm -r doc/
+
+# Add everything
+
+git add .
+
+git commit -m "Built from $commit_hash"
+
+# Push to update the pages
+
+git push haskell-servant HEAD:gh-pages
+
+rm -rf $SERVANT_DIR
diff --git a/example/greet.hs b/example/greet.hs
index aac8052b..311ef060 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -4,9 +4,10 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 import Data.Aeson
+import Data.Proxy
 import Data.Text
 import GHC.Generics
-import Servant
+import Servant.API
 import Servant.Docs
 
 -- * Example
diff --git a/servant-docs.cabal b/servant-docs.cabal
index 3a48559f..1c049007 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -1,64 +1,10 @@
 name:                servant-docs
-version:             0.2
+version:             0.2.1
 synopsis:            generate API docs for your servant webservice
 description:
   Library for generating API docs from a servant API definition.
   .
-  Runnable example below that prints API docs in markdown.
-  .
-  > {-# LANGUAGE DataKinds #-}
-  > {-# LANGUAGE PolyKinds #-}
-  > {-# LANGUAGE TypeFamilies #-}
-  > {-# LANGUAGE DeriveGeneric #-}
-  > {-# LANGUAGE TypeOperators #-}
-  > {-# LANGUAGE FlexibleInstances #-}
-  > {-# LANGUAGE OverloadedStrings #-}
-  >
-  > import Data.Proxy
-  > import Data.Text
-  > import Servant
-  >
-  > -- our type for a Greeting message
-  > data Greet = Greet { _msg :: Text }
-  >   deriving (Generic, Show)
-  >
-  > -- we get our JSON serialization for free
-  > instance FromJSON Greet
-  > instance ToJSON Greet
-  >
-  > -- we provide a sample value for the 'Greet' type
-  > instance ToSample Greet where
-  >   toSample = Just g
-  >
-  >     where g = Greet "Hello, haskeller!"
-  >
-  > instance ToParam (QueryParam "capital" Bool) where
-  >   toParam _ =
-  >     DocQueryParam "capital"
-  >                   ["true", "false"]
-  >                   "Get the greeting message in uppercase (true) or not (false). Default is false."
-  >
-  > instance ToCapture (Capture "name" Text) where
-  >   toCapture _ = DocCapture "name" "name of the person to greet"
-  >
-  > instance ToCapture (Capture "greetid" Text) where
-  >   toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
-  >
-  > -- API specification
-  > type TestApi =
-  >        "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
-  >   :<|> "greet" :> RQBody Greet :> Post Greet
-  >   :<|> "delete" :> Capture "greetid" Text :> Delete
-  >
-  > testApi :: Proxy TestApi
-  > testApi = Proxy
-  >
-  > -- Generate the Documentation's ADT
-  > greetDocs :: API
-  > greetDocs = docs testApi
-  >
-  > main :: IO ()
-  > main = putStrLn $ markdown greetDocs
+  Runnable example <https://github.com/haskell-servant/servant-docs/blob/master/example/greet.hs here>.
 license:             BSD3
 license-file:        LICENSE
 author:              Alp Mestanogullari, Sönke Hahn, Julian K. Arni
@@ -83,7 +29,7 @@ library
     , bytestring
     , hashable
     , lens
-    , servant >= 0.2
+    , servant >= 0.2.1
     , string-conversions
     , system-filepath
     , text
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 99d619d8..606d2dda 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -119,7 +119,7 @@ import Data.Text (Text, pack, unpack)
 import Data.String.Conversions
 import GHC.Generics
 import GHC.TypeLits
-import Servant
+import Servant.API
 
 import qualified Data.HashMap.Strict as HM
 

From 3898c19afe75d0ec9d2ece912d7bb5ab41ed8a56 Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Sat, 20 Dec 2014 21:58:07 +0100
Subject: [PATCH 09/54] Switch to encodePretty in sampleByteString.

---
 example/greet.hs    |  3 ++-
 example/greet.md    | 29 +++++++++++++++++++----------
 servant-docs.cabal  |  1 +
 src/Servant/Docs.hs |  5 +++--
 4 files changed, 25 insertions(+), 13 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 311ef060..868a55ac 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 import Data.Aeson
 import Data.Proxy
 import Data.Text
@@ -60,4 +61,4 @@ docsGreet :: API
 docsGreet = docs testApi
 
 main :: IO ()
-main = putStrLn $ markdown docsGreet
\ No newline at end of file
+main = putStrLn $ markdown docsGreet
diff --git a/example/greet.md b/example/greet.md
index 149c3d59..2191063c 100644
--- a/example/greet.md
+++ b/example/greet.md
@@ -1,52 +1,61 @@
+
 POST /greet
 -----------
 
-**Request Body**: 
+**Request Body**:
 
 ``` javascript
-{"msg":"Hello, haskeller!"}
+{
+    "msg": "Hello, haskeller!"
+}
 ```
 
-**Response**: 
+**Response**:
 
  - Status code 201
  - Response body as below.
 
 ``` javascript
-{"msg":"Hello, haskeller!"}
+{
+    "msg": "Hello, haskeller!"
+}
 ```
 
 GET /hello/:name
 ----------------
 
-**Captures**: 
+**Captures**:
 
 - *name*: name of the person to greet
 
-**GET Parameters**: 
+**GET Parameters**:
 
  - capital
      - **Values**: *true, false*
      - **Description**: Get the greeting message in uppercase (true) or not (false). Default is false.
 
 
-**Response**: 
+**Response**:
 
  - Status code 200
  - Response body as below.
 
 ``` javascript
-{"msg":"Hello, haskeller!"}
+{
+    "msg": "Hello, haskeller!"
+}
 ```
 
 DELETE /greet/:greetid
 ----------------------
 
-**Captures**: 
+**Captures**:
 
 - *greetid*: identifier of the greet msg to remove
 
-**Response**: 
+**Response**:
 
  - Status code 204
  - No response body
+
+
diff --git a/servant-docs.cabal b/servant-docs.cabal
index 1c049007..7f7d8777 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -26,6 +26,7 @@ library
   build-depends:
       base >=4.7 && <5
     , aeson
+    , aeson-pretty < 0.8
     , bytestring
     , hashable
     , lens
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 606d2dda..a3bcf5ee 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -109,6 +109,7 @@ module Servant.Docs
 
 import Control.Lens hiding (Action)
 import Data.Aeson
+import Data.Aeson.Encode.Pretty (encodePretty)
 import Data.ByteString.Lazy.Char8 (ByteString)
 import Data.Hashable
 import Data.HashMap.Strict (HashMap)
@@ -333,7 +334,7 @@ instance ToSample () where
   toSample = Just ()
 
 sampleByteString :: forall a . ToSample a => Proxy a -> Maybe ByteString
-sampleByteString Proxy = fmap encode (toSample :: Maybe a)
+sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a)
 
 -- | The class that helps us automatically get documentation
 --   for GET parameters.
@@ -605,4 +606,4 @@ toHtml md =
   "</pre>" ++
   "</body>" ++
   "</html>"
--}
\ No newline at end of file
+-}

From 17569a31b630a5d6928a492c11416606bd939f1b Mon Sep 17 00:00:00 2001
From: Phil Freeman <paf31@cantab.net>
Date: Wed, 31 Dec 2014 17:18:23 -0800
Subject: [PATCH 10/54] Add .gitignore file which ignore sandbox files

---
 .gitignore | 3 +++
 1 file changed, 3 insertions(+)
 create mode 100644 .gitignore

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 00000000..cef41940
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+.cabal-sandbox
+cabal.sandbox.config
+dist

From 42fc048dfc57c2a1d41be84dcb1c50e100a63e8a Mon Sep 17 00:00:00 2001
From: Phil Freeman <paf31@cantab.net>
Date: Wed, 31 Dec 2014 17:19:35 -0800
Subject: [PATCH 11/54] Add missing slash character in generated docs.

---
 src/Servant/Docs.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index a3bcf5ee..3c132ee7 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -175,7 +175,7 @@ instance Show Endpoint where
 -- POST /foo
 -- @
 defEndpoint :: Endpoint
-defEndpoint = Endpoint "/" DocGET
+defEndpoint = Endpoint "" DocGET
 
 instance Hashable Endpoint
 
@@ -577,7 +577,7 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh
     docsFor sublayoutP (endpoint', action)
 
     where sublayoutP = Proxy :: Proxy sublayout
-          endpoint' = endpoint & path <>~ symbolVal pa
+          endpoint' = endpoint & path <>~ '/' : symbolVal pa
           pa = Proxy :: Proxy path
 
 {-

From 6f106628873fc6a6f83580a4937e7c5ed79d9c7a Mon Sep 17 00:00:00 2001
From: Daniel Larsson <daniel.j.larsson@gmail.com>
Date: Thu, 1 Jan 2015 23:42:06 +0100
Subject: [PATCH 12/54] Initial support for matrix parameters. Not complete,
 not sure how to document them yet, since documentation is focused on
 endpoints, not individual path fragments.

---
 .gitignore          | 17 +++++++++++++++++
 src/Servant/Docs.hs | 37 +++++++++++++++++++++++++++++++++++++
 2 files changed, 54 insertions(+)
 create mode 100644 .gitignore

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 00000000..0855a79b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,17 @@
+dist
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.virtualenv
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+cabal.config
+*.prof
+*.aux
+*.hp
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index a3bcf5ee..507209e5 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -556,6 +556,43 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
           paramP = Proxy :: Proxy (QueryFlag sym)
           action' = over params (|> toParam paramP) action
 
+
+instance (KnownSymbol sym, {- ToParam (MatrixParam sym a), -} HasDocs sublayout)
+      => HasDocs (MatrixParam sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action)
+
+    where sublayoutP = Proxy :: Proxy sublayout
+
+          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          symP = Proxy :: Proxy sym
+
+
+instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout)
+      => HasDocs (MatrixParams sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action)
+
+    where sublayoutP = Proxy :: Proxy sublayout
+
+          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          symP = Proxy :: Proxy sym
+
+
+instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
+      => HasDocs (MatrixFlag sym :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action)
+
+    where sublayoutP = Proxy :: Proxy sublayout
+
+          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          symP = Proxy :: Proxy sym
+
+
 instance HasDocs Raw where
   docsFor _proxy (endpoint, action) =
     single endpoint action

From 43f9aa78c0f650cfeba2d54e987bd2d1635f003d Mon Sep 17 00:00:00 2001
From: Phil Freeman <paf31@cantab.net>
Date: Fri, 2 Jan 2015 10:06:34 -0800
Subject: [PATCH 13/54] Represent path as [String]

---
 src/Servant/Docs.hs | 29 ++++++++++++++++++-----------
 1 file changed, 18 insertions(+), 11 deletions(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 3c132ee7..606ac9da 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -148,19 +148,26 @@ instance Hashable Method
 -- @
 -- λ> 'defEndpoint'
 -- GET /
--- λ> 'defEndpoint' & 'path' '<>~' "foo"
+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
 -- GET /foo
--- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST'
+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
 -- POST /foo
 -- @
 data Endpoint = Endpoint
-  { _path   :: String -- type collected
-  , _method :: Method -- type collected
+  { _path   :: [String] -- type collected
+  , _method :: Method   -- type collected
   } deriving (Eq, Generic)
 
 instance Show Endpoint where
   show (Endpoint p m) =
-    show m ++ " " ++ p
+    show m ++ " " ++ showPath p
+
+-- |
+-- Render a path as a '/'-delimited string
+--
+showPath :: [String] -> String
+showPath [] = "/"
+showPath ps = concatMap ('/' :) ps
 
 -- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'
 --
@@ -169,13 +176,13 @@ instance Show Endpoint where
 -- @
 -- λ> 'defEndpoint'
 -- GET /
--- λ> 'defEndpoint' & 'path' '<>~' "foo"
+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
 -- GET /foo
--- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST'
+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
 -- POST /foo
 -- @
 defEndpoint :: Endpoint
-defEndpoint = Endpoint "" DocGET
+defEndpoint = Endpoint [] DocGET
 
 instance Hashable Endpoint
 
@@ -376,7 +383,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
           responseStr (action ^. response) ++
           []
 
-          where str = show (endpoint^.method) ++ " " ++ endpoint^.path
+          where str = show (endpoint^.method) ++ " " ++ showPath (endpoint^.path)
                 len = length str
 
         capturesStr :: [DocCapture] -> [String]
@@ -472,7 +479,7 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
           captureP = Proxy :: Proxy (Capture sym a)
 
           action' = over captures (|> toCapture captureP) action
-          endpoint' = over path (\p -> p++"/:"++symbolVal symP) endpoint
+          endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
           symP = Proxy :: Proxy sym
 
 
@@ -577,7 +584,7 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh
     docsFor sublayoutP (endpoint', action)
 
     where sublayoutP = Proxy :: Proxy sublayout
-          endpoint' = endpoint & path <>~ '/' : symbolVal pa
+          endpoint' = endpoint & path <>~ [symbolVal pa]
           pa = Proxy :: Proxy path
 
 {-

From e333ed5ff607b4db61e038978a5db6f777850505 Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Sat, 3 Jan 2015 16:11:09 +0000
Subject: [PATCH 14/54] Expose "headers" lens

All other lenses for `Action` are exposed. Without it, it is impossible to access the headers field.
---
 src/Servant/Docs.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 606ac9da..a88fbd77 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -99,7 +99,7 @@ module Servant.Docs
   , DocCapture(..), capSymbol, capDesc
   , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
   , Response, respStatus, respBody, defResponse
-  , Action, captures, params, rqbody, response, defAction
+  , Action, captures, headers, params, rqbody, response, defAction
   , single
 
   , -- * Useful modules when defining your doc printers

From 0edde415bdae7afcb4a43e799d77ecdbcc5e81dd Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Sun, 4 Jan 2015 16:38:50 +0100
Subject: [PATCH 15/54] first shot (doesn't build though) at multiple responses
 in the docs

---
 src/Servant/Docs.hs | 58 ++++++++++++++++++++++++++++++---------------
 1 file changed, 39 insertions(+), 19 deletions(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index a88fbd77..26f794c5 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -1,10 +1,12 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 -------------------------------------------------------------------------------
 -- | This module lets you get API docs for free. It lets generate
@@ -83,12 +85,10 @@ module Servant.Docs
   ( -- * 'HasDocs' class and key functions
     HasDocs(..), docs, markdown
 
-  {- , -- * Serving the documentation
-    serveDocumentation -}
-
   , -- * Classes you need to implement for your types
     ToSample(..)
   , sampleByteString
+  , sampleByteStrings
   , ToParam(..)
   , ToCapture(..)
 
@@ -114,6 +114,7 @@ import Data.ByteString.Lazy.Char8 (ByteString)
 import Data.Hashable
 import Data.HashMap.Strict (HashMap)
 import Data.List
+import Data.Maybe (listToMaybe)
 import Data.Monoid
 import Data.Proxy
 import Data.Text (Text, pack, unpack)
@@ -123,6 +124,7 @@ import GHC.TypeLits
 import Servant.API
 
 import qualified Data.HashMap.Strict as HM
+import qualified Data.Text           as T
 
 -- | Supported HTTP request methods
 data Method = DocDELETE -- ^ the DELETE method
@@ -233,12 +235,12 @@ data ParamKind = Normal | List | Flag
 -- Can be tweaked with two lenses.
 --
 -- > λ> defResponse
--- > Response {_respStatus = 200, _respBody = Nothing}
--- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
--- > Response {_respStatus = 204, _respBody = Just "[]"}
+-- > Response {_respStatus = 200, _respBody = []}
+-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
+-- > Response {_respStatus = 204, _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
 data Response = Response
   { _respStatus :: Int
-  , _respBody   :: Maybe ByteString
+  , _respBody   :: [(Text, ByteString)]
   } deriving (Eq, Show)
 
 -- | Default response: status code 200, no response body.
@@ -250,7 +252,7 @@ data Response = Response
 -- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
 -- > Response {_respStatus = 204, _respBody = Just "[]"}
 defResponse :: Response
-defResponse = Response 200 Nothing
+defResponse = Response 200 []
 
 -- | A datatype that represents everything that can happen
 -- at an endpoint, with its lenses:
@@ -334,15 +336,29 @@ class HasDocs layout where
 -- >   toSample = Just g
 -- >
 -- >     where g = Greet "Hello, haskeller!"
+--
+-- You can also instantiate this class using 'toSamples' instead of
+-- 'toSample': it lets you specify different responses along with
+-- some context (as 'Text') that explains when you're supposed to
+-- get the corresponding response. 
 class ToJSON a => ToSample a where
+  {-# MINIMAL (toSample | toSamples) #-}
   toSample :: Maybe a
+  toSample = fmap snd $ listToMaybe samples
+    where samples = toSamples :: [(Text, a)]
 
-instance ToSample () where
-  toSample = Just ()
+  toSamples :: [(Text, a)]
+  toSamples = maybe [] (return . ("",)) s
+    where s = toSample :: Maybe a
 
-sampleByteString :: forall a . ToSample a => Proxy a -> Maybe ByteString
+sampleByteString :: ToSample a => Proxy a -> Maybe ByteString
 sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a)
 
+sampleByteStrings :: ToSample a => Proxy a -> [(Text, ByteString)]
+sampleByteStrings Proxy = samples & traverse._2 %~ encodePretty
+
+  where samples = toSamples :: [(Text, a)]
+
 -- | The class that helps us automatically get documentation
 --   for GET parameters.
 --
@@ -448,9 +464,13 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
           "**Response**: " :
           "" :
           (" - Status code " ++ show (resp ^. respStatus)) :
-          (resp ^. respBody &
-            maybe [" - No response body\n"]
-                  (\b -> " - Response body as below." : jsonStr b))
+          bodies
+
+          where bodies = case resp ^. respBody of
+                  []        -> [" - No response body\n"]
+                  [("", r)] -> " - Response body as below." : jsonStr r
+                  xs        ->
+                    concatMap (\(ctx, r) -> (" - " <> T.unpack ctx) : jsonStr r) xs
 
 -- * Instances
 
@@ -489,7 +509,7 @@ instance HasDocs Delete where
 
     where endpoint' = endpoint & method .~ DocDELETE
 
-          action' = action & response.respBody .~ Nothing
+          action' = action & response.respBody .~ []
                            & response.respStatus .~ 204
 
 instance ToSample a => HasDocs (Get a) where
@@ -497,7 +517,7 @@ instance ToSample a => HasDocs (Get a) where
     single endpoint' action'
 
     where endpoint' = endpoint & method .~ DocGET
-          action' = action & response.respBody .~ sampleByteString p
+          action' = action & response.respBody .~ sampleByteStrings p
           p = Proxy :: Proxy a
 
 instance (KnownSymbol sym, HasDocs sublayout)
@@ -515,7 +535,7 @@ instance ToSample a => HasDocs (Post a) where
 
     where endpoint' = endpoint & method .~ DocPOST
 
-          action' = action & response.respBody .~ sampleByteString p
+          action' = action & response.respBody .~ sampleByteStrings p
                            & response.respStatus .~ 201
 
           p = Proxy :: Proxy a
@@ -526,7 +546,7 @@ instance ToSample a => HasDocs (Put a) where
 
     where endpoint' = endpoint & method .~ DocPUT
 
-          action' = action & response.respBody .~ sampleByteString p
+          action' = action & response.respBody .~ sampleByteStrings p
                            & response.respStatus .~ 200
 
           p = Proxy :: Proxy a

From 71142b08d4f78d6ed2dfb335f7fa3c0312595743 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Sun, 4 Jan 2015 16:44:23 +0100
Subject: [PATCH 16/54] fix build error

---
 src/Servant/Docs.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 26f794c5..c1f4aa92 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -351,10 +351,10 @@ class ToJSON a => ToSample a where
   toSamples = maybe [] (return . ("",)) s
     where s = toSample :: Maybe a
 
-sampleByteString :: ToSample a => Proxy a -> Maybe ByteString
+sampleByteString :: forall a. ToSample a => Proxy a -> Maybe ByteString
 sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a)
 
-sampleByteStrings :: ToSample a => Proxy a -> [(Text, ByteString)]
+sampleByteStrings :: forall a. ToSample a => Proxy a -> [(Text, ByteString)]
 sampleByteStrings Proxy = samples & traverse._2 %~ encodePretty
 
   where samples = toSamples :: [(Text, a)]

From 07472ccb7aec9e33e0927c8d9506b9d1f7a568b6 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Sun, 4 Jan 2015 16:53:02 +0100
Subject: [PATCH 17/54] update the example to show off multiple-responses

---
 example/greet.hs |  5 +++++
 example/greet.md | 39 +++++++++++++++++++++++++++------------
 2 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 868a55ac..38a29292 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -39,6 +39,11 @@ instance ToParam (QueryParam "capital" Bool) where
 instance ToSample Greet where
   toSample = Just $ Greet "Hello, haskeller!"
 
+  toSamples =
+    [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")
+    , ("If you use ?capital=false", Greet "Hello, haskeller")
+    ]
+
 -- API specification
 type TestApi =
        -- GET /hello/:name?capital={true, false}  returns a Greet as JSON
diff --git a/example/greet.md b/example/greet.md
index 2191063c..284c7eeb 100644
--- a/example/greet.md
+++ b/example/greet.md
@@ -1,8 +1,7 @@
-
 POST /greet
 -----------
 
-**Request Body**:
+**Request Body**: 
 
 ``` javascript
 {
@@ -10,50 +9,66 @@ POST /greet
 }
 ```
 
-**Response**:
+**Response**: 
 
  - Status code 201
- - Response body as below.
+ - If you use ?capital=true
 
 ``` javascript
 {
-    "msg": "Hello, haskeller!"
+    "msg": "HELLO, HASKELLER"
+}
+```
+
+ - If you use ?capital=false
+
+``` javascript
+{
+    "msg": "Hello, haskeller"
 }
 ```
 
 GET /hello/:name
 ----------------
 
-**Captures**:
+**Captures**: 
 
 - *name*: name of the person to greet
 
-**GET Parameters**:
+**GET Parameters**: 
 
  - capital
      - **Values**: *true, false*
      - **Description**: Get the greeting message in uppercase (true) or not (false). Default is false.
 
 
-**Response**:
+**Response**: 
 
  - Status code 200
- - Response body as below.
+ - If you use ?capital=true
 
 ``` javascript
 {
-    "msg": "Hello, haskeller!"
+    "msg": "HELLO, HASKELLER"
+}
+```
+
+ - If you use ?capital=false
+
+``` javascript
+{
+    "msg": "Hello, haskeller"
 }
 ```
 
 DELETE /greet/:greetid
 ----------------------
 
-**Captures**:
+**Captures**: 
 
 - *greetid*: identifier of the greet msg to remove
 
-**Response**:
+**Response**: 
 
  - Status code 204
  - No response body

From 923a75afefb4c2316780d2bd73c526c4431e4b3b Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Sun, 4 Jan 2015 17:17:57 +0100
Subject: [PATCH 18/54] add a changelog

---
 CHANGELOG.md | 6 ++++++
 1 file changed, 6 insertions(+)
 create mode 100644 CHANGELOG.md

diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 00000000..ecf16c01
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,6 @@
+0.3
+---
+
+* Add the ability to display multiple responses, with some accompanying `Text` to describe the context in which we get the corresponding JSON.
+* Expose the `headers` lens
+* Represent an endpoint's path as `[String]` (previously `String`), fixing a corner case where the leading `/` would be missing.

From b7591dd7e099cc745502ac8db0e7a47df38403ac Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Sun, 4 Jan 2015 17:18:12 +0100
Subject: [PATCH 19/54] mention servant-pandoc in the readme

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 23ac3ea3..8adaf0b8 100644
--- a/README.md
+++ b/README.md
@@ -4,7 +4,7 @@
 
 ![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)
 
-Generate API docs for your *servant* webservice.
+Generate API docs for your *servant* webservice. Feel free to also take a look at [servant-pandoc](https://github.com/mpickering/servant-pandoc) which uses this package to target a broad range of output formats using the excellent **pandoc**.
 
 ## Example
 

From 44efc7ff20d156a9f9cadca59fd1e61380ffde2d Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Sun, 4 Jan 2015 17:18:40 +0100
Subject: [PATCH 20/54] bump version

---
 servant-docs.cabal | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/servant-docs.cabal b/servant-docs.cabal
index 7f7d8777..52c06b5b 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -1,5 +1,5 @@
 name:                servant-docs
-version:             0.2.1
+version:             0.3
 synopsis:            generate API docs for your servant webservice
 description:
   Library for generating API docs from a servant API definition.
@@ -9,13 +9,16 @@ license:             BSD3
 license-file:        LICENSE
 author:              Alp Mestanogullari, Sönke Hahn, Julian K. Arni
 maintainer:          alpmestan@gmail.com
-copyright:           2014 Zalora South East Asia Pte Ltd
+copyright:           2014-2015 Zalora South East Asia Pte Ltd
 category:            Web
 build-type:          Simple
 cabal-version:       >=1.10
 tested-with:         GHC >= 7.8
 homepage:            http://haskell-servant.github.io/
 Bug-reports:         http://github.com/haskell-servant/servant-docs/issues
+extra-source-files:
+  CHANGELOG.md
+  README.md
 source-repository head
   type: git
   location: http://github.com/haskell-servant/servant-docs.git

From d81704abc76cb559c90fc31c28e6488a47049638 Mon Sep 17 00:00:00 2001
From: Daniel Larsson <daniel.j.larsson@gmail.com>
Date: Tue, 6 Jan 2015 14:30:01 +0100
Subject: [PATCH 21/54] Added support for matrix parameters

---
 example/greet.hs    |  9 +++++++-
 src/Servant/Docs.hs | 53 ++++++++++++++++++++++++++++++++++-----------
 2 files changed, 48 insertions(+), 14 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 38a29292..ba44f4e1 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -36,6 +36,13 @@ instance ToParam (QueryParam "capital" Bool) where
                   "Get the greeting message in uppercase (true) or not (false). Default is false."
                   Normal
 
+instance ToParam (MatrixParam "lang" String) where
+  toParam _ =
+    DocQueryParam "lang"
+                  ["en", "sv", "fr"]
+                  "Get the greeting message selected language. Default is en."
+                  Normal
+
 instance ToSample Greet where
   toSample = Just $ Greet "Hello, haskeller!"
 
@@ -47,7 +54,7 @@ instance ToSample Greet where
 -- API specification
 type TestApi =
        -- GET /hello/:name?capital={true, false}  returns a Greet as JSON
-       "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
+       "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
 
        -- POST /greet with a Greet as JSON in the request body,
        --             returns a Greet as JSON
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 09d4e428..a228140d 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -216,6 +216,7 @@ data DocQueryParam = DocQueryParam
   , _paramKind   :: ParamKind
   } deriving (Eq, Show)
 
+
 -- | Type of GET parameter:
 --
 -- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
@@ -265,11 +266,12 @@ defResponse = Response 200 []
 -- You can tweak an 'Action' (like the default 'defAction') with these lenses
 -- to transform an action and add some information to it.
 data Action = Action
-  { _captures :: [DocCapture]        -- type collected + user supplied info
-  , _headers  :: [Text]              -- type collected
-  , _params   :: [DocQueryParam]     -- type collected + user supplied info
-  , _rqbody   :: Maybe ByteString    -- user supplied
-  , _response :: Response            -- user supplied
+  { _captures :: [DocCapture]                 -- type collected + user supplied info
+  , _headers  :: [Text]                       -- type collected
+  , _params   :: [DocQueryParam]              -- type collected + user supplied info
+  , _mxParams :: [(String, [DocQueryParam])]  -- type collected + user supplied info
+  , _rqbody   :: Maybe ByteString             -- user supplied
+  , _response :: Response                     -- user supplied
   } deriving (Eq, Show)
 
 -- Default 'Action'. Has no 'captures', no GET 'params', expects
@@ -278,12 +280,13 @@ data Action = Action
 -- Tweakable with lenses.
 --
 -- > λ> defAction
--- > Action {_captures = [], _params = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
 -- > λ> defAction & response.respStatus .~ 201
--- > Action {_captures = [], _params = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
 defAction :: Action
 defAction =
   Action []
+         []
          []
          []
          Nothing
@@ -393,6 +396,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
           replicate len '-' :
           "" :
           capturesStr (action ^. captures) ++
+          mxParamsStr (action ^. mxParams) ++
           headersStr (action ^. headers) ++
           paramsStr (action ^. params) ++
           rqbodyStr (action ^. rqbody) ++
@@ -413,6 +417,22 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
         captureStr cap =
           "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
 
+        mxParamsStr :: [(String, [DocQueryParam])] -> [String]
+        mxParamsStr [] = []
+        mxParamsStr l =
+          "**Matrix Parameters**: " :
+          "" :
+          map segmentStr l ++
+          "" :
+          []
+        segmentStr :: (String, [DocQueryParam]) -> String
+        segmentStr (segment, l) = unlines $
+          ("**" ++ segment ++ "**: ") :
+          "" :
+          map paramStr l ++
+          "" :
+          []
+
         headersStr :: [Text] -> [String]
         headersStr [] = []
         headersStr l = [""] ++ map headerStr l ++ [""]
@@ -584,15 +604,23 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
           action' = over params (|> toParam paramP) action
 
 
-instance (KnownSymbol sym, {- ToParam (MatrixParam sym a), -} HasDocs sublayout)
+instance (KnownSymbol sym, ToParam (MatrixParam sym a), HasDocs sublayout)
       => HasDocs (MatrixParam sym a :> sublayout) where
 
   docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint', action)
+    docsFor sublayoutP (endpoint', action')
 
     where sublayoutP = Proxy :: Proxy sublayout
+          paramP = Proxy :: Proxy (MatrixParam sym a)
+          segment = endpoint ^. (path._last)
+          segment' = action ^. (mxParams._last._1)
+          endpoint' = over (path._last) (\p -> p ++ ";" ++ symbolVal symP ++ "=<value>") endpoint
 
-          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          action' = if segment' /= segment
+                    -- This is the first matrix parameter for this segment, insert a new entry into the mxParams list
+                    then over mxParams (|> (segment, [toParam paramP])) action
+                    -- We've already inserted a matrix parameter for this segment, append to the existing list
+                    else action & mxParams._last._2 <>~ [toParam paramP]
           symP = Proxy :: Proxy sym
 
 
@@ -603,8 +631,7 @@ instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout
     docsFor sublayoutP (endpoint', action)
 
     where sublayoutP = Proxy :: Proxy sublayout
-
-          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP ++ "=<value>"]) endpoint
           symP = Proxy :: Proxy sym
 
 
@@ -616,7 +643,7 @@ instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
 
     where sublayoutP = Proxy :: Proxy sublayout
 
-          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint
           symP = Proxy :: Proxy sym
 
 

From 62f8a7f0900d6dd89950c8a544324c59ed9aafe4 Mon Sep 17 00:00:00 2001
From: Daniel Larsson <daniel.j.larsson@gmail.com>
Date: Thu, 1 Jan 2015 23:42:06 +0100
Subject: [PATCH 22/54] Initial support for matrix parameters. Not complete,
 not sure how to document them yet, since documentation is focused on
 endpoints, not individual path fragments.

---
 src/Servant/Docs.hs | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index c1f4aa92..09d4e428 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -583,6 +583,43 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
           paramP = Proxy :: Proxy (QueryFlag sym)
           action' = over params (|> toParam paramP) action
 
+
+instance (KnownSymbol sym, {- ToParam (MatrixParam sym a), -} HasDocs sublayout)
+      => HasDocs (MatrixParam sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action)
+
+    where sublayoutP = Proxy :: Proxy sublayout
+
+          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          symP = Proxy :: Proxy sym
+
+
+instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout)
+      => HasDocs (MatrixParams sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action)
+
+    where sublayoutP = Proxy :: Proxy sublayout
+
+          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          symP = Proxy :: Proxy sym
+
+
+instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
+      => HasDocs (MatrixFlag sym :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action)
+
+    where sublayoutP = Proxy :: Proxy sublayout
+
+          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          symP = Proxy :: Proxy sym
+
+
 instance HasDocs Raw where
   docsFor _proxy (endpoint, action) =
     single endpoint action

From c4f7735de8b25a9901bd278808ef63c40d44558f Mon Sep 17 00:00:00 2001
From: Daniel Larsson <daniel.j.larsson@gmail.com>
Date: Tue, 6 Jan 2015 14:30:01 +0100
Subject: [PATCH 23/54] Added support for matrix parameters

---
 example/greet.hs    |  9 +++++++-
 src/Servant/Docs.hs | 53 ++++++++++++++++++++++++++++++++++-----------
 2 files changed, 48 insertions(+), 14 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 38a29292..ba44f4e1 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -36,6 +36,13 @@ instance ToParam (QueryParam "capital" Bool) where
                   "Get the greeting message in uppercase (true) or not (false). Default is false."
                   Normal
 
+instance ToParam (MatrixParam "lang" String) where
+  toParam _ =
+    DocQueryParam "lang"
+                  ["en", "sv", "fr"]
+                  "Get the greeting message selected language. Default is en."
+                  Normal
+
 instance ToSample Greet where
   toSample = Just $ Greet "Hello, haskeller!"
 
@@ -47,7 +54,7 @@ instance ToSample Greet where
 -- API specification
 type TestApi =
        -- GET /hello/:name?capital={true, false}  returns a Greet as JSON
-       "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
+       "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
 
        -- POST /greet with a Greet as JSON in the request body,
        --             returns a Greet as JSON
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 09d4e428..a228140d 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -216,6 +216,7 @@ data DocQueryParam = DocQueryParam
   , _paramKind   :: ParamKind
   } deriving (Eq, Show)
 
+
 -- | Type of GET parameter:
 --
 -- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
@@ -265,11 +266,12 @@ defResponse = Response 200 []
 -- You can tweak an 'Action' (like the default 'defAction') with these lenses
 -- to transform an action and add some information to it.
 data Action = Action
-  { _captures :: [DocCapture]        -- type collected + user supplied info
-  , _headers  :: [Text]              -- type collected
-  , _params   :: [DocQueryParam]     -- type collected + user supplied info
-  , _rqbody   :: Maybe ByteString    -- user supplied
-  , _response :: Response            -- user supplied
+  { _captures :: [DocCapture]                 -- type collected + user supplied info
+  , _headers  :: [Text]                       -- type collected
+  , _params   :: [DocQueryParam]              -- type collected + user supplied info
+  , _mxParams :: [(String, [DocQueryParam])]  -- type collected + user supplied info
+  , _rqbody   :: Maybe ByteString             -- user supplied
+  , _response :: Response                     -- user supplied
   } deriving (Eq, Show)
 
 -- Default 'Action'. Has no 'captures', no GET 'params', expects
@@ -278,12 +280,13 @@ data Action = Action
 -- Tweakable with lenses.
 --
 -- > λ> defAction
--- > Action {_captures = [], _params = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
 -- > λ> defAction & response.respStatus .~ 201
--- > Action {_captures = [], _params = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
 defAction :: Action
 defAction =
   Action []
+         []
          []
          []
          Nothing
@@ -393,6 +396,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
           replicate len '-' :
           "" :
           capturesStr (action ^. captures) ++
+          mxParamsStr (action ^. mxParams) ++
           headersStr (action ^. headers) ++
           paramsStr (action ^. params) ++
           rqbodyStr (action ^. rqbody) ++
@@ -413,6 +417,22 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
         captureStr cap =
           "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
 
+        mxParamsStr :: [(String, [DocQueryParam])] -> [String]
+        mxParamsStr [] = []
+        mxParamsStr l =
+          "**Matrix Parameters**: " :
+          "" :
+          map segmentStr l ++
+          "" :
+          []
+        segmentStr :: (String, [DocQueryParam]) -> String
+        segmentStr (segment, l) = unlines $
+          ("**" ++ segment ++ "**: ") :
+          "" :
+          map paramStr l ++
+          "" :
+          []
+
         headersStr :: [Text] -> [String]
         headersStr [] = []
         headersStr l = [""] ++ map headerStr l ++ [""]
@@ -584,15 +604,23 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
           action' = over params (|> toParam paramP) action
 
 
-instance (KnownSymbol sym, {- ToParam (MatrixParam sym a), -} HasDocs sublayout)
+instance (KnownSymbol sym, ToParam (MatrixParam sym a), HasDocs sublayout)
       => HasDocs (MatrixParam sym a :> sublayout) where
 
   docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint', action)
+    docsFor sublayoutP (endpoint', action')
 
     where sublayoutP = Proxy :: Proxy sublayout
+          paramP = Proxy :: Proxy (MatrixParam sym a)
+          segment = endpoint ^. (path._last)
+          segment' = action ^. (mxParams._last._1)
+          endpoint' = over (path._last) (\p -> p ++ ";" ++ symbolVal symP ++ "=<value>") endpoint
 
-          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          action' = if segment' /= segment
+                    -- This is the first matrix parameter for this segment, insert a new entry into the mxParams list
+                    then over mxParams (|> (segment, [toParam paramP])) action
+                    -- We've already inserted a matrix parameter for this segment, append to the existing list
+                    else action & mxParams._last._2 <>~ [toParam paramP]
           symP = Proxy :: Proxy sym
 
 
@@ -603,8 +631,7 @@ instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout
     docsFor sublayoutP (endpoint', action)
 
     where sublayoutP = Proxy :: Proxy sublayout
-
-          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP ++ "=<value>"]) endpoint
           symP = Proxy :: Proxy sym
 
 
@@ -616,7 +643,7 @@ instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
 
     where sublayoutP = Proxy :: Proxy sublayout
 
-          endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint
+          endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint
           symP = Proxy :: Proxy sym
 
 

From aa64d7a0bfec0d5c91631e7559f071f292f059a0 Mon Sep 17 00:00:00 2001
From: Christian Marie <christian@ponies.io>
Date: Fri, 23 Jan 2015 12:19:37 +1100
Subject: [PATCH 24/54] Add DocIntro and DocNote types to allow extra docs

This commit provides a way for a user to add information to either the
beginning of the output, and for a HasDoc instance to add extra sections to an
endpoint.

See example/greet.hs for usage of the Intro type.
---
 example/greet.hs    |  22 ++++++--
 example/greet.md    |  33 +++++++-----
 src/Servant/Docs.hs | 121 +++++++++++++++++++++++++++++++++++++++-----
 3 files changed, 146 insertions(+), 30 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 38a29292..1bb36c4a 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -6,7 +6,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 import Data.Aeson
 import Data.Proxy
-import Data.Text
+import Data.Text(Text)
 import GHC.Generics
 import Servant.API
 import Servant.Docs
@@ -44,6 +44,17 @@ instance ToSample Greet where
     , ("If you use ?capital=false", Greet "Hello, haskeller")
     ]
 
+instance ToIntro "on proper introductions" where
+  toIntro _ = DocIntro "On proper introductions." -- The title
+    [ "Hello there."
+    , "As documentation is usually written for humans, it's often useful \
+      \to introduce concepts with a few words." ] -- Elements are paragraphs
+
+instance ToIntro "on zebras" where
+  toIntro _ = DocIntro "This title is below the last"
+    [ "You'll also note that multiple intros are possible." ]
+
+
 -- API specification
 type TestApi =
        -- GET /hello/:name?capital={true, false}  returns a Greet as JSON
@@ -56,14 +67,17 @@ type TestApi =
        -- DELETE /greet/:greetid
   :<|> "greet" :> Capture "greetid" Text :> Delete
 
-testApi :: Proxy TestApi
-testApi = Proxy
+type IntroducedApi =
+    Intro "on proper introductions" :> Intro "on zebras" :> TestApi
+
+introducedApi :: Proxy IntroducedApi
+introducedApi = Proxy
 
 -- Generate the data that lets us have API docs. This
 -- is derived from the type as well as from
 -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
 docsGreet :: API
-docsGreet = docs testApi
+docsGreet = docs introducedApi
 
 main :: IO ()
 main = putStrLn $ markdown docsGreet
diff --git a/example/greet.md b/example/greet.md
index 284c7eeb..fa870ac5 100644
--- a/example/greet.md
+++ b/example/greet.md
@@ -1,7 +1,16 @@
-POST /greet
------------
+#### On proper introductions.
 
-**Request Body**: 
+Hello there.
+
+As documentation is usually written for humans, it's often useful to introduce concepts with a few words.
+
+#### This title is below the last
+
+You'll also note that multiple intros are possible.
+
+## POST /greet
+
+#### Request Body:
 
 ``` javascript
 {
@@ -9,7 +18,7 @@ POST /greet
 }
 ```
 
-**Response**: 
+#### Response:
 
  - Status code 201
  - If you use ?capital=true
@@ -28,21 +37,20 @@ POST /greet
 }
 ```
 
-GET /hello/:name
-----------------
+## GET /hello/:name
 
-**Captures**: 
+#### Captures:
 
 - *name*: name of the person to greet
 
-**GET Parameters**: 
+#### GET Parameters:
 
  - capital
      - **Values**: *true, false*
      - **Description**: Get the greeting message in uppercase (true) or not (false). Default is false.
 
 
-**Response**: 
+#### Response:
 
  - Status code 200
  - If you use ?capital=true
@@ -61,14 +69,13 @@ GET /hello/:name
 }
 ```
 
-DELETE /greet/:greetid
-----------------------
+## DELETE /greet/:greetid
 
-**Captures**: 
+#### Captures:
 
 - *greetid*: identifier of the greet msg to remove
 
-**Response**: 
+#### Response:
 
  - Status code 204
  - No response body
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index c1f4aa92..0c35a89b 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeOperators #-}
@@ -91,6 +92,7 @@ module Servant.Docs
   , sampleByteStrings
   , ToParam(..)
   , ToCapture(..)
+  , ToIntro(..)
 
   , -- * ADTs to represent an 'API'
     Method(..)
@@ -98,8 +100,10 @@ module Servant.Docs
   , API, emptyAPI
   , DocCapture(..), capSymbol, capDesc
   , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
+  , DocNote(..), noteTitle, noteBody
+  , DocIntro(..), Intro
   , Response, respStatus, respBody, defResponse
-  , Action, captures, headers, params, rqbody, response, defAction
+  , Action, captures, headers, notes, params, rqbody, response, defAction
   , single
 
   , -- * Useful modules when defining your doc printers
@@ -110,6 +114,7 @@ module Servant.Docs
 import Control.Lens hiding (Action)
 import Data.Aeson
 import Data.Aeson.Encode.Pretty (encodePretty)
+import Data.Ord(comparing)
 import Data.ByteString.Lazy.Char8 (ByteString)
 import Data.Hashable
 import Data.HashMap.Strict (HashMap)
@@ -188,12 +193,36 @@ defEndpoint = Endpoint [] DocGET
 
 instance Hashable Endpoint
 
--- | Our API type, a good old hashmap from 'Endpoint' to 'Action'
-type API = HashMap Endpoint Action
+-- | Our API documentation type, a product of top-level information and a good
+-- old hashmap from 'Endpoint' to 'Action'
+data API = API
+  { _apiIntros    :: [DocIntro]
+  , _apiEndpoints :: HashMap Endpoint Action
+  } deriving (Eq, Show)
+
+instance Monoid API where
+    API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2)
+    mempty = API mempty mempty
+
+-- | A way for a developer to insert an introductory paragraph manually. This
+-- is not to be used in server or client facing API types.
+--
+-- Example:
+--
+-- > type OurAPI = "users" :> Get [User]
+-- > type IntroducedAPI = Intro "of human bondage" :> OurAPI
+-- >
+-- > instance ToIntro "of human bondage" where
+-- >    toIntro = DocIntro "A title for the intro section"
+-- >      [ "A blob of text that will be at the top."
+-- >      , "List elements are paragraphs."
+-- >      ]
+--
+data Intro (name :: Symbol)
 
 -- | An empty 'API'
 emptyAPI :: API
-emptyAPI = HM.empty
+emptyAPI = mempty
 
 -- | A type to represent captures. Holds the name of the capture
 --   and a description.
@@ -216,6 +245,26 @@ data DocQueryParam = DocQueryParam
   , _paramKind   :: ParamKind
   } deriving (Eq, Show)
 
+-- | An introductory paragraph for your documentation. You can attach these
+-- with the 'Intro' type.
+--
+data DocIntro = DocIntro
+  { _introTitle :: String   -- ^ Appears above the intro blob
+  , _introBody  :: [String] -- ^ Each String is a paragraph.
+  } deriving (Eq, Show)
+
+instance Ord DocIntro where
+    compare = comparing _introTitle
+
+-- | A type to represent extra notes that may be attached to an 'Action'.
+--
+-- This is intended to be used when writing your own HasDocs instances to
+-- add extra sections to your endpoint's documentation.
+data DocNote = DocNote
+  { _noteTitle :: String
+  , _noteBody  :: [String]
+  } deriving (Eq, Show)
+
 -- | Type of GET parameter:
 --
 -- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
@@ -268,6 +317,7 @@ data Action = Action
   { _captures :: [DocCapture]        -- type collected + user supplied info
   , _headers  :: [Text]              -- type collected
   , _params   :: [DocQueryParam]     -- type collected + user supplied info
+  , _notes    :: [DocNote]           -- user supplied
   , _rqbody   :: Maybe ByteString    -- user supplied
   , _response :: Response            -- user supplied
   } deriving (Eq, Show)
@@ -284,6 +334,7 @@ data Action = Action
 defAction :: Action
 defAction =
   Action []
+         []
          []
          []
          Nothing
@@ -293,12 +344,15 @@ defAction =
 --   'API' is a 'Monoid', so combine multiple endpoints with
 --   'mappend' or '<>'.
 single :: Endpoint -> Action -> API
-single = HM.singleton
+single e a = API mempty (HM.singleton e a)
 
 -- gimme some lenses
+makeLenses ''API
 makeLenses ''Endpoint
 makeLenses ''DocCapture
 makeLenses ''DocQueryParam
+makeLenses ''DocIntro
+makeLenses ''DocNote
 makeLenses ''Response
 makeLenses ''Action
 
@@ -382,16 +436,26 @@ class ToParam t where
 class ToCapture c where
   toCapture :: Proxy c -> DocCapture
 
+-- | The class to define the contents of an 'Intro'
+-- Example of an instance:
+--
+-- > instance ToIntro "an intro" where
+-- >   toIntro _ = DocIntro "This is some text"
+class ToIntro (intro :: Symbol) where
+    toIntro :: Proxy intro -> DocIntro
+
 -- | Generate documentation in Markdown format for
 --   the given 'API'.
 markdown :: API -> String
-markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
+markdown api = unlines $
+       introsStr (api ^. apiIntros)
+    ++ (concatMap (uncurry printEndpoint) . HM.toList $ api ^. apiEndpoints)
 
   where printEndpoint :: Endpoint -> Action -> [String]
         printEndpoint endpoint action =
           str :
-          replicate len '-' :
           "" :
+          notesStr (action ^. notes) ++
           capturesStr (action ^. captures) ++
           headersStr (action ^. headers) ++
           paramsStr (action ^. params) ++
@@ -399,13 +463,35 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
           responseStr (action ^. response) ++
           []
 
-          where str = show (endpoint^.method) ++ " " ++ showPath (endpoint^.path)
-                len = length str
+          where str = "## " ++ show (endpoint^.method)
+                    ++ " " ++ showPath (endpoint^.path)
+
+        introsStr :: [DocIntro] -> [String]
+        introsStr = concatMap introStr
+
+        introStr :: DocIntro -> [String]
+        introStr i =
+            ("#### " ++ i ^. introTitle) :
+            "" :
+            intersperse ""  (i ^. introBody) ++
+            "" :
+            []
+
+        notesStr :: [DocNote] -> [String]
+        notesStr = concatMap noteStr
+
+        noteStr :: DocNote -> [String]
+        noteStr nt =
+            ("#### " ++ nt ^. noteTitle) :
+            "" :
+            intersperse "" (nt ^. noteBody) ++
+            "" :
+            []
 
         capturesStr :: [DocCapture] -> [String]
         capturesStr [] = []
         capturesStr l =
-          "**Captures**: " :
+          "#### Captures:" :
           "" :
           map captureStr l ++
           "" :
@@ -423,7 +509,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
         paramsStr :: [DocQueryParam] -> [String]
         paramsStr [] = []
         paramsStr l =
-          "**GET Parameters**: " :
+          "#### GET Parameters:" :
           "" :
           map paramStr l ++
           "" :
@@ -448,7 +534,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
         rqbodyStr :: Maybe ByteString -> [String]
         rqbodyStr Nothing = []
         rqbodyStr (Just b) =
-          "**Request Body**: " :
+          "#### Request Body:" :
           jsonStr b
 
         jsonStr b =
@@ -461,7 +547,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
 
         responseStr :: Response -> [String]
         responseStr resp =
-          "**Response**: " :
+          "#### Response:" :
           "" :
           (" - Status code " ++ show (resp ^. respStatus)) :
           bodies
@@ -607,6 +693,15 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh
           endpoint' = endpoint & path <>~ [symbolVal pa]
           pa = Proxy :: Proxy path
 
+instance (KnownSymbol intro, HasDocs sublayout, ToIntro intro)
+      => HasDocs (Intro intro :> sublayout) where
+
+  docsFor Proxy x =
+    docsFor sublayoutP x & apiIntros %~ (toIntro intro <|)
+    where sublayoutP = Proxy :: Proxy sublayout
+          intro :: Proxy intro
+          intro = Proxy
+
 {-
 
 -- | Serve your API's docs as markdown embedded in an html \<pre> tag.

From b85a90c4f5c2cc64f10474916c68d6c7bce54acc Mon Sep 17 00:00:00 2001
From: Christian Marie <christian@ponies.io>
Date: Fri, 30 Jan 2015 15:45:00 +1100
Subject: [PATCH 25/54] Add docsWithIntros function, update documentation

---
 example/greet.hs    |  26 ++++----
 src/Servant/Docs.hs | 143 +++++++++++++++++++++++---------------------
 2 files changed, 89 insertions(+), 80 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 1bb36c4a..95588deb 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -14,7 +14,7 @@ import Servant.Docs
 -- * Example
 
 -- | A greet message data type
-newtype Greet = Greet { msg :: Text }
+newtype Greet = Greet Text
   deriving (Generic, Show)
 
 instance FromJSON Greet
@@ -33,7 +33,8 @@ instance ToParam (QueryParam "capital" Bool) where
   toParam _ =
     DocQueryParam "capital"
                   ["true", "false"]
-                  "Get the greeting message in uppercase (true) or not (false). Default is false."
+                  "Get the greeting message in uppercase (true) or not (false).\
+                  \Default is false."
                   Normal
 
 instance ToSample Greet where
@@ -44,14 +45,14 @@ instance ToSample Greet where
     , ("If you use ?capital=false", Greet "Hello, haskeller")
     ]
 
-instance ToIntro "on proper introductions" where
-  toIntro _ = DocIntro "On proper introductions." -- The title
+intro1 :: DocIntro
+intro1 = DocIntro "On proper introductions." -- The title
     [ "Hello there."
     , "As documentation is usually written for humans, it's often useful \
       \to introduce concepts with a few words." ] -- Elements are paragraphs
 
-instance ToIntro "on zebras" where
-  toIntro _ = DocIntro "This title is below the last"
+intro2 :: DocIntro
+intro2 = DocIntro "This title is below the last"
     [ "You'll also note that multiple intros are possible." ]
 
 
@@ -67,17 +68,18 @@ type TestApi =
        -- DELETE /greet/:greetid
   :<|> "greet" :> Capture "greetid" Text :> Delete
 
-type IntroducedApi =
-    Intro "on proper introductions" :> Intro "on zebras" :> TestApi
-
-introducedApi :: Proxy IntroducedApi
-introducedApi = Proxy
+testApi :: Proxy TestApi
+testApi = Proxy
 
 -- Generate the data that lets us have API docs. This
 -- is derived from the type as well as from
 -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
+--
+-- If you didn't want intros you could just call:
+--
+-- > docs testAPI
 docsGreet :: API
-docsGreet = docs introducedApi
+docsGreet = docsWithIntros [intro1, intro2] testApi
 
 main :: IO ()
 main = putStrLn $ markdown docsGreet
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 0c35a89b..77000510 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -15,7 +15,12 @@
 --
 -- @docs :: 'HasDocs' api => 'Proxy' api -> 'API'@
 --
--- You can then call 'markdown' on it:
+-- Alternately, if you wish to add one or more introductions to your
+-- documentation, use 'docsWithIntros':
+--
+-- @docsWithIntros :: 'HasDocs' api => [DocIntro] -> 'Proxy' api -> 'API'@
+--
+-- You can then call 'markdown' on the 'API' value:
 --
 -- @markdown :: 'API' -> String@
 --
@@ -30,61 +35,92 @@
 -- markdown pretty printer in action:
 --
 -- > {-# LANGUAGE DataKinds #-}
--- > {-# LANGUAGE PolyKinds #-}
--- > {-# LANGUAGE TypeFamilies #-}
 -- > {-# LANGUAGE DeriveGeneric #-}
 -- > {-# LANGUAGE TypeOperators #-}
 -- > {-# LANGUAGE FlexibleInstances #-}
 -- > {-# LANGUAGE OverloadedStrings #-}
--- >
+-- > {-# OPTIONS_GHC -fno-warn-orphans #-}
+-- > import Data.Aeson
 -- > import Data.Proxy
--- > import Data.Text
--- > import Servant
+-- > import Data.Text(Text)
+-- > import GHC.Generics
+-- > import Servant.API
+-- > import Servant.Docs
 -- >
--- > -- our type for a Greeting message
--- > data Greet = Greet { _msg :: Text }
+-- > -- * Example
+-- >
+-- > -- | A greet message data type
+-- > newtype Greet = Greet Text
 -- >   deriving (Generic, Show)
 -- >
--- > -- we get our JSON serialization for free
 -- > instance FromJSON Greet
 -- > instance ToJSON Greet
 -- >
--- > -- we provide a sample value for the 'Greet' type
--- > instance ToSample Greet where
--- >   toSample = Just g
--- >
--- >     where g = Greet "Hello, haskeller!"
--- >
--- > instance ToParam (QueryParam "capital" Bool) where
--- >   toParam _ =
--- >     DocQueryParam "capital"
--- >                   ["true", "false"]
--- >                   "Get the greeting message in uppercase (true) or not (false). Default is false."
--- >
+-- > -- We add some useful annotations to our captures,
+-- > -- query parameters and request body to make the docs
+-- > -- really helpful.
 -- > instance ToCapture (Capture "name" Text) where
 -- >   toCapture _ = DocCapture "name" "name of the person to greet"
 -- >
 -- > instance ToCapture (Capture "greetid" Text) where
 -- >   toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
 -- >
+-- > instance ToParam (QueryParam "capital" Bool) where
+-- >   toParam _ =
+-- >     DocQueryParam "capital"
+-- >                   ["true", "false"]
+-- >                   "Get the greeting message in uppercase (true) or not (false).\
+-- >                   \Default is false."
+-- >                   Normal
+-- >
+-- > instance ToSample Greet where
+-- >   toSample = Just $ Greet "Hello, haskeller!"
+-- >
+-- >   toSamples =
+-- >     [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")
+-- >     , ("If you use ?capital=false", Greet "Hello, haskeller")
+-- >     ]
+-- >
+-- > intro1 :: DocIntro
+-- > intro1 = DocIntro "On proper introductions." -- The title
+-- >     [ "Hello there."
+-- >     , "As documentation is usually written for humans, it's often useful \
+-- >       \to introduce concepts with a few words." ] -- Elements are paragraphs
+-- >
+-- > intro2 :: DocIntro
+-- > intro2 = DocIntro "This title is below the last"
+-- >     [ "You'll also note that multiple intros are possible." ]
+-- >
+-- >
 -- > -- API specification
 -- > type TestApi =
+-- >        -- GET /hello/:name?capital={true, false}  returns a Greet as JSON
 -- >        "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
--- >   :<|> "greet" :> RQBody Greet :> Post Greet
--- >   :<|> "delete" :> Capture "greetid" Text :> Delete
+-- >
+-- >        -- POST /greet with a Greet as JSON in the request body,
+-- >        --             returns a Greet as JSON
+-- >   :<|> "greet" :> ReqBody Greet :> Post Greet
+-- >
+-- >        -- DELETE /greet/:greetid
+-- >   :<|> "greet" :> Capture "greetid" Text :> Delete
 -- >
 -- > testApi :: Proxy TestApi
 -- > testApi = Proxy
 -- >
--- > -- Generate the Documentation's ADT
--- > greetDocs :: API
--- > greetDocs = docs testApi
--- >
+-- > -- Generate the data that lets us have API docs. This
+-- > -- is derived from the type as well as from
+-- > -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
+-- > --
+-- > -- If you didn't want intros you could just call:
+-- > --
+-- > -- > docs testAPI
+-- > docsGreet :: API
+-- > docsGreet = docsWithIntros [intro1, intro2] testApi
 -- > main :: IO ()
--- > main = putStrLn $ markdown greetDocs
+-- > main = putStrLn $ markdown docsGreet
 module Servant.Docs
   ( -- * 'HasDocs' class and key functions
-    HasDocs(..), docs, markdown
+    HasDocs(..), docs, docsWithIntros, markdown
 
   , -- * Classes you need to implement for your types
     ToSample(..)
@@ -92,7 +128,6 @@ module Servant.Docs
   , sampleByteStrings
   , ToParam(..)
   , ToCapture(..)
-  , ToIntro(..)
 
   , -- * ADTs to represent an 'API'
     Method(..)
@@ -101,7 +136,7 @@ module Servant.Docs
   , DocCapture(..), capSymbol, capDesc
   , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
   , DocNote(..), noteTitle, noteBody
-  , DocIntro(..), Intro
+  , DocIntro(..)
   , Response, respStatus, respBody, defResponse
   , Action, captures, headers, notes, params, rqbody, response, defAction
   , single
@@ -204,22 +239,6 @@ instance Monoid API where
     API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2)
     mempty = API mempty mempty
 
--- | A way for a developer to insert an introductory paragraph manually. This
--- is not to be used in server or client facing API types.
---
--- Example:
---
--- > type OurAPI = "users" :> Get [User]
--- > type IntroducedAPI = Intro "of human bondage" :> OurAPI
--- >
--- > instance ToIntro "of human bondage" where
--- >    toIntro = DocIntro "A title for the intro section"
--- >      [ "A blob of text that will be at the top."
--- >      , "List elements are paragraphs."
--- >      ]
---
-data Intro (name :: Symbol)
-
 -- | An empty 'API'
 emptyAPI :: API
 emptyAPI = mempty
@@ -245,9 +264,8 @@ data DocQueryParam = DocQueryParam
   , _paramKind   :: ParamKind
   } deriving (Eq, Show)
 
--- | An introductory paragraph for your documentation. You can attach these
--- with the 'Intro' type.
---
+-- | An introductory paragraph for your documentation. You can pass these to
+-- 'docsWithIntros'.
 data DocIntro = DocIntro
   { _introTitle :: String   -- ^ Appears above the intro blob
   , _introBody  :: [String] -- ^ Each String is a paragraph.
@@ -356,10 +374,16 @@ makeLenses ''DocNote
 makeLenses ''Response
 makeLenses ''Action
 
--- | Generate the docs for a given API that implements 'HasDocs'.
+-- | Generate the docs for a given API that implements 'HasDocs'. This is the
+-- default way to create documentation.
 docs :: HasDocs layout => Proxy layout -> API
 docs p = docsFor p (defEndpoint, defAction)
 
+-- | Generate the docs for a given API that implements 'HasDocs' with with any
+-- number of introduction(s)
+docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
+docsWithIntros intros p = docs p & apiIntros <>~ intros
+
 -- | The class that abstracts away the impact of API combinators
 --   on documentation generation.
 class HasDocs layout where
@@ -436,14 +460,6 @@ class ToParam t where
 class ToCapture c where
   toCapture :: Proxy c -> DocCapture
 
--- | The class to define the contents of an 'Intro'
--- Example of an instance:
---
--- > instance ToIntro "an intro" where
--- >   toIntro _ = DocIntro "This is some text"
-class ToIntro (intro :: Symbol) where
-    toIntro :: Proxy intro -> DocIntro
-
 -- | Generate documentation in Markdown format for
 --   the given 'API'.
 markdown :: API -> String
@@ -693,15 +709,6 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh
           endpoint' = endpoint & path <>~ [symbolVal pa]
           pa = Proxy :: Proxy path
 
-instance (KnownSymbol intro, HasDocs sublayout, ToIntro intro)
-      => HasDocs (Intro intro :> sublayout) where
-
-  docsFor Proxy x =
-    docsFor sublayoutP x & apiIntros %~ (toIntro intro <|)
-    where sublayoutP = Proxy :: Proxy sublayout
-          intro :: Proxy intro
-          intro = Proxy
-
 {-
 
 -- | Serve your API's docs as markdown embedded in an html \<pre> tag.

From a008e08dd17a09bf3e2538847d4843cd66b8bccd Mon Sep 17 00:00:00 2001
From: Christian Marie <christian@ponies.io>
Date: Sat, 7 Feb 2015 15:17:39 +1100
Subject: [PATCH 26/54] Add initial mockup of general extra info API

---
 example/greet.hs    | 10 ++++++-
 src/Servant/Docs.hs | 63 ++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 69 insertions(+), 4 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 44f9a69a..b24319f7 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -78,6 +78,14 @@ type TestApi =
 testApi :: Proxy TestApi
 testApi = Proxy
 
+extras :: ExtraInfo TestApi
+extras =
+    safeInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
+             defAction & headers <>~ ["unicorns"]
+                       & notes   <>~ [ DocNote "Title" ["This is some text"]
+                                     , DocNote "Second secton" ["And some more"]
+                                     ]
+
 -- Generate the data that lets us have API docs. This
 -- is derived from the type as well as from
 -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
@@ -86,7 +94,7 @@ testApi = Proxy
 --
 -- > docs testAPI
 docsGreet :: API
-docsGreet = docsWithIntros [intro1, intro2] testApi
+docsGreet = docsWith [intro1, intro2] extras testApi
 
 main :: IO ()
 main = putStrLn $ markdown docsGreet
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 6a4fad31..a512919d 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -8,6 +8,9 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE PolyKinds #-}
 
 -------------------------------------------------------------------------------
 -- | This module lets you get API docs for free. It lets generate
@@ -128,7 +131,9 @@
 -- > main = putStrLn $ markdown docsGreet
 module Servant.Docs
   ( -- * 'HasDocs' class and key functions
-    HasDocs(..), docs, docsWithIntros, markdown
+    HasDocs(..), docs, markdown
+    -- * Generating docs with extra information
+  , ExtraInfo(..), docsWith, docsWithIntros, safeInfo
 
   , -- * Classes you need to implement for your types
     ToSample(..)
@@ -169,7 +174,9 @@ import Data.Text (Text, pack, unpack)
 import Data.String.Conversions
 import GHC.Generics
 import GHC.TypeLits
+import GHC.Exts(Constraint)
 import Servant.API
+import Servant.Utils.Links
 
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Text           as T
@@ -343,12 +350,21 @@ data Action = Action
   { _captures :: [DocCapture]                 -- type collected + user supplied info
   , _headers  :: [Text]                       -- type collected
   , _params   :: [DocQueryParam]              -- type collected + user supplied info
-  , _notes    :: [DocNote]           -- user supplied
   , _mxParams :: [(String, [DocQueryParam])]  -- type collected + user supplied info
+  , _notes    :: [DocNote]                    -- user supplied
   , _rqbody   :: Maybe ByteString             -- user supplied
   , _response :: Response                     -- user supplied
   } deriving (Eq, Show)
 
+-- | Combine two Actions, we can't make a monoid as merging Response breaks the
+-- laws.
+--
+-- As such, we invent a non-commutative, left associative operation
+-- 'combineAction' to mush two together taking the response from the very left.
+combineAction :: Action -> Action -> Action
+Action c h p m n r resp `combineAction` Action c' h' p' m' n' r' _ =
+        Action (c <> c') (h <> h') (p <> p') (m <> m') (n <> n') (r <> r') resp
+
 -- Default 'Action'. Has no 'captures', no GET 'params', expects
 -- no request body ('rqbody') and the typical response is 'defResponse'.
 --
@@ -389,10 +405,51 @@ makeLenses ''Action
 docs :: HasDocs layout => Proxy layout -> API
 docs p = docsFor p (defEndpoint, defAction)
 
+
+newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action)
+instance Monoid (ExtraInfo a) where
+    mempty = ExtraInfo mempty
+    ExtraInfo a `mappend` ExtraInfo b =
+        ExtraInfo $ HM.unionWith combineAction a b
+
+-- | Closed type family, check if endpoint is exactly within API.
+
+-- We aren't sure what affects how an Endpoint is built up, so we require an
+-- exact match.
+type family IsIn (endpoint :: *) (api :: *) :: Constraint where
+    IsIn e (sa :<|> sb)                = Or (IsIn e sa) (IsIn e sb)
+    IsIn (e :> sa) (e :> sb)           = IsIn sa sb
+    IsIn e e                           = ()
+
+
+safeInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
+         => Proxy endpoint -> Action -> ExtraInfo layout
+safeInfo p action =
+    let api = docsFor p (defEndpoint, defAction)
+    -- Assume one endpoint, HasLink constraint means that we should only ever
+    -- point at one endpoint.
+    in ExtraInfo $ api ^. apiEndpoints & traversed .~ action
+
+-- | Generate documentation given some initial state, in which you may wish to
+-- note that certain endpoints are special in some way.
+--
+-- If you only want to add an introduction, use 'docsWithIntros'.
+--
+-- You are expected to build up the SafeMap with safeEntry
+docsWith :: HasDocs layout
+         => [DocIntro]
+         -> ExtraInfo layout
+         -> Proxy layout
+         -> API
+docsWith intros (ExtraInfo endpoints) p =
+    docs p & apiIntros <>~ intros
+           & apiEndpoints %~ HM.unionWith combineAction endpoints
+
+
 -- | Generate the docs for a given API that implements 'HasDocs' with with any
 -- number of introduction(s)
 docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
-docsWithIntros intros p = docs p & apiIntros <>~ intros
+docsWithIntros intros = docsWith intros mempty
 
 -- | The class that abstracts away the impact of API combinators
 --   on documentation generation.

From b935f2818513e82725f3402dc14967e118d4a8d9 Mon Sep 17 00:00:00 2001
From: Christian Marie <christian@ponies.io>
Date: Wed, 18 Feb 2015 12:49:08 +1100
Subject: [PATCH 27/54] Improve documentation.

I also slipped a change into the Matrix Paramters section markdown generation,
there is one less (superfluous) newline there now.
---
 example/greet.hs    | 18 ++++++++----
 example/greet.md    | 16 ++++++++--
 src/Servant/Docs.hs | 72 +++++++++++++++++++++++++++++++++------------
 3 files changed, 80 insertions(+), 26 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index b24319f7..e5d448d1 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -52,6 +52,11 @@ instance ToSample Greet where
     , ("If you use ?capital=false", Greet "Hello, haskeller")
     ]
 
+-- We define some introductory sections, these will appear at the top of the
+-- documentation.
+--
+-- We pass them in with 'docsWith', below. If you only want to add
+-- introductions, you may use 'docsWithIntros'
 intro1 :: DocIntro
 intro1 = DocIntro "On proper introductions." -- The title
     [ "Hello there."
@@ -78,8 +83,11 @@ type TestApi =
 testApi :: Proxy TestApi
 testApi = Proxy
 
-extras :: ExtraInfo TestApi
-extras =
+-- Build some extra information for the DELETE /greet/:greetid endpoint. We
+-- want to add documentation about a secret unicorn header and some extra
+-- notes.
+extra :: ExtraInfo TestApi
+extra =
     safeInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
              defAction & headers <>~ ["unicorns"]
                        & notes   <>~ [ DocNote "Title" ["This is some text"]
@@ -90,11 +98,11 @@ extras =
 -- is derived from the type as well as from
 -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
 --
--- If you didn't want intros you could just call:
+-- If you didn't want intros and extra information, you could just call:
 --
--- > docs testAPI
+-- > docs testAPI :: API
 docsGreet :: API
-docsGreet = docsWith [intro1, intro2] extras testApi
+docsGreet = docsWith [intro1, intro2] extra testApi
 
 main :: IO ()
 main = putStrLn $ markdown docsGreet
diff --git a/example/greet.md b/example/greet.md
index 948b89ed..16275e39 100644
--- a/example/greet.md
+++ b/example/greet.md
@@ -37,7 +37,7 @@ You'll also note that multiple intros are possible.
 
 - *name*: name of the person to greet
 
-#### Matrix Parameters**:
+#### Matrix Parameters:
 
 **hello**:
 
@@ -47,7 +47,6 @@ You'll also note that multiple intros are possible.
 
 
 
-
 #### GET Parameters:
 
  - capital
@@ -72,13 +71,24 @@ You'll also note that multiple intros are possible.
 
 ## DELETE /greet/:greetid
 
+#### Title
+
+This is some text
+
+#### Second secton
+
+And some more
+
 #### Captures:
 
 - *greetid*: identifier of the greet msg to remove
 
+
+- This endpoint is sensitive to the value of the **unicorns** HTTP header.
+
 #### Response:
 
- - Status code 204
+ - Status code 200
  - No response body
 
 
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index a512919d..2cd4a564 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -91,6 +91,11 @@
 -- >     , ("If you use ?capital=false", Greet "Hello, haskeller")
 -- >     ]
 -- >
+-- > -- We define some introductory sections, these will appear at the top of the
+-- > -- documentation.
+-- > --
+-- > -- We pass them in with 'docsWith', below. If you only want to add
+-- > -- introductions, you may use 'docsWithIntros'
 -- > intro1 :: DocIntro
 -- > intro1 = DocIntro "On proper introductions." -- The title
 -- >     [ "Hello there."
@@ -117,15 +122,26 @@
 -- > testApi :: Proxy TestApi
 -- > testApi = Proxy
 -- >
+-- > -- Build some extra information for the DELETE /greet/:greetid endpoint. We
+-- > -- want to add documentation about a secret unicorn header and some extra
+-- > -- notes.
+-- > extra :: ExtraInfo TestApi
+-- > extra =
+-- >     safeInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
+-- >              defAction & headers <>~ ["unicorns"]
+-- >                        & notes   <>~ [ DocNote "Title" ["This is some text"]
+-- >                                      , DocNote "Second secton" ["And some more"]
+-- >                                      ]
+-- >
 -- > -- Generate the data that lets us have API docs. This
 -- > -- is derived from the type as well as from
 -- > -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
 -- > --
--- > -- If you didn't want intros you could just call:
+-- > -- If you didn't want intros and extra information, you could just call:
 -- > --
--- > -- > docs testAPI
+-- > -- > docs testAPI :: API
 -- > docsGreet :: API
--- > docsGreet = docsWithIntros [intro1, intro2] testApi
+-- > docsGreet = docsWith [intro1, intro2] extra testApi
 -- >
 -- > main :: IO ()
 -- > main = putStrLn $ markdown docsGreet
@@ -298,6 +314,17 @@ data DocNote = DocNote
   , _noteBody  :: [String]
   } deriving (Eq, Show)
 
+-- | Type of extra information that a user may wish to "union" with their
+-- documentation.
+--
+-- These are intended to be built using safeInfo.
+-- Multiple ExtraInfo may be combined with the monoid instance.
+newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action)
+instance Monoid (ExtraInfo a) where
+    mempty = ExtraInfo mempty
+    ExtraInfo a `mappend` ExtraInfo b =
+        ExtraInfo $ HM.unionWith combineAction a b
+
 -- | Type of GET parameter:
 --
 -- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
@@ -405,13 +432,6 @@ makeLenses ''Action
 docs :: HasDocs layout => Proxy layout -> API
 docs p = docsFor p (defEndpoint, defAction)
 
-
-newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action)
-instance Monoid (ExtraInfo a) where
-    mempty = ExtraInfo mempty
-    ExtraInfo a `mappend` ExtraInfo b =
-        ExtraInfo $ HM.unionWith combineAction a b
-
 -- | Closed type family, check if endpoint is exactly within API.
 
 -- We aren't sure what affects how an Endpoint is built up, so we require an
@@ -421,6 +441,18 @@ type family IsIn (endpoint :: *) (api :: *) :: Constraint where
     IsIn (e :> sa) (e :> sb)           = IsIn sa sb
     IsIn e e                           = ()
 
+-- | Create an 'ExtraInfo' that is garunteed to be within the given API layout.
+--
+-- The safety here is to ensure that you only add custom documentation to an
+-- endpoint that actually exists within your API.
+--
+-- > extra :: ExtraInfo TestApi
+-- > extra =
+-- >     safeInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
+-- >              defAction & headers <>~ ["unicorns"]
+-- >                        & notes   <>~ [ DocNote "Title" ["This is some text"]
+-- >                                      , DocNote "Second secton" ["And some more"]
+-- >                                      ]
 
 safeInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
          => Proxy endpoint -> Action -> ExtraInfo layout
@@ -430,12 +462,18 @@ safeInfo p action =
     -- point at one endpoint.
     in ExtraInfo $ api ^. apiEndpoints & traversed .~ action
 
--- | Generate documentation given some initial state, in which you may wish to
--- note that certain endpoints are special in some way.
+-- | Generate documentation given some extra introductions (in the form of
+-- 'DocInfo') and some extra endpoint documentation (in the form of
+-- 'ExtraInfo'.
+--
+-- The extra introductions will be prepended to the top of the documentation,
+-- before the specific endpoint documentation. The extra endpoint documentation
+-- will be "unioned" with the automatically generated endpoint documentation.
+--
+-- You are expected to build up the ExtraInfo with the Monoid instance and
+-- 'safeInfo'.
 --
 -- If you only want to add an introduction, use 'docsWithIntros'.
---
--- You are expected to build up the SafeMap with safeEntry
 docsWith :: HasDocs layout
          => [DocIntro]
          -> ExtraInfo layout
@@ -485,7 +523,7 @@ class HasDocs layout where
 -- You can also instantiate this class using 'toSamples' instead of
 -- 'toSample': it lets you specify different responses along with
 -- some context (as 'Text') that explains when you're supposed to
--- get the corresponding response. 
+-- get the corresponding response.
 class ToJSON a => ToSample a where
   {-# MINIMAL (toSample | toSamples) #-}
   toSample :: Maybe a
@@ -588,9 +626,7 @@ markdown api = unlines $
         mxParamsStr l =
           "#### Matrix Parameters:" :
           "" :
-          map segmentStr l ++
-          "" :
-          []
+          map segmentStr l
         segmentStr :: (String, [DocQueryParam]) -> String
         segmentStr (segment, l) = unlines $
           ("**" ++ segment ++ "**:") :

From 3c14343b8889495eff7d0c4d7b9d1522c206b11e Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Thu, 19 Feb 2015 10:59:24 +1100
Subject: [PATCH 28/54] Add content-type params to type constructors

---
 example/greet.hs    |  4 ++--
 src/Servant/Docs.hs | 14 +++++++-------
 2 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 44f9a69a..977ee8bf 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -66,11 +66,11 @@ intro2 = DocIntro "This title is below the last"
 -- API specification
 type TestApi =
        -- GET /hello/:name?capital={true, false}  returns a Greet as JSON
-       "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
+       "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
 
        -- POST /greet with a Greet as JSON in the request body,
        --             returns a Greet as JSON
-  :<|> "greet" :> ReqBody Greet :> Post Greet
+  :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
 
        -- DELETE /greet/:greetid
   :<|> "greet" :> Capture "greetid" Text :> Delete
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 6a4fad31..7809b5a7 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -102,11 +102,11 @@
 -- > -- API specification
 -- > type TestApi =
 -- >        -- GET /hello/:name?capital={true, false}  returns a Greet as JSON
--- >        "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
+-- >        "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
 -- >
 -- >        -- POST /greet with a Greet as JSON in the request body,
 -- >        --             returns a Greet as JSON
--- >   :<|> "greet" :> ReqBody Greet :> Post Greet
+-- >   :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
 -- >
 -- >        -- DELETE /greet/:greetid
 -- >   :<|> "greet" :> Capture "greetid" Text :> Delete
@@ -154,7 +154,7 @@ module Servant.Docs
   , module Data.Monoid
   ) where
 
-import Control.Lens hiding (Action)
+import Control.Lens
 import Data.Aeson
 import Data.Aeson.Encode.Pretty (encodePretty)
 import Data.Ord(comparing)
@@ -641,7 +641,7 @@ instance HasDocs Delete where
           action' = action & response.respBody .~ []
                            & response.respStatus .~ 204
 
-instance ToSample a => HasDocs (Get a) where
+instance ToSample a => HasDocs (Get cts a) where
   docsFor Proxy (endpoint, action) =
     single endpoint' action'
 
@@ -658,7 +658,7 @@ instance (KnownSymbol sym, HasDocs sublayout)
           action' = over headers (|> headername) action
           headername = pack $ symbolVal (Proxy :: Proxy sym)
 
-instance ToSample a => HasDocs (Post a) where
+instance ToSample a => HasDocs (Post cts a) where
   docsFor Proxy (endpoint, action) =
     single endpoint' action'
 
@@ -669,7 +669,7 @@ instance ToSample a => HasDocs (Post a) where
 
           p = Proxy :: Proxy a
 
-instance ToSample a => HasDocs (Put a) where
+instance ToSample a => HasDocs (Put cts a) where
   docsFor Proxy (endpoint, action) =
     single endpoint' action'
 
@@ -761,7 +761,7 @@ instance HasDocs Raw where
     single endpoint action
 
 instance (ToSample a, HasDocs sublayout)
-      => HasDocs (ReqBody a :> sublayout) where
+      => HasDocs (ReqBody cts a :> sublayout) where
 
   docsFor Proxy (endpoint, action) =
     docsFor sublayoutP (endpoint, action')

From 6d85885b4219a80bcc21cc972dba05477350aafe Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Thu, 19 Feb 2015 12:48:10 +1100
Subject: [PATCH 29/54] Add content types to the example

---
 example/greet.hs   | 29 +++++++++++++++++++++--------
 servant-docs.cabal |  3 ++-
 2 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 977ee8bf..28b5e64f 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -1,14 +1,19 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeOperators         #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 import Data.Aeson
+import Data.Aeson.Encode.Pretty (encodePretty)
 import Data.Proxy
-import Data.Text(Text)
+import Data.Text (Text)
+import qualified Data.Text.Lazy as T
+import qualified Data.Text.Lazy.Encoding as T
 import GHC.Generics
 import Servant.API
+import Servant.API.ContentTypes
 import Servant.Docs
 
 -- * Example
@@ -20,6 +25,14 @@ newtype Greet = Greet Text
 instance FromJSON Greet
 instance ToJSON Greet
 
+instance MimeRender JSON Greet where
+    toByteString Proxy v = encodePretty v
+
+instance MimeRender HTML Greet where
+    toByteString Proxy (Greet s) = "<h1>" <> (c s) <> "</h1>"
+      where
+        c = T.encodeUtf8 . T.fromStrict
+
 -- We add some useful annotations to our captures,
 -- query parameters and request body to make the docs
 -- really helpful.
@@ -66,11 +79,11 @@ intro2 = DocIntro "This title is below the last"
 -- API specification
 type TestApi =
        -- GET /hello/:name?capital={true, false}  returns a Greet as JSON
-       "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
+       "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, HTML] Greet
 
        -- POST /greet with a Greet as JSON in the request body,
        --             returns a Greet as JSON
-  :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
+  :<|> "greet" :> ReqBody '[JSON,HTML] Greet :> Post '[JSON] Greet
 
        -- DELETE /greet/:greetid
   :<|> "greet" :> Capture "greetid" Text :> Delete
diff --git a/servant-docs.cabal b/servant-docs.cabal
index 52c06b5b..37de47c4 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -32,6 +32,7 @@ library
     , aeson-pretty < 0.8
     , bytestring
     , hashable
+    , http-media
     , lens
     , servant >= 0.2.1
     , string-conversions
@@ -46,5 +47,5 @@ executable greet-docs
   main-is: greet.hs
   hs-source-dirs: example
   ghc-options: -Wall
-  build-depends: base, aeson, servant, servant-docs, text
+  build-depends: base, aeson, aeson-pretty, servant, servant-docs, text
   default-language: Haskell2010

From dba8689acd4970780346630165d69e88155c5315 Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Thu, 19 Feb 2015 12:53:14 +1100
Subject: [PATCH 30/54] Remove redundant dependencies

---
 servant-docs.cabal | 2 --
 1 file changed, 2 deletions(-)

diff --git a/servant-docs.cabal b/servant-docs.cabal
index 37de47c4..c3b91df1 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -29,14 +29,12 @@ library
   build-depends:
       base >=4.7 && <5
     , aeson
-    , aeson-pretty < 0.8
     , bytestring
     , hashable
     , http-media
     , lens
     , servant >= 0.2.1
     , string-conversions
-    , system-filepath
     , text
     , unordered-containers
   hs-source-dirs: src

From 508b9f979136bafdd048c08c2680c5e6755a0f7d Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Thu, 19 Feb 2015 12:55:00 +1100
Subject: [PATCH 31/54] Generate docs with samples encoded in all types

Request and response body documentation now includes sample values
encoded in all supported media types.
---
 src/Servant/Docs.hs | 129 +++++++++++++++++++++++++++-----------------
 1 file changed, 80 insertions(+), 49 deletions(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 7809b5a7..a0097345 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -1,13 +1,16 @@
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TupleSections         #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
 
 -------------------------------------------------------------------------------
 -- | This module lets you get API docs for free. It lets generate
@@ -154,25 +157,27 @@ module Servant.Docs
   , module Data.Monoid
   ) where
 
+import Control.Applicative
 import Control.Lens
 import Data.Aeson
-import Data.Aeson.Encode.Pretty (encodePretty)
-import Data.Ord(comparing)
 import Data.ByteString.Lazy.Char8 (ByteString)
 import Data.Hashable
 import Data.HashMap.Strict (HashMap)
 import Data.List
-import Data.Maybe (listToMaybe)
+import Data.Maybe
 import Data.Monoid
+import Data.Ord (comparing)
 import Data.Proxy
-import Data.Text (Text, pack, unpack)
 import Data.String.Conversions
+import Data.Text (Text, pack, unpack)
 import GHC.Generics
 import GHC.TypeLits
 import Servant.API
+import Servant.API.ContentTypes
 
 import qualified Data.HashMap.Strict as HM
-import qualified Data.Text           as T
+import qualified Data.Text as T
+import qualified Network.HTTP.Media as M
 
 -- | Supported HTTP request methods
 data Method = DocDELETE -- ^ the DELETE method
@@ -315,7 +320,7 @@ data ParamKind = Normal | List | Flag
 -- > Response {_respStatus = 204, _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
 data Response = Response
   { _respStatus :: Int
-  , _respBody   :: [(Text, ByteString)]
+  , _respBody   :: [(Text, M.MediaType, ByteString)]
   } deriving (Eq, Show)
 
 -- | Default response: status code 200, no response body.
@@ -345,7 +350,7 @@ data Action = Action
   , _params   :: [DocQueryParam]              -- type collected + user supplied info
   , _notes    :: [DocNote]           -- user supplied
   , _mxParams :: [(String, [DocQueryParam])]  -- type collected + user supplied info
-  , _rqbody   :: Maybe ByteString             -- user supplied
+  , _rqbody   :: Maybe [(M.MediaType, ByteString)] -- user supplied
   , _response :: Response                     -- user supplied
   } deriving (Eq, Show)
 
@@ -428,24 +433,38 @@ class HasDocs layout where
 -- You can also instantiate this class using 'toSamples' instead of
 -- 'toSample': it lets you specify different responses along with
 -- some context (as 'Text') that explains when you're supposed to
--- get the corresponding response. 
+-- get the corresponding response.
 class ToJSON a => ToSample a where
   {-# MINIMAL (toSample | toSamples) #-}
   toSample :: Maybe a
-  toSample = fmap snd $ listToMaybe samples
+  toSample = snd <$> listToMaybe samples
     where samples = toSamples :: [(Text, a)]
 
   toSamples :: [(Text, a)]
   toSamples = maybe [] (return . ("",)) s
     where s = toSample :: Maybe a
 
-sampleByteString :: forall a. ToSample a => Proxy a -> Maybe ByteString
-sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a)
+-- | Synthesise a sample value of a type, encoded in the specified media types.
+sampleByteString
+    :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
+    => Proxy ctypes
+    -> Proxy a
+    -> Maybe [(M.MediaType, ByteString)]
+sampleByteString ctypes@Proxy Proxy =
+    fmap (amr ctypes) (toSample :: Maybe a)
 
-sampleByteStrings :: forall a. ToSample a => Proxy a -> [(Text, ByteString)]
-sampleByteStrings Proxy = samples & traverse._2 %~ encodePretty
-
-  where samples = toSamples :: [(Text, a)]
+-- | Synthesise a list of sample values of a particular type, encoded in the
+-- specified media types.
+sampleByteStrings
+    :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
+    => Proxy ctypes
+    -> Proxy a
+    -> [(Text, M.MediaType, ByteString)]
+sampleByteStrings ctypes@Proxy Proxy =
+    let samples = toSamples :: [(Text, a)]
+        ext t (a,b) = (t,a,b)
+        enc (t, s) = ext t <$> amr ctypes s
+    in concatMap enc samples
 
 -- | The class that helps us automatically get documentation
 --   for GET parameters.
@@ -574,16 +593,26 @@ markdown api = unlines $
 
           where values = param ^. paramValues
 
-        rqbodyStr :: Maybe ByteString -> [String]
+        rqbodyStr :: Maybe [(M.MediaType, ByteString)]-> [String]
         rqbodyStr Nothing = []
-        rqbodyStr (Just b) =
-          "#### Request Body:" :
-          jsonStr b
+        rqbodyStr (Just b) = concatMap formatBody b
 
-        jsonStr b =
+        formatBody (m, b) =
+          "#### Request Body: `" <> show (M.mainType m <> "/" <> M.subType m) <> "`" :
+          contentStr m b
+
+        markdownForType mime_type =
+            case (M.mainType mime_type, M.subType mime_type) of
+                ("text", "html") -> "html"
+                ("application", "xml") -> "xml"
+                ("application", "json") -> "javascript"
+                ("application", "javascript") -> "javascript"
+                (_, _) -> ""
+
+        contentStr mime_type body =
           "" :
-          "``` javascript" :
-          cs b :
+          "``` " <> markdownForType mime_type :
+          cs body :
           "```" :
           "" :
           []
@@ -597,9 +626,9 @@ markdown api = unlines $
 
           where bodies = case resp ^. respBody of
                   []        -> [" - No response body\n"]
-                  [("", r)] -> " - Response body as below." : jsonStr r
+                  [("", t, r)] -> " - Response body as below." : contentStr t r
                   xs        ->
-                    concatMap (\(ctx, r) -> (" - " <> T.unpack ctx) : jsonStr r) xs
+                    concatMap (\(ctx, t, r) -> (" - " <> T.unpack ctx) : contentStr t r) xs
 
 -- * Instances
 
@@ -641,14 +670,16 @@ instance HasDocs Delete where
           action' = action & response.respBody .~ []
                            & response.respStatus .~ 204
 
-instance ToSample a => HasDocs (Get cts a) where
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Get cts a) where
   docsFor Proxy (endpoint, action) =
     single endpoint' action'
 
     where endpoint' = endpoint & method .~ DocGET
-          action' = action & response.respBody .~ sampleByteStrings p
+          action' = action & response.respBody .~ sampleByteStrings t p
+          t = Proxy :: Proxy cts
           p = Proxy :: Proxy a
 
+
 instance (KnownSymbol sym, HasDocs sublayout)
       => HasDocs (Header sym a :> sublayout) where
   docsFor Proxy (endpoint, action) =
@@ -658,29 +689,26 @@ instance (KnownSymbol sym, HasDocs sublayout)
           action' = over headers (|> headername) action
           headername = pack $ symbolVal (Proxy :: Proxy sym)
 
-instance ToSample a => HasDocs (Post cts a) where
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Post cts a) where
   docsFor Proxy (endpoint, action) =
     single endpoint' action'
 
     where endpoint' = endpoint & method .~ DocPOST
-
-          action' = action & response.respBody .~ sampleByteStrings p
+          action' = action & response.respBody .~ sampleByteStrings t p
                            & response.respStatus .~ 201
-
+          t = Proxy :: Proxy cts
           p = Proxy :: Proxy a
 
-instance ToSample a => HasDocs (Put cts a) where
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Put cts a) where
   docsFor Proxy (endpoint, action) =
     single endpoint' action'
 
     where endpoint' = endpoint & method .~ DocPUT
-
-          action' = action & response.respBody .~ sampleByteStrings p
+          action' = action & response.respBody .~ sampleByteStrings t p
                            & response.respStatus .~ 200
-
+          t = Proxy :: Proxy cts
           p = Proxy :: Proxy a
 
-
 instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
       => HasDocs (QueryParam sym a :> sublayout) where
 
@@ -755,20 +783,23 @@ instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
           endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint
           symP = Proxy :: Proxy sym
 
-
 instance HasDocs Raw where
   docsFor _proxy (endpoint, action) =
     single endpoint action
 
-instance (ToSample a, HasDocs sublayout)
+-- TODO: We use 'AllMimeRender' here because we need to be able to show the
+-- example data. However, there's no reason to believe that the instances of
+-- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
+-- both are even defined) for any particular type.
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout)
       => HasDocs (ReqBody cts a :> sublayout) where
 
   docsFor Proxy (endpoint, action) =
     docsFor sublayoutP (endpoint, action')
 
     where sublayoutP = Proxy :: Proxy sublayout
-
-          action' = action & rqbody .~ sampleByteString p
+          action' = action & rqbody .~ sampleByteString t p
+          t = Proxy :: Proxy cts
           p = Proxy :: Proxy a
 
 instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where

From 3451dcf186a647bf05988f18d961fd11fbd608fc Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Thu, 19 Feb 2015 13:03:38 +1100
Subject: [PATCH 32/54] Use string conversions in example

---
 example/greet.hs | 9 +++------
 1 file changed, 3 insertions(+), 6 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 28b5e64f..9a5469cb 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -8,9 +8,8 @@
 import Data.Aeson
 import Data.Aeson.Encode.Pretty (encodePretty)
 import Data.Proxy
+import Data.String.Conversions
 import Data.Text (Text)
-import qualified Data.Text.Lazy as T
-import qualified Data.Text.Lazy.Encoding as T
 import GHC.Generics
 import Servant.API
 import Servant.API.ContentTypes
@@ -26,12 +25,10 @@ instance FromJSON Greet
 instance ToJSON Greet
 
 instance MimeRender JSON Greet where
-    toByteString Proxy v = encodePretty v
+    toByteString Proxy = encodePretty
 
 instance MimeRender HTML Greet where
-    toByteString Proxy (Greet s) = "<h1>" <> (c s) <> "</h1>"
-      where
-        c = T.encodeUtf8 . T.fromStrict
+    toByteString Proxy (Greet s) = "<h1>" <> cs s <> "</h1>"
 
 -- We add some useful annotations to our captures,
 -- query parameters and request body to make the docs

From d62c61224bd7e7869c436ba83bfebfdf91423bb0 Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Thu, 19 Feb 2015 13:15:25 +1100
Subject: [PATCH 33/54] Simplify encoding code slightly

---
 src/Servant/Docs.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index a0097345..2e32001f 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -462,8 +462,7 @@ sampleByteStrings
     -> [(Text, M.MediaType, ByteString)]
 sampleByteStrings ctypes@Proxy Proxy =
     let samples = toSamples :: [(Text, a)]
-        ext t (a,b) = (t,a,b)
-        enc (t, s) = ext t <$> amr ctypes s
+        enc (t, s) = (\(m,b) -> (t,m,b)) <$> amr ctypes s
     in concatMap enc samples
 
 -- | The class that helps us automatically get documentation

From f303f6176a4648f8803c4e4145f186cf50e100df Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Thu, 19 Feb 2015 13:19:29 +1100
Subject: [PATCH 34/54] Simplify encoding code slightly more

---
 src/Servant/Docs.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 2e32001f..d49ce877 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -462,7 +462,7 @@ sampleByteStrings
     -> [(Text, M.MediaType, ByteString)]
 sampleByteStrings ctypes@Proxy Proxy =
     let samples = toSamples :: [(Text, a)]
-        enc (t, s) = (\(m,b) -> (t,m,b)) <$> amr ctypes s
+        enc (t, s) = uncurry (t,,) <$> amr ctypes s
     in concatMap enc samples
 
 -- | The class that helps us automatically get documentation

From 921547da609ab696902be3b7ec309838892533fb Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Thu, 19 Feb 2015 13:23:13 +1100
Subject: [PATCH 35/54] Example now depends on string-conversions

---
 servant-docs.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/servant-docs.cabal b/servant-docs.cabal
index c3b91df1..d45cbbbf 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -45,5 +45,5 @@ executable greet-docs
   main-is: greet.hs
   hs-source-dirs: example
   ghc-options: -Wall
-  build-depends: base, aeson, aeson-pretty, servant, servant-docs, text
+  build-depends: base, aeson, aeson-pretty, servant, servant-docs, string-conversions, text
   default-language: Haskell2010

From 0daa8d27a5f067ee7bd70b0606f4698fb7a9feec Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Thu, 19 Feb 2015 15:29:04 +1100
Subject: [PATCH 36/54] Add list of supported content types to documentation

---
 src/Servant/Docs.hs | 115 ++++++++++++++++++++++++++++++--------------
 1 file changed, 79 insertions(+), 36 deletions(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index d49ce877..504b82f6 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -148,8 +148,8 @@ module Servant.Docs
   , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
   , DocNote(..), noteTitle, noteBody
   , DocIntro(..)
-  , Response, respStatus, respBody, defResponse
-  , Action, captures, headers, notes, params, rqbody, response, defAction
+  , Response, respStatus, respTypes, respBody, defResponse
+  , Action, captures, headers, notes, params, rqtypes, rqbody, response, defAction
   , single
 
   , -- * Useful modules when defining your doc printers
@@ -304,22 +304,24 @@ data DocNote = DocNote
 data ParamKind = Normal | List | Flag
   deriving (Eq, Show)
 
--- | A type to represent an HTTP response. Has an 'Int' status and
--- a 'Maybe ByteString' response body. Tweak 'defResponse' using
--- the 'respStatus' and 'respBody' lenses if you want.
+-- | A type to represent an HTTP response. Has an 'Int' status, a list of
+-- possible 'MediaType's, and a list of example 'ByteString' response bodies.
+-- Tweak 'defResponse' using the 'respStatus', 'respTypes' and 'respBody'
+-- lenses if you want.
 --
 -- If you want to respond with a non-empty response body, you'll most likely
 -- want to write a 'ToSample' instance for the type that'll be represented
--- as some JSON in the response.
+-- as encoded data in the response.
 --
--- Can be tweaked with two lenses.
+-- Can be tweaked with three lenses.
 --
 -- > λ> defResponse
--- > Response {_respStatus = 200, _respBody = []}
+-- > Response {_respStatus = 200, _respTypes = [], _respBody = []}
 -- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
--- > Response {_respStatus = 204, _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
+-- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
 data Response = Response
   { _respStatus :: Int
+  , _respTypes  :: [M.MediaType]
   , _respBody   :: [(Text, M.MediaType, ByteString)]
   } deriving (Eq, Show)
 
@@ -332,7 +334,7 @@ data Response = Response
 -- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
 -- > Response {_respStatus = 204, _respBody = Just "[]"}
 defResponse :: Response
-defResponse = Response 200 []
+defResponse = Response 200 [] []
 
 -- | A datatype that represents everything that can happen
 -- at an endpoint, with its lenses:
@@ -345,13 +347,14 @@ defResponse = Response 200 []
 -- You can tweak an 'Action' (like the default 'defAction') with these lenses
 -- to transform an action and add some information to it.
 data Action = Action
-  { _captures :: [DocCapture]                 -- type collected + user supplied info
-  , _headers  :: [Text]                       -- type collected
-  , _params   :: [DocQueryParam]              -- type collected + user supplied info
-  , _notes    :: [DocNote]           -- user supplied
-  , _mxParams :: [(String, [DocQueryParam])]  -- type collected + user supplied info
-  , _rqbody   :: Maybe [(M.MediaType, ByteString)] -- user supplied
-  , _response :: Response                     -- user supplied
+  { _captures :: [DocCapture]                -- type collected + user supplied info
+  , _headers  :: [Text]                      -- type collected
+  , _params   :: [DocQueryParam]             -- type collected + user supplied info
+  , _notes    :: [DocNote]                   -- user supplied
+  , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
+  , _rqtypes  :: [M.MediaType]               -- type collected
+  , _rqbody   :: [(M.MediaType, ByteString)] -- user supplied
+  , _response :: Response                    -- user supplied
   } deriving (Eq, Show)
 
 -- Default 'Action'. Has no 'captures', no GET 'params', expects
@@ -370,7 +373,8 @@ defAction =
          []
          []
          []
-         Nothing
+         []
+         []
          defResponse
 
 -- | Create an API that's comprised of a single endpoint.
@@ -449,9 +453,9 @@ sampleByteString
     :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
     => Proxy ctypes
     -> Proxy a
-    -> Maybe [(M.MediaType, ByteString)]
+    -> [(M.MediaType, ByteString)]
 sampleByteString ctypes@Proxy Proxy =
-    fmap (amr ctypes) (toSample :: Maybe a)
+    maybe [] (amr ctypes) (toSample :: Maybe a)
 
 -- | Synthesise a list of sample values of a particular type, encoded in the
 -- specified media types.
@@ -465,6 +469,25 @@ sampleByteStrings ctypes@Proxy Proxy =
         enc (t, s) = uncurry (t,,) <$> amr ctypes s
     in concatMap enc samples
 
+-- | Generate a list of 'MediaType' values describing the content types
+-- accepted by an API component.
+class SupportedTypes (list :: [*]) where
+    supportedTypes :: Proxy list -> [M.MediaType]
+
+instance SupportedTypes '[] where
+    supportedTypes Proxy = []
+
+instance (Accept ctype) => SupportedTypes '[ctype] where
+    supportedTypes Proxy = [ contentType (Proxy :: Proxy ctype) ]
+
+instance (Accept ctype, Accept ctype', SupportedTypes rest)
+        => SupportedTypes (ctype ': ctype' ': rest) where
+
+    supportedTypes Proxy =
+        [ contentType (Proxy :: Proxy ctype)
+        , contentType (Proxy :: Proxy ctype')
+        ] <> supportedTypes (Proxy :: Proxy rest)
+
 -- | The class that helps us automatically get documentation
 --   for GET parameters.
 --
@@ -504,7 +527,7 @@ markdown api = unlines $
           mxParamsStr (action ^. mxParams) ++
           headersStr (action ^. headers) ++
           paramsStr (action ^. params) ++
-          rqbodyStr (action ^. rqbody) ++
+          rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
           responseStr (action ^. response) ++
           []
 
@@ -518,7 +541,7 @@ markdown api = unlines $
         introStr i =
             ("#### " ++ i ^. introTitle) :
             "" :
-            intersperse ""  (i ^. introBody) ++
+            intersperse "" (i ^. introBody) ++
             "" :
             []
 
@@ -541,6 +564,7 @@ markdown api = unlines $
           map captureStr l ++
           "" :
           []
+
         captureStr cap =
           "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
 
@@ -552,6 +576,7 @@ markdown api = unlines $
           map segmentStr l ++
           "" :
           []
+
         segmentStr :: (String, [DocQueryParam]) -> String
         segmentStr (segment, l) = unlines $
           ("**" ++ segment ++ "**:") :
@@ -575,8 +600,9 @@ markdown api = unlines $
           map paramStr l ++
           "" :
           []
+
         paramStr param = unlines $
-          (" - " ++ param ^. paramName) :
+          ("- " ++ param ^. paramName) :
           (if (not (null values) || param ^. paramKind /= Flag)
             then ["     - **Values**: *" ++ intercalate ", " values ++ "*"]
             else []) ++
@@ -592,12 +618,20 @@ markdown api = unlines $
 
           where values = param ^. paramValues
 
-        rqbodyStr :: Maybe [(M.MediaType, ByteString)]-> [String]
-        rqbodyStr Nothing = []
-        rqbodyStr (Just b) = concatMap formatBody b
+        rqbodyStr :: [M.MediaType] -> [(M.MediaType, ByteString)]-> [String]
+        rqbodyStr [] [] = []
+        rqbodyStr types samples =
+            ["#### Request:", ""]
+            <> formatTypes types
+            <> concatMap formatBody samples
+
+        formatTypes [] = []
+        formatTypes ts = ["- Supported content types are: ", ""]
+            <> map (\t -> "    - `" <> show t <> "`") ts
+            <> [""]
 
         formatBody (m, b) =
-          "#### Request Body: `" <> show (M.mainType m <> "/" <> M.subType m) <> "`" :
+          "- Example: `" <> cs (M.mainType m <> "/" <> M.subType m) <> "`" :
           contentStr m b
 
         markdownForType mime_type =
@@ -606,6 +640,7 @@ markdown api = unlines $
                 ("application", "xml") -> "xml"
                 ("application", "json") -> "javascript"
                 ("application", "javascript") -> "javascript"
+                ("text", "css") -> "css"
                 (_, _) -> ""
 
         contentStr mime_type body =
@@ -620,14 +655,16 @@ markdown api = unlines $
         responseStr resp =
           "#### Response:" :
           "" :
-          (" - Status code " ++ show (resp ^. respStatus)) :
+          ("- Status code " ++ show (resp ^. respStatus)) :
+          "" :
+          formatTypes (resp ^. respTypes) ++
           bodies
 
           where bodies = case resp ^. respBody of
-                  []        -> [" - No response body\n"]
-                  [("", t, r)] -> " - Response body as below." : contentStr t r
+                  []        -> ["- No response body\n"]
+                  [("", t, r)] -> "- Response body as below." : contentStr t r
                   xs        ->
-                    concatMap (\(ctx, t, r) -> (" - " <> T.unpack ctx) : contentStr t r) xs
+                    concatMap (\(ctx, t, r) -> ("- " <> T.unpack ctx) : contentStr t r) xs
 
 -- * Instances
 
@@ -669,16 +706,17 @@ instance HasDocs Delete where
           action' = action & response.respBody .~ []
                            & response.respStatus .~ 204
 
-instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Get cts a) where
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
+    => HasDocs (Get cts a) where
   docsFor Proxy (endpoint, action) =
     single endpoint' action'
 
     where endpoint' = endpoint & method .~ DocGET
           action' = action & response.respBody .~ sampleByteStrings t p
+                           & response.respTypes .~ supportedTypes t
           t = Proxy :: Proxy cts
           p = Proxy :: Proxy a
 
-
 instance (KnownSymbol sym, HasDocs sublayout)
       => HasDocs (Header sym a :> sublayout) where
   docsFor Proxy (endpoint, action) =
@@ -688,22 +726,26 @@ instance (KnownSymbol sym, HasDocs sublayout)
           action' = over headers (|> headername) action
           headername = pack $ symbolVal (Proxy :: Proxy sym)
 
-instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Post cts a) where
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
+    => HasDocs (Post cts a) where
   docsFor Proxy (endpoint, action) =
     single endpoint' action'
 
     where endpoint' = endpoint & method .~ DocPOST
           action' = action & response.respBody .~ sampleByteStrings t p
+                           & response.respTypes .~ supportedTypes t
                            & response.respStatus .~ 201
           t = Proxy :: Proxy cts
           p = Proxy :: Proxy a
 
-instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Put cts a) where
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
+    => HasDocs (Put cts a) where
   docsFor Proxy (endpoint, action) =
     single endpoint' action'
 
     where endpoint' = endpoint & method .~ DocPUT
           action' = action & response.respBody .~ sampleByteStrings t p
+                           & response.respTypes .~ supportedTypes t
                            & response.respStatus .~ 200
           t = Proxy :: Proxy cts
           p = Proxy :: Proxy a
@@ -790,7 +832,7 @@ instance HasDocs Raw where
 -- example data. However, there's no reason to believe that the instances of
 -- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
 -- both are even defined) for any particular type.
-instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout)
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout, SupportedTypes cts)
       => HasDocs (ReqBody cts a :> sublayout) where
 
   docsFor Proxy (endpoint, action) =
@@ -798,6 +840,7 @@ instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout)
 
     where sublayoutP = Proxy :: Proxy sublayout
           action' = action & rqbody .~ sampleByteString t p
+                           & rqtypes .~ supportedTypes t
           t = Proxy :: Proxy cts
           p = Proxy :: Proxy a
 

From 8087fae18bdf7b3bb23d4693c59a1580acb31618 Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Fri, 20 Feb 2015 08:03:11 +1100
Subject: [PATCH 37/54] amr renamed allMimeRender

---
 example/greet.hs    | 1 -
 src/Servant/Docs.hs | 4 ++--
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index 9a5469cb..8e1efaeb 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -12,7 +12,6 @@ import Data.String.Conversions
 import Data.Text (Text)
 import GHC.Generics
 import Servant.API
-import Servant.API.ContentTypes
 import Servant.Docs
 
 -- * Example
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 504b82f6..da3bf67b 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -455,7 +455,7 @@ sampleByteString
     -> Proxy a
     -> [(M.MediaType, ByteString)]
 sampleByteString ctypes@Proxy Proxy =
-    maybe [] (amr ctypes) (toSample :: Maybe a)
+    maybe [] (allMimeRender ctypes) (toSample :: Maybe a)
 
 -- | Synthesise a list of sample values of a particular type, encoded in the
 -- specified media types.
@@ -466,7 +466,7 @@ sampleByteStrings
     -> [(Text, M.MediaType, ByteString)]
 sampleByteStrings ctypes@Proxy Proxy =
     let samples = toSamples :: [(Text, a)]
-        enc (t, s) = uncurry (t,,) <$> amr ctypes s
+        enc (t, s) = uncurry (t,,) <$> allMimeRender ctypes s
     in concatMap enc samples
 
 -- | Generate a list of 'MediaType' values describing the content types

From 02c4adfd1805268dd229f1c812441dcf0a927257 Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Fri, 20 Feb 2015 08:05:37 +1100
Subject: [PATCH 38/54] Simplify SupportedTypes instances

---
 src/Servant/Docs.hs | 12 +++---------
 1 file changed, 3 insertions(+), 9 deletions(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index da3bf67b..f156f643 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -477,16 +477,10 @@ class SupportedTypes (list :: [*]) where
 instance SupportedTypes '[] where
     supportedTypes Proxy = []
 
-instance (Accept ctype) => SupportedTypes '[ctype] where
-    supportedTypes Proxy = [ contentType (Proxy :: Proxy ctype) ]
-
-instance (Accept ctype, Accept ctype', SupportedTypes rest)
-        => SupportedTypes (ctype ': ctype' ': rest) where
-
+instance (Accept ctype, SupportedTypes rest) => SupportedTypes (ctype ': rest)
+  where
     supportedTypes Proxy =
-        [ contentType (Proxy :: Proxy ctype)
-        , contentType (Proxy :: Proxy ctype')
-        ] <> supportedTypes (Proxy :: Proxy rest)
+        contentType (Proxy :: Proxy ctype) : supportedTypes (Proxy :: Proxy rest)
 
 -- | The class that helps us automatically get documentation
 --   for GET parameters.

From bdf61e4df941363d0f85fb291c78e266bf7e83d5 Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Sun, 22 Feb 2015 17:18:07 +1100
Subject: [PATCH 39/54] Sample program more sensible and update README

---
 README.md        | 12 ++++++++++--
 example/greet.hs |  6 ++++--
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/README.md b/README.md
index 8adaf0b8..cc27510b 100644
--- a/README.md
+++ b/README.md
@@ -31,6 +31,14 @@ data Greet = Greet { _msg :: Text }
 instance FromJSON Greet
 instance ToJSON Greet
 
+-- we can render a Greeting into JSON using this ToJSON instance
+instance MimeRender JSON Greet where
+    toByteString Proxy = encodePretty
+
+-- or we can render it to HTML
+instance MimeRender HTML Greet where
+    toByteString Proxy (Greet s) = "<h1>" <> cs s <> "</h1>"
+
 -- we provide a sample value for the 'Greet' type
 instance ToSample Greet where
   toSample = Just g
@@ -51,8 +59,8 @@ instance ToCapture (Capture "greetid" Text) where
 
 -- API specification
 type TestApi =
-       "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
-  :<|> "greet" :> RQBody Greet :> Post Greet
+       "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON,HTML] Greet
+  :<|> "greet" :> RQBody '[JSON] Greet :> Post '[JSON] Greet
   :<|> "delete" :> Capture "greetid" Text :> Delete
 
 testApi :: Proxy TestApi
diff --git a/example/greet.hs b/example/greet.hs
index 8e1efaeb..3aca7b24 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -23,9 +23,11 @@ newtype Greet = Greet Text
 instance FromJSON Greet
 instance ToJSON Greet
 
+-- | A 'Greet' value can be rendered to 'JSON'.
 instance MimeRender JSON Greet where
     toByteString Proxy = encodePretty
 
+-- | A 'Greet' value can be rendered to 'HTML'.
 instance MimeRender HTML Greet where
     toByteString Proxy (Greet s) = "<h1>" <> cs s <> "</h1>"
 
@@ -74,12 +76,12 @@ intro2 = DocIntro "This title is below the last"
 
 -- API specification
 type TestApi =
-       -- GET /hello/:name?capital={true, false}  returns a Greet as JSON
+       -- GET /hello/:name?capital={true, false}  returns a Greet as JSON or HTML
        "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, HTML] Greet
 
        -- POST /greet with a Greet as JSON in the request body,
        --             returns a Greet as JSON
-  :<|> "greet" :> ReqBody '[JSON,HTML] Greet :> Post '[JSON] Greet
+  :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
 
        -- DELETE /greet/:greetid
   :<|> "greet" :> Capture "greetid" Text :> Delete

From 97ff49c3c4fcd395c902cff78bf2cc7e0d69f733 Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Sun, 22 Feb 2015 19:42:38 +1100
Subject: [PATCH 40/54] Replace HTML with PlainText in examples

---
 README.md        | 13 +++++--------
 example/greet.hs | 17 +++++++----------
 2 files changed, 12 insertions(+), 18 deletions(-)

diff --git a/README.md b/README.md
index cc27510b..28c450e7 100644
--- a/README.md
+++ b/README.md
@@ -27,16 +27,13 @@ import Servant
 data Greet = Greet { _msg :: Text }
   deriving (Generic, Show)
 
--- we get our JSON serialization for free
+-- we get our JSON serialization for free. This will be used by the default
+-- 'MimeRender' instance for 'JSON'.
 instance FromJSON Greet
 instance ToJSON Greet
 
--- we can render a Greeting into JSON using this ToJSON instance
-instance MimeRender JSON Greet where
-    toByteString Proxy = encodePretty
-
--- or we can render it to HTML
-instance MimeRender HTML Greet where
+-- We can also implement 'MimeRender' explicitly for additional formats.
+instance MimeRender PlainText Greet where
     toByteString Proxy (Greet s) = "<h1>" <> cs s <> "</h1>"
 
 -- we provide a sample value for the 'Greet' type
@@ -59,7 +56,7 @@ instance ToCapture (Capture "greetid" Text) where
 
 -- API specification
 type TestApi =
-       "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON,HTML] Greet
+       "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON,PlainText] Greet
   :<|> "greet" :> RQBody '[JSON] Greet :> Post '[JSON] Greet
   :<|> "delete" :> Capture "greetid" Text :> Delete
 
diff --git a/example/greet.hs b/example/greet.hs
index 3aca7b24..10019f90 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -6,7 +6,6 @@
 {-# LANGUAGE TypeOperators         #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 import Data.Aeson
-import Data.Aeson.Encode.Pretty (encodePretty)
 import Data.Proxy
 import Data.String.Conversions
 import Data.Text (Text)
@@ -20,16 +19,14 @@ import Servant.Docs
 newtype Greet = Greet Text
   deriving (Generic, Show)
 
+-- | We can get JSON support automatically. This will be used to parse
+-- and encode a Greeting as 'JSON'.
 instance FromJSON Greet
 instance ToJSON Greet
 
--- | A 'Greet' value can be rendered to 'JSON'.
-instance MimeRender JSON Greet where
-    toByteString Proxy = encodePretty
-
--- | A 'Greet' value can be rendered to 'HTML'.
-instance MimeRender HTML Greet where
-    toByteString Proxy (Greet s) = "<h1>" <> cs s <> "</h1>"
+-- | We can also implement 'MimeRender' for additional formats like 'PlainText'.
+instance MimeRender PlainText Greet where
+    toByteString Proxy (Greet s) = "\"" <> cs s <> "\""
 
 -- We add some useful annotations to our captures,
 -- query parameters and request body to make the docs
@@ -76,8 +73,8 @@ intro2 = DocIntro "This title is below the last"
 
 -- API specification
 type TestApi =
-       -- GET /hello/:name?capital={true, false}  returns a Greet as JSON or HTML
-       "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, HTML] Greet
+       -- GET /hello/:name?capital={true, false}  returns a Greet as JSON or PlainText
+       "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet
 
        -- POST /greet with a Greet as JSON in the request body,
        --             returns a Greet as JSON

From fc5802fe7fba1b10112b4b34647c0083a28b57de Mon Sep 17 00:00:00 2001
From: Thomas Sutton <me@thomas-sutton.id.au>
Date: Mon, 23 Feb 2015 09:38:19 +1100
Subject: [PATCH 41/54] Show, rather than convert, media types

---
 servant-docs.cabal  | 2 +-
 src/Servant/Docs.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/servant-docs.cabal b/servant-docs.cabal
index d45cbbbf..32c18230 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -45,5 +45,5 @@ executable greet-docs
   main-is: greet.hs
   hs-source-dirs: example
   ghc-options: -Wall
-  build-depends: base, aeson, aeson-pretty, servant, servant-docs, string-conversions, text
+  build-depends: base, aeson, servant, servant-docs, string-conversions, text
   default-language: Haskell2010
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index f156f643..6a3e5e59 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -625,7 +625,7 @@ markdown api = unlines $
             <> [""]
 
         formatBody (m, b) =
-          "- Example: `" <> cs (M.mainType m <> "/" <> M.subType m) <> "`" :
+          "- Example: `" <> cs (show m) <> "`" :
           contentStr m b
 
         markdownForType mime_type =

From 53d3f6db80b731d0058b7657de8edf53d6404ef7 Mon Sep 17 00:00:00 2001
From: Christian Marie <christian@ponies.io>
Date: Mon, 23 Feb 2015 09:54:07 +1100
Subject: [PATCH 42/54] Rename safeInfo to extraInfo

---
 example/greet.hs    |  2 +-
 src/Servant/Docs.hs | 14 +++++++-------
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index e5d448d1..c7815d51 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -88,7 +88,7 @@ testApi = Proxy
 -- notes.
 extra :: ExtraInfo TestApi
 extra =
-    safeInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
+    extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
              defAction & headers <>~ ["unicorns"]
                        & notes   <>~ [ DocNote "Title" ["This is some text"]
                                      , DocNote "Second secton" ["And some more"]
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 2cd4a564..24b35cce 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -127,7 +127,7 @@
 -- > -- notes.
 -- > extra :: ExtraInfo TestApi
 -- > extra =
--- >     safeInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
+-- >     extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
 -- >              defAction & headers <>~ ["unicorns"]
 -- >                        & notes   <>~ [ DocNote "Title" ["This is some text"]
 -- >                                      , DocNote "Second secton" ["And some more"]
@@ -149,7 +149,7 @@ module Servant.Docs
   ( -- * 'HasDocs' class and key functions
     HasDocs(..), docs, markdown
     -- * Generating docs with extra information
-  , ExtraInfo(..), docsWith, docsWithIntros, safeInfo
+  , ExtraInfo(..), docsWith, docsWithIntros, extraInfo
 
   , -- * Classes you need to implement for your types
     ToSample(..)
@@ -317,7 +317,7 @@ data DocNote = DocNote
 -- | Type of extra information that a user may wish to "union" with their
 -- documentation.
 --
--- These are intended to be built using safeInfo.
+-- These are intended to be built using extraInfo.
 -- Multiple ExtraInfo may be combined with the monoid instance.
 newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action)
 instance Monoid (ExtraInfo a) where
@@ -448,15 +448,15 @@ type family IsIn (endpoint :: *) (api :: *) :: Constraint where
 --
 -- > extra :: ExtraInfo TestApi
 -- > extra =
--- >     safeInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
+-- >     extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
 -- >              defAction & headers <>~ ["unicorns"]
 -- >                        & notes   <>~ [ DocNote "Title" ["This is some text"]
 -- >                                      , DocNote "Second secton" ["And some more"]
 -- >                                      ]
 
-safeInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
+extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
          => Proxy endpoint -> Action -> ExtraInfo layout
-safeInfo p action =
+extraInfo p action =
     let api = docsFor p (defEndpoint, defAction)
     -- Assume one endpoint, HasLink constraint means that we should only ever
     -- point at one endpoint.
@@ -471,7 +471,7 @@ safeInfo p action =
 -- will be "unioned" with the automatically generated endpoint documentation.
 --
 -- You are expected to build up the ExtraInfo with the Monoid instance and
--- 'safeInfo'.
+-- 'extraInfo'.
 --
 -- If you only want to add an introduction, use 'docsWithIntros'.
 docsWith :: HasDocs layout

From 1fef813a3bd2f7dcb2ce58483869001c47bc78b4 Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Mon, 23 Feb 2015 10:53:18 +0100
Subject: [PATCH 43/54] Render entpoints in canonical order.

---
 src/Servant/Docs.hs | 26 +++++++++++++++++---------
 1 file changed, 17 insertions(+), 9 deletions(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 6f3e2cdf..936a8020 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -11,6 +11,7 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 -------------------------------------------------------------------------------
 -- | This module lets you get API docs for free. It lets generate
@@ -190,6 +191,7 @@ import Data.ByteString.Lazy.Char8 (ByteString)
 import Data.Hashable
 import Data.HashMap.Strict (HashMap)
 import Data.List
+import Data.Function (on)
 import Data.Maybe
 import Data.Monoid
 import Data.Ord (comparing)
@@ -207,12 +209,18 @@ import qualified Data.HashMap.Strict as HM
 import qualified Data.Text as T
 import qualified Network.HTTP.Media as M
 
+-- | Temporary orphan.  Can be eliminated as soon as
+-- https://github.com/zmthy/http-media/pull/12 has been released.
+-- (Also consider removing StandaloneDeriving language ext above.)
+instance Ord M.MediaType where
+  compare t t' = compare (show t) (show t')
+
 -- | Supported HTTP request methods
 data Method = DocDELETE -- ^ the DELETE method
             | DocGET    -- ^ the GET method
             | DocPOST   -- ^ the POST method
             | DocPUT    -- ^ the PUT method
-  deriving (Eq, Generic)
+  deriving (Eq, Ord, Generic)
 
 instance Show Method where
   show DocGET = "GET"
@@ -239,7 +247,7 @@ instance Hashable Method
 data Endpoint = Endpoint
   { _path   :: [String] -- type collected
   , _method :: Method   -- type collected
-  } deriving (Eq, Generic)
+  } deriving (Eq, Ord, Generic)
 
 instance Show Endpoint where
   show (Endpoint p m) =
@@ -291,7 +299,7 @@ emptyAPI = mempty
 data DocCapture = DocCapture
   { _capSymbol :: String -- type supplied
   , _capDesc   :: String -- user supplied
-  } deriving (Eq, Show)
+  } deriving (Eq, Ord, Show)
 
 -- | A type to represent a /GET/ parameter from the Query String. Holds its name,
 --   the possible values (leave empty if there isn't a finite number of them),
@@ -303,7 +311,7 @@ data DocQueryParam = DocQueryParam
   , _paramValues :: [String] -- user supplied
   , _paramDesc   :: String   -- user supplied
   , _paramKind   :: ParamKind
-  } deriving (Eq, Show)
+  } deriving (Eq, Ord, Show)
 
 -- | An introductory paragraph for your documentation. You can pass these to
 -- 'docsWithIntros'.
@@ -322,7 +330,7 @@ instance Ord DocIntro where
 data DocNote = DocNote
   { _noteTitle :: String
   , _noteBody  :: [String]
-  } deriving (Eq, Show)
+  } deriving (Eq, Ord, Show)
 
 -- | Type of extra information that a user may wish to "union" with their
 -- documentation.
@@ -341,7 +349,7 @@ instance Monoid (ExtraInfo a) where
 -- - List corresponds to @QueryParams@, i.e GET parameters with multiple values
 -- - Flag corresponds to @QueryFlag@, i.e a value-less GET parameter
 data ParamKind = Normal | List | Flag
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)
 
 -- | A type to represent an HTTP response. Has an 'Int' status, a list of
 -- possible 'MediaType's, and a list of example 'ByteString' response bodies.
@@ -362,7 +370,7 @@ data Response = Response
   { _respStatus :: Int
   , _respTypes  :: [M.MediaType]
   , _respBody   :: [(Text, M.MediaType, ByteString)]
-  } deriving (Eq, Show)
+  } deriving (Eq, Ord, Show)
 
 -- | Default response: status code 200, no response body.
 --
@@ -394,7 +402,7 @@ data Action = Action
   , _rqtypes  :: [M.MediaType]               -- type collected
   , _rqbody   :: [(M.MediaType, ByteString)] -- user supplied
   , _response :: Response                    -- user supplied
-  } deriving (Eq, Show)
+  } deriving (Eq, Ord, Show)
 
 -- | Combine two Actions, we can't make a monoid as merging Response breaks the
 -- laws.
@@ -611,7 +619,7 @@ class ToCapture c where
 markdown :: API -> String
 markdown api = unlines $
        introsStr (api ^. apiIntros)
-    ++ (concatMap (uncurry printEndpoint) . HM.toList $ api ^. apiEndpoints)
+    ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
 
   where printEndpoint :: Endpoint -> Action -> [String]
         printEndpoint endpoint action =

From f11d5207e412670a1573aa3e2b58d2ff8d4148e1 Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Tue, 24 Feb 2015 08:54:14 +0100
Subject: [PATCH 44/54] Dropped orphan instance for MediaType (now available
 upstream).

---
 servant-docs.cabal  | 2 +-
 src/Servant/Docs.hs | 6 ------
 2 files changed, 1 insertion(+), 7 deletions(-)

diff --git a/servant-docs.cabal b/servant-docs.cabal
index 32c18230..48e5271c 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -31,7 +31,7 @@ library
     , aeson
     , bytestring
     , hashable
-    , http-media
+    , http-media >= 0.6
     , lens
     , servant >= 0.2.1
     , string-conversions
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 936a8020..945f1e62 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -209,12 +209,6 @@ import qualified Data.HashMap.Strict as HM
 import qualified Data.Text as T
 import qualified Network.HTTP.Media as M
 
--- | Temporary orphan.  Can be eliminated as soon as
--- https://github.com/zmthy/http-media/pull/12 has been released.
--- (Also consider removing StandaloneDeriving language ext above.)
-instance Ord M.MediaType where
-  compare t t' = compare (show t) (show t')
-
 -- | Supported HTTP request methods
 data Method = DocDELETE -- ^ the DELETE method
             | DocGET    -- ^ the GET method

From 68fee749c4e5f7136ead94338b6a783788f2c6a4 Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Tue, 24 Feb 2015 11:01:34 +0100
Subject: [PATCH 45/54] Remove dead code.

---
 src/Servant/Docs.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 945f1e62..7cf9f441 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -11,7 +11,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE StandaloneDeriving #-}
 
 -------------------------------------------------------------------------------
 -- | This module lets you get API docs for free. It lets generate
@@ -191,7 +190,6 @@ import Data.ByteString.Lazy.Char8 (ByteString)
 import Data.Hashable
 import Data.HashMap.Strict (HashMap)
 import Data.List
-import Data.Function (on)
 import Data.Maybe
 import Data.Monoid
 import Data.Ord (comparing)

From eb87b00b0d3bb165551582fb2ce2a72ba3773046 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Wed, 4 Mar 2015 02:07:13 +0100
Subject: [PATCH 46/54] prepare changelog for next version

---
 CHANGELOG.md | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index ecf16c01..2ca35899 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,9 @@
+0.4
+---
+* Allow for extra information to be added to the docs
+* Support content-type aware combinators of *servant-0.3*
+* Render endpoints in a canonical order (https://github.com/haskell-servant/servant-docs/pull/15)
+
 0.3
 ---
 

From 38fea6060e97e7f219fbd2b235c7132ff1d57684 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Thu, 26 Mar 2015 13:03:22 +0100
Subject: [PATCH 47/54] do not export Control.Lens and Data.Monoid from
 Servant.Docs

---
 src/Servant/Docs.hs | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 7cf9f441..7595e9ee 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -177,10 +177,6 @@ module Servant.Docs
   , Response, respStatus, respTypes, respBody, defResponse
   , Action, captures, headers, notes, params, rqtypes, rqbody, response, defAction
   , single
-
-  , -- * Useful modules when defining your doc printers
-    module Control.Lens
-  , module Data.Monoid
   ) where
 
 import Control.Applicative

From 32768e431e31a7a6577abb00df10a7d2917c344e Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Thu, 26 Mar 2015 13:14:34 +0100
Subject: [PATCH 48/54] import Control.Lens in the example

---
 example/greet.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/example/greet.hs b/example/greet.hs
index 4004914f..e5734472 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TypeOperators         #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+import Control.Lens
 import Data.Aeson
 import Data.Proxy
 import Data.String.Conversions

From a06e54610cdfe9cf7beeeff57ce3e4a3209ca6ad Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Thu, 26 Mar 2015 13:26:23 +0100
Subject: [PATCH 49/54] add lens as a dependency for the example

---
 servant-docs.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/servant-docs.cabal b/servant-docs.cabal
index 48e5271c..050d1a2c 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -45,5 +45,5 @@ executable greet-docs
   main-is: greet.hs
   hs-source-dirs: example
   ghc-options: -Wall
-  build-depends: base, aeson, servant, servant-docs, string-conversions, text
+  build-depends: base, aeson, lens, servant, servant-docs, string-conversions, text
   default-language: Haskell2010

From 52157f51819b70f3d38ef8251ab68d398a719fac Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Wed, 8 Apr 2015 16:27:24 +0200
Subject: [PATCH 50/54] Add nix files

---
 default.nix | 19 +++++++++++++++++++
 shell.nix   |  9 +++++++++
 2 files changed, 28 insertions(+)
 create mode 100644 default.nix
 create mode 100644 shell.nix

diff --git a/default.nix b/default.nix
new file mode 100644
index 00000000..b310e07c
--- /dev/null
+++ b/default.nix
@@ -0,0 +1,19 @@
+{ mkDerivation, aeson, base, bytestring, hashable, hspec
+, http-media, lens, servant, stdenv, string-conversions, text
+, unordered-containers
+}:
+mkDerivation {
+  pname = "servant-docs";
+  version = "0.3";
+  src = ./.;
+  isLibrary = true;
+  isExecutable = true;
+  buildDepends = [
+    aeson base bytestring hashable http-media lens servant
+    string-conversions text unordered-containers
+  ];
+  testDepends = [ aeson base hspec lens servant ];
+  homepage = "http://haskell-servant.github.io/";
+  description = "generate API docs for your servant webservice";
+  license = stdenv.lib.licenses.bsd3;
+}
diff --git a/shell.nix b/shell.nix
new file mode 100644
index 00000000..e17a0f83
--- /dev/null
+++ b/shell.nix
@@ -0,0 +1,9 @@
+with (import <nixpkgs> {}).pkgs;
+let modifiedHaskellPackages = haskellngPackages.override {
+      overrides = self: super: {
+        servant = self.callPackage ../servant {};
+        servant-server = self.callPackage ./servant-server {};
+        servant-docs = self.callPackage ./. {};
+      };
+    };
+in modifiedHaskellPackages.servant-docs.env

From 9996e6755b37de009a6b1dd0446ed3d2c8e0ff95 Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Wed, 8 Apr 2015 16:27:38 +0200
Subject: [PATCH 51/54] Cleanup: tests, fix ToJSON supeclass.

---
 CHANGELOG.md                 |   2 +
 servant-docs.cabal           |  28 +-
 src/Servant/Docs.hs          | 818 +----------------------------------
 src/Servant/Docs/Internal.hs | 803 ++++++++++++++++++++++++++++++++++
 test/Servant/DocsSpec.hs     |  64 +++
 test/Spec.hs                 |   1 +
 6 files changed, 903 insertions(+), 813 deletions(-)
 create mode 100644 src/Servant/Docs/Internal.hs
 create mode 100644 test/Servant/DocsSpec.hs
 create mode 100644 test/Spec.hs

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 2ca35899..2263072d 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -3,6 +3,8 @@
 * Allow for extra information to be added to the docs
 * Support content-type aware combinators of *servant-0.3*
 * Render endpoints in a canonical order (https://github.com/haskell-servant/servant-docs/pull/15)
+* Remove ToJSON superclass from ToSample
+* Split out Internal module
 
 0.3
 ---
diff --git a/servant-docs.cabal b/servant-docs.cabal
index 050d1a2c..35591972 100644
--- a/servant-docs.cabal
+++ b/servant-docs.cabal
@@ -25,10 +25,10 @@ source-repository head
 
 library
   exposed-modules:
-    Servant.Docs
+      Servant.Docs
+    , Servant.Docs.Internal
   build-depends:
       base >=4.7 && <5
-    , aeson
     , bytestring
     , hashable
     , http-media >= 0.6
@@ -45,5 +45,27 @@ executable greet-docs
   main-is: greet.hs
   hs-source-dirs: example
   ghc-options: -Wall
-  build-depends: base, aeson, lens, servant, servant-docs, string-conversions, text
+  build-depends:
+      base
+    , aeson
+    , lens
+    , servant
+    , servant-docs
+    , string-conversions
+    , text
   default-language: Haskell2010
+
+test-suite spec
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  hs-source-dirs: test
+  ghc-options: -Wall
+  build-depends:
+      base
+    , aeson
+    , hspec
+    , servant
+    , servant-docs
+    , string-conversions
+  default-language: Haskell2010
+
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 7595e9ee..d2c4722e 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -1,31 +1,17 @@
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE PolyKinds #-}
-
 -------------------------------------------------------------------------------
--- | This module lets you get API docs for free. It lets generate
+-- | This module lets you get API docs for free. It lets you generate
 -- an 'API' from the type that represents your API using 'docs':
 --
 -- @docs :: 'HasDocs' api => 'Proxy' api -> 'API'@
 --
--- Alternately, if you wish to add one or more introductions to your
+-- Alternatively, if you wish to add one or more introductions to your
 -- documentation, use 'docsWithIntros':
 --
--- @docsWithIntros :: 'HasDocs' api => [DocIntro] -> 'Proxy' api -> 'API'@
+-- @'docsWithIntros' :: 'HasDocs' api => [DocIntro] -> 'Proxy' api -> 'API'@
 --
 -- You can then call 'markdown' on the 'API' value:
 --
--- @markdown :: 'API' -> String@
+-- @'markdown' :: 'API' -> String@
 --
 -- or define a custom pretty printer:
 --
@@ -34,8 +20,8 @@
 -- The only thing you'll need to do will be to implement some classes
 -- for your captures, get parameters and request or response bodies.
 --
--- Here's a little (but complete) example that you can run to see the
--- markdown pretty printer in action:
+-- Here is a complete example that you can run to see the markdown pretty
+-- printer in action:
 --
 -- > {-# LANGUAGE DataKinds             #-}
 -- > {-# LANGUAGE DeriveGeneric         #-}
@@ -174,797 +160,9 @@ module Servant.Docs
   , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
   , DocNote(..), noteTitle, noteBody
   , DocIntro(..)
-  , Response, respStatus, respTypes, respBody, defResponse
+  , Response(..), respStatus, respTypes, respBody, defResponse
   , Action, captures, headers, notes, params, rqtypes, rqbody, response, defAction
   , single
   ) where
 
-import Control.Applicative
-import Control.Lens hiding (Action)
-import Data.Aeson
-import Data.ByteString.Lazy.Char8 (ByteString)
-import Data.Hashable
-import Data.HashMap.Strict (HashMap)
-import Data.List
-import Data.Maybe
-import Data.Monoid
-import Data.Ord (comparing)
-import Data.Proxy
-import Data.String.Conversions
-import Data.Text (Text, pack, unpack)
-import GHC.Generics
-import GHC.TypeLits
-import GHC.Exts(Constraint)
-import Servant.API
-import Servant.Utils.Links
-import Servant.API.ContentTypes
-
-import qualified Data.HashMap.Strict as HM
-import qualified Data.Text as T
-import qualified Network.HTTP.Media as M
-
--- | Supported HTTP request methods
-data Method = DocDELETE -- ^ the DELETE method
-            | DocGET    -- ^ the GET method
-            | DocPOST   -- ^ the POST method
-            | DocPUT    -- ^ the PUT method
-  deriving (Eq, Ord, Generic)
-
-instance Show Method where
-  show DocGET = "GET"
-  show DocPOST = "POST"
-  show DocDELETE = "DELETE"
-  show DocPUT = "PUT"
-
-instance Hashable Method
-
--- | An 'Endpoint' type that holds the 'path' and the 'method'.
---
--- Gets used as the key in the 'API' hashmap. Modify 'defEndpoint'
--- or any 'Endpoint' value you want using the 'path' and 'method'
--- lenses to tweak.
---
--- @
--- λ> 'defEndpoint'
--- GET /
--- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
--- GET /foo
--- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
--- POST /foo
--- @
-data Endpoint = Endpoint
-  { _path   :: [String] -- type collected
-  , _method :: Method   -- type collected
-  } deriving (Eq, Ord, Generic)
-
-instance Show Endpoint where
-  show (Endpoint p m) =
-    show m ++ " " ++ showPath p
-
--- |
--- Render a path as a '/'-delimited string
---
-showPath :: [String] -> String
-showPath [] = "/"
-showPath ps = concatMap ('/' :) ps
-
--- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'
---
--- Here's how you can modify it:
---
--- @
--- λ> 'defEndpoint'
--- GET /
--- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
--- GET /foo
--- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
--- POST /foo
--- @
-defEndpoint :: Endpoint
-defEndpoint = Endpoint [] DocGET
-
-instance Hashable Endpoint
-
--- | Our API documentation type, a product of top-level information and a good
--- old hashmap from 'Endpoint' to 'Action'
-data API = API
-  { _apiIntros    :: [DocIntro]
-  , _apiEndpoints :: HashMap Endpoint Action
-  } deriving (Eq, Show)
-
-instance Monoid API where
-    API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2)
-    mempty = API mempty mempty
-
--- | An empty 'API'
-emptyAPI :: API
-emptyAPI = mempty
-
--- | A type to represent captures. Holds the name of the capture
---   and a description.
---
--- Write a 'ToCapture' instance for your captured types.
-data DocCapture = DocCapture
-  { _capSymbol :: String -- type supplied
-  , _capDesc   :: String -- user supplied
-  } deriving (Eq, Ord, Show)
-
--- | A type to represent a /GET/ parameter from the Query String. Holds its name,
---   the possible values (leave empty if there isn't a finite number of them),
---   and a description of how it influences the output or behavior.
---
--- Write a 'ToParam' instance for your GET parameter types
-data DocQueryParam = DocQueryParam
-  { _paramName   :: String   -- type supplied
-  , _paramValues :: [String] -- user supplied
-  , _paramDesc   :: String   -- user supplied
-  , _paramKind   :: ParamKind
-  } deriving (Eq, Ord, Show)
-
--- | An introductory paragraph for your documentation. You can pass these to
--- 'docsWithIntros'.
-data DocIntro = DocIntro
-  { _introTitle :: String   -- ^ Appears above the intro blob
-  , _introBody  :: [String] -- ^ Each String is a paragraph.
-  } deriving (Eq, Show)
-
-instance Ord DocIntro where
-    compare = comparing _introTitle
-
--- | A type to represent extra notes that may be attached to an 'Action'.
---
--- This is intended to be used when writing your own HasDocs instances to
--- add extra sections to your endpoint's documentation.
-data DocNote = DocNote
-  { _noteTitle :: String
-  , _noteBody  :: [String]
-  } deriving (Eq, Ord, Show)
-
--- | Type of extra information that a user may wish to "union" with their
--- documentation.
---
--- These are intended to be built using extraInfo.
--- Multiple ExtraInfo may be combined with the monoid instance.
-newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action)
-instance Monoid (ExtraInfo a) where
-    mempty = ExtraInfo mempty
-    ExtraInfo a `mappend` ExtraInfo b =
-        ExtraInfo $ HM.unionWith combineAction a b
-
--- | Type of GET parameter:
---
--- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
--- - List corresponds to @QueryParams@, i.e GET parameters with multiple values
--- - Flag corresponds to @QueryFlag@, i.e a value-less GET parameter
-data ParamKind = Normal | List | Flag
-  deriving (Eq, Ord, Show)
-
--- | A type to represent an HTTP response. Has an 'Int' status, a list of
--- possible 'MediaType's, and a list of example 'ByteString' response bodies.
--- Tweak 'defResponse' using the 'respStatus', 'respTypes' and 'respBody'
--- lenses if you want.
---
--- If you want to respond with a non-empty response body, you'll most likely
--- want to write a 'ToSample' instance for the type that'll be represented
--- as encoded data in the response.
---
--- Can be tweaked with three lenses.
---
--- > λ> defResponse
--- > Response {_respStatus = 200, _respTypes = [], _respBody = []}
--- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
--- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
-data Response = Response
-  { _respStatus :: Int
-  , _respTypes  :: [M.MediaType]
-  , _respBody   :: [(Text, M.MediaType, ByteString)]
-  } deriving (Eq, Ord, Show)
-
--- | Default response: status code 200, no response body.
---
--- Can be tweaked with two lenses.
---
--- > λ> defResponse
--- > Response {_respStatus = 200, _respBody = Nothing}
--- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
--- > Response {_respStatus = 204, _respBody = Just "[]"}
-defResponse :: Response
-defResponse = Response 200 [] []
-
--- | A datatype that represents everything that can happen
--- at an endpoint, with its lenses:
---
--- - List of captures ('captures')
--- - List of GET parameters ('params')
--- - What the request body should look like, if any is requested ('rqbody')
--- - What the response should be if everything goes well ('response')
---
--- You can tweak an 'Action' (like the default 'defAction') with these lenses
--- to transform an action and add some information to it.
-data Action = Action
-  { _captures :: [DocCapture]                -- type collected + user supplied info
-  , _headers  :: [Text]                      -- type collected
-  , _params   :: [DocQueryParam]             -- type collected + user supplied info
-  , _notes    :: [DocNote]                   -- user supplied
-  , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
-  , _rqtypes  :: [M.MediaType]               -- type collected
-  , _rqbody   :: [(M.MediaType, ByteString)] -- user supplied
-  , _response :: Response                    -- user supplied
-  } deriving (Eq, Ord, Show)
-
--- | Combine two Actions, we can't make a monoid as merging Response breaks the
--- laws.
---
--- As such, we invent a non-commutative, left associative operation
--- 'combineAction' to mush two together taking the response, body and content
--- types from the very left.
-combineAction :: Action -> Action -> Action
-Action c h p n m ts body resp `combineAction` Action c' h' p' n' m' _ _ _ =
-        Action (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
-
--- Default 'Action'. Has no 'captures', no GET 'params', expects
--- no request body ('rqbody') and the typical response is 'defResponse'.
---
--- Tweakable with lenses.
---
--- > λ> defAction
--- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
--- > λ> defAction & response.respStatus .~ 201
--- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
-defAction :: Action
-defAction =
-  Action []
-         []
-         []
-         []
-         []
-         []
-         []
-         defResponse
-
--- | Create an API that's comprised of a single endpoint.
---   'API' is a 'Monoid', so combine multiple endpoints with
---   'mappend' or '<>'.
-single :: Endpoint -> Action -> API
-single e a = API mempty (HM.singleton e a)
-
--- gimme some lenses
-makeLenses ''API
-makeLenses ''Endpoint
-makeLenses ''DocCapture
-makeLenses ''DocQueryParam
-makeLenses ''DocIntro
-makeLenses ''DocNote
-makeLenses ''Response
-makeLenses ''Action
-
--- | Generate the docs for a given API that implements 'HasDocs'. This is the
--- default way to create documentation.
-docs :: HasDocs layout => Proxy layout -> API
-docs p = docsFor p (defEndpoint, defAction)
-
--- | Closed type family, check if endpoint is exactly within API.
-
--- We aren't sure what affects how an Endpoint is built up, so we require an
--- exact match.
-type family IsIn (endpoint :: *) (api :: *) :: Constraint where
-    IsIn e (sa :<|> sb)                = Or (IsIn e sa) (IsIn e sb)
-    IsIn (e :> sa) (e :> sb)           = IsIn sa sb
-    IsIn e e                           = ()
-
--- | Create an 'ExtraInfo' that is garunteed to be within the given API layout.
---
--- The safety here is to ensure that you only add custom documentation to an
--- endpoint that actually exists within your API.
---
--- > extra :: ExtraInfo TestApi
--- > extra =
--- >     extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
--- >              defAction & headers <>~ ["unicorns"]
--- >                        & notes   <>~ [ DocNote "Title" ["This is some text"]
--- >                                      , DocNote "Second secton" ["And some more"]
--- >                                      ]
-
-extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
-          => Proxy endpoint -> Action -> ExtraInfo layout
-extraInfo p action =
-    let api = docsFor p (defEndpoint, defAction)
-    -- Assume one endpoint, HasLink constraint means that we should only ever
-    -- point at one endpoint.
-    in ExtraInfo $ api ^. apiEndpoints & traversed .~ action
-
--- | Generate documentation given some extra introductions (in the form of
--- 'DocInfo') and some extra endpoint documentation (in the form of
--- 'ExtraInfo'.
---
--- The extra introductions will be prepended to the top of the documentation,
--- before the specific endpoint documentation. The extra endpoint documentation
--- will be "unioned" with the automatically generated endpoint documentation.
---
--- You are expected to build up the ExtraInfo with the Monoid instance and
--- 'extraInfo'.
---
--- If you only want to add an introduction, use 'docsWithIntros'.
-docsWith :: HasDocs layout
-         => [DocIntro]
-         -> ExtraInfo layout
-         -> Proxy layout
-         -> API
-docsWith intros (ExtraInfo endpoints) p =
-    docs p & apiIntros <>~ intros
-           & apiEndpoints %~ HM.unionWith combineAction endpoints
-
-
--- | Generate the docs for a given API that implements 'HasDocs' with with any
--- number of introduction(s)
-docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
-docsWithIntros intros = docsWith intros mempty
-
--- | The class that abstracts away the impact of API combinators
---   on documentation generation.
-class HasDocs layout where
-  docsFor :: Proxy layout -> (Endpoint, Action) -> API
-
--- | The class that lets us display a sample JSON input or output
---   when generating documentation for endpoints that either:
---
--- - expect a request body, or
--- - return a non empty response body
---
--- Example of an instance:
---
--- > {-# LANGUAGE DeriveGeneric #-}
--- > {-# LANGUAGE OverloadedStrings #-}
--- >
--- > import Data.Aeson
--- > import Data.Text
--- > import GHC.Generics
--- >
--- > data Greet = Greet { _msg :: Text }
--- >   deriving (Generic, Show)
--- >
--- > instance FromJSON Greet
--- > instance ToJSON Greet
--- >
--- > instance ToSample Greet where
--- >   toSample = Just g
--- >
--- >     where g = Greet "Hello, haskeller!"
---
--- You can also instantiate this class using 'toSamples' instead of
--- 'toSample': it lets you specify different responses along with
--- some context (as 'Text') that explains when you're supposed to
--- get the corresponding response.
-class ToJSON a => ToSample a where
-  {-# MINIMAL (toSample | toSamples) #-}
-  toSample :: Maybe a
-  toSample = snd <$> listToMaybe samples
-    where samples = toSamples :: [(Text, a)]
-
-  toSamples :: [(Text, a)]
-  toSamples = maybe [] (return . ("",)) s
-    where s = toSample :: Maybe a
-
--- | Synthesise a sample value of a type, encoded in the specified media types.
-sampleByteString
-    :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
-    => Proxy ctypes
-    -> Proxy a
-    -> [(M.MediaType, ByteString)]
-sampleByteString ctypes@Proxy Proxy =
-    maybe [] (allMimeRender ctypes) (toSample :: Maybe a)
-
--- | Synthesise a list of sample values of a particular type, encoded in the
--- specified media types.
-sampleByteStrings
-    :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
-    => Proxy ctypes
-    -> Proxy a
-    -> [(Text, M.MediaType, ByteString)]
-sampleByteStrings ctypes@Proxy Proxy =
-    let samples = toSamples :: [(Text, a)]
-        enc (t, s) = uncurry (t,,) <$> allMimeRender ctypes s
-    in concatMap enc samples
-
--- | Generate a list of 'MediaType' values describing the content types
--- accepted by an API component.
-class SupportedTypes (list :: [*]) where
-    supportedTypes :: Proxy list -> [M.MediaType]
-
-instance SupportedTypes '[] where
-    supportedTypes Proxy = []
-
-instance (Accept ctype, SupportedTypes rest) => SupportedTypes (ctype ': rest)
-  where
-    supportedTypes Proxy =
-        contentType (Proxy :: Proxy ctype) : supportedTypes (Proxy :: Proxy rest)
-
--- | The class that helps us automatically get documentation
---   for GET parameters.
---
--- Example of an instance:
---
--- > instance ToParam (QueryParam "capital" Bool) where
--- >   toParam _ =
--- >     DocQueryParam "capital"
--- >                   ["true", "false"]
--- >                   "Get the greeting message in uppercase (true) or not (false). Default is false."
-class ToParam t where
-  toParam :: Proxy t -> DocQueryParam
-
--- | The class that helps us automatically get documentation
---   for URL captures.
---
--- Example of an instance:
---
--- > instance ToCapture (Capture "name" Text) where
--- >   toCapture _ = DocCapture "name" "name of the person to greet"
-class ToCapture c where
-  toCapture :: Proxy c -> DocCapture
-
--- | Generate documentation in Markdown format for
---   the given 'API'.
-markdown :: API -> String
-markdown api = unlines $
-       introsStr (api ^. apiIntros)
-    ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
-
-  where printEndpoint :: Endpoint -> Action -> [String]
-        printEndpoint endpoint action =
-          str :
-          "" :
-          notesStr (action ^. notes) ++
-          capturesStr (action ^. captures) ++
-          mxParamsStr (action ^. mxParams) ++
-          headersStr (action ^. headers) ++
-          paramsStr (action ^. params) ++
-          rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
-          responseStr (action ^. response) ++
-          []
-
-          where str = "## " ++ show (endpoint^.method)
-                    ++ " " ++ showPath (endpoint^.path)
-
-        introsStr :: [DocIntro] -> [String]
-        introsStr = concatMap introStr
-
-        introStr :: DocIntro -> [String]
-        introStr i =
-            ("#### " ++ i ^. introTitle) :
-            "" :
-            intersperse "" (i ^. introBody) ++
-            "" :
-            []
-
-        notesStr :: [DocNote] -> [String]
-        notesStr = concatMap noteStr
-
-        noteStr :: DocNote -> [String]
-        noteStr nt =
-            ("#### " ++ nt ^. noteTitle) :
-            "" :
-            intersperse "" (nt ^. noteBody) ++
-            "" :
-            []
-
-        capturesStr :: [DocCapture] -> [String]
-        capturesStr [] = []
-        capturesStr l =
-          "#### Captures:" :
-          "" :
-          map captureStr l ++
-          "" :
-          []
-
-        captureStr cap =
-          "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
-
-        mxParamsStr :: [(String, [DocQueryParam])] -> [String]
-        mxParamsStr [] = []
-        mxParamsStr l =
-          "#### Matrix Parameters:" :
-          "" :
-          map segmentStr l
-        segmentStr :: (String, [DocQueryParam]) -> String
-        segmentStr (segment, l) = unlines $
-          ("**" ++ segment ++ "**:") :
-          "" :
-          map paramStr l ++
-          "" :
-          []
-
-        headersStr :: [Text] -> [String]
-        headersStr [] = []
-        headersStr l = [""] ++ map headerStr l ++ [""]
-
-          where headerStr hname = "- This endpoint is sensitive to the value of the **"
-                               ++ unpack hname ++ "** HTTP header."
-
-        paramsStr :: [DocQueryParam] -> [String]
-        paramsStr [] = []
-        paramsStr l =
-          "#### GET Parameters:" :
-          "" :
-          map paramStr l ++
-          "" :
-          []
-
-        paramStr param = unlines $
-          ("- " ++ param ^. paramName) :
-          (if (not (null values) || param ^. paramKind /= Flag)
-            then ["     - **Values**: *" ++ intercalate ", " values ++ "*"]
-            else []) ++
-          ("     - **Description**: " ++ param ^. paramDesc) :
-          (if (param ^. paramKind == List)
-            then ["     - This parameter is a **list**. All GET parameters with the name "
-                  ++ param ^. paramName ++ "[] will forward their values in a list to the handler."]
-            else []) ++
-          (if (param ^. paramKind == Flag)
-            then ["     - This parameter is a **flag**. This means no value is expected to be associated to this parameter."]
-            else []) ++
-          []
-
-          where values = param ^. paramValues
-
-        rqbodyStr :: [M.MediaType] -> [(M.MediaType, ByteString)]-> [String]
-        rqbodyStr [] [] = []
-        rqbodyStr types samples =
-            ["#### Request:", ""]
-            <> formatTypes types
-            <> concatMap formatBody samples
-
-        formatTypes [] = []
-        formatTypes ts = ["- Supported content types are:", ""]
-            <> map (\t -> "    - `" <> show t <> "`") ts
-            <> [""]
-
-        formatBody (m, b) =
-          "- Example: `" <> cs (show m) <> "`" :
-          contentStr m b
-
-        markdownForType mime_type =
-            case (M.mainType mime_type, M.subType mime_type) of
-                ("text", "html") -> "html"
-                ("application", "xml") -> "xml"
-                ("application", "json") -> "javascript"
-                ("application", "javascript") -> "javascript"
-                ("text", "css") -> "css"
-                (_, _) -> ""
-
-        contentStr mime_type body =
-          "" :
-          "```" <> markdownForType mime_type :
-          cs body :
-          "```" :
-          "" :
-          []
-
-        responseStr :: Response -> [String]
-        responseStr resp =
-          "#### Response:" :
-          "" :
-          ("- Status code " ++ show (resp ^. respStatus)) :
-          "" :
-          formatTypes (resp ^. respTypes) ++
-          bodies
-
-          where bodies = case resp ^. respBody of
-                  []        -> ["- No response body\n"]
-                  [("", t, r)] -> "- Response body as below." : contentStr t r
-                  xs        ->
-                    concatMap (\(ctx, t, r) -> ("- " <> T.unpack ctx) : contentStr t r) xs
-
--- * Instances
-
--- | The generated docs for @a ':<|>' b@ just appends the docs
---   for @a@ with the docs for @b@.
-instance (HasDocs layout1, HasDocs layout2)
-      => HasDocs (layout1 :<|> layout2) where
-
-  docsFor Proxy (ep, action) = docsFor p1 (ep, action) <> docsFor p2 (ep, action)
-
-    where p1 :: Proxy layout1
-          p1 = Proxy
-
-          p2 :: Proxy layout2
-          p2 = Proxy
-
--- | @"books" :> 'Capture' "isbn" Text@ will appear as
--- @/books/:isbn@ in the docs.
-instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
-      => HasDocs (Capture sym a :> sublayout) where
-
-  docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint', action')
-
-    where sublayoutP = Proxy :: Proxy sublayout
-          captureP = Proxy :: Proxy (Capture sym a)
-
-          action' = over captures (|> toCapture captureP) action
-          endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
-          symP = Proxy :: Proxy sym
-
-
-instance HasDocs Delete where
-  docsFor Proxy (endpoint, action) =
-    single endpoint' action'
-
-    where endpoint' = endpoint & method .~ DocDELETE
-
-          action' = action & response.respBody .~ []
-                           & response.respStatus .~ 204
-
-instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
-    => HasDocs (Get cts a) where
-  docsFor Proxy (endpoint, action) =
-    single endpoint' action'
-
-    where endpoint' = endpoint & method .~ DocGET
-          action' = action & response.respBody .~ sampleByteStrings t p
-                           & response.respTypes .~ supportedTypes t
-          t = Proxy :: Proxy cts
-          p = Proxy :: Proxy a
-
-instance (KnownSymbol sym, HasDocs sublayout)
-      => HasDocs (Header sym a :> sublayout) where
-  docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint, action')
-
-    where sublayoutP = Proxy :: Proxy sublayout
-          action' = over headers (|> headername) action
-          headername = pack $ symbolVal (Proxy :: Proxy sym)
-
-instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
-    => HasDocs (Post cts a) where
-  docsFor Proxy (endpoint, action) =
-    single endpoint' action'
-
-    where endpoint' = endpoint & method .~ DocPOST
-          action' = action & response.respBody .~ sampleByteStrings t p
-                           & response.respTypes .~ supportedTypes t
-                           & response.respStatus .~ 201
-          t = Proxy :: Proxy cts
-          p = Proxy :: Proxy a
-
-instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
-    => HasDocs (Put cts a) where
-  docsFor Proxy (endpoint, action) =
-    single endpoint' action'
-
-    where endpoint' = endpoint & method .~ DocPUT
-          action' = action & response.respBody .~ sampleByteStrings t p
-                           & response.respTypes .~ supportedTypes t
-                           & response.respStatus .~ 200
-          t = Proxy :: Proxy cts
-          p = Proxy :: Proxy a
-
-instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
-      => HasDocs (QueryParam sym a :> sublayout) where
-
-  docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint, action')
-
-    where sublayoutP = Proxy :: Proxy sublayout
-          paramP = Proxy :: Proxy (QueryParam sym a)
-          action' = over params (|> toParam paramP) action
-
-instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs sublayout)
-      => HasDocs (QueryParams sym a :> sublayout) where
-
-  docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint, action')
-
-    where sublayoutP = Proxy :: Proxy sublayout
-          paramP = Proxy :: Proxy (QueryParams sym a)
-          action' = over params (|> toParam paramP) action
-
-
-instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
-      => HasDocs (QueryFlag sym :> sublayout) where
-
-  docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint, action')
-
-    where sublayoutP = Proxy :: Proxy sublayout
-          paramP = Proxy :: Proxy (QueryFlag sym)
-          action' = over params (|> toParam paramP) action
-
-
-instance (KnownSymbol sym, ToParam (MatrixParam sym a), HasDocs sublayout)
-      => HasDocs (MatrixParam sym a :> sublayout) where
-
-  docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint', action')
-
-    where sublayoutP = Proxy :: Proxy sublayout
-          paramP = Proxy :: Proxy (MatrixParam sym a)
-          segment = endpoint ^. (path._last)
-          segment' = action ^. (mxParams._last._1)
-          endpoint' = over (path._last) (\p -> p ++ ";" ++ symbolVal symP ++ "=<value>") endpoint
-
-          action' = if segment' /= segment
-                    -- This is the first matrix parameter for this segment, insert a new entry into the mxParams list
-                    then over mxParams (|> (segment, [toParam paramP])) action
-                    -- We've already inserted a matrix parameter for this segment, append to the existing list
-                    else action & mxParams._last._2 <>~ [toParam paramP]
-          symP = Proxy :: Proxy sym
-
-
-instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout)
-      => HasDocs (MatrixParams sym a :> sublayout) where
-
-  docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint', action)
-
-    where sublayoutP = Proxy :: Proxy sublayout
-          endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP ++ "=<value>"]) endpoint
-          symP = Proxy :: Proxy sym
-
-
-instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
-      => HasDocs (MatrixFlag sym :> sublayout) where
-
-  docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint', action)
-
-    where sublayoutP = Proxy :: Proxy sublayout
-
-          endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint
-          symP = Proxy :: Proxy sym
-
-instance HasDocs Raw where
-  docsFor _proxy (endpoint, action) =
-    single endpoint action
-
--- TODO: We use 'AllMimeRender' here because we need to be able to show the
--- example data. However, there's no reason to believe that the instances of
--- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
--- both are even defined) for any particular type.
-instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout, SupportedTypes cts)
-      => HasDocs (ReqBody cts a :> sublayout) where
-
-  docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint, action')
-
-    where sublayoutP = Proxy :: Proxy sublayout
-          action' = action & rqbody .~ sampleByteString t p
-                           & rqtypes .~ supportedTypes t
-          t = Proxy :: Proxy cts
-          p = Proxy :: Proxy a
-
-instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where
-
-  docsFor Proxy (endpoint, action) =
-    docsFor sublayoutP (endpoint', action)
-
-    where sublayoutP = Proxy :: Proxy sublayout
-          endpoint' = endpoint & path <>~ [symbolVal pa]
-          pa = Proxy :: Proxy path
-
-{-
-
--- | Serve your API's docs as markdown embedded in an html \<pre> tag.
---
--- > type MyApi = "users" :> Get [User]
--- >         :<|> "docs   :> Raw
--- >
--- > apiProxy :: Proxy MyApi
--- > apiProxy = Proxy
--- >
--- > server :: Server MyApi
--- > server = listUsers
--- >     :<|> serveDocumentation apiProxy
-serveDocumentation :: HasDocs api => Proxy api -> Server Raw
-serveDocumentation proxy _request respond =
-  respond $ responseLBS ok200 [] $ cs $ toHtml $ markdown $ docs proxy
-
-toHtml :: String -> String
-toHtml md =
-  "<html>" ++
-  "<body>" ++
-  "<pre>" ++
-  md ++
-  "</pre>" ++
-  "</body>" ++
-  "</html>"
--}
+import Servant.Docs.Internal
diff --git a/src/Servant/Docs/Internal.hs b/src/Servant/Docs/Internal.hs
new file mode 100644
index 00000000..786157cd
--- /dev/null
+++ b/src/Servant/Docs/Internal.hs
@@ -0,0 +1,803 @@
+{-# LANGUAGE ConstraintKinds      #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE PolyKinds            #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TupleSections        #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Servant.Docs.Internal where
+
+import           Control.Applicative
+import           Control.Lens
+import           Data.ByteString.Lazy.Char8 (ByteString)
+import           Data.Hashable
+import           Data.HashMap.Strict        (HashMap)
+import           Data.List
+import           Data.Maybe
+import           Data.Monoid
+import           Data.Ord                   (comparing)
+import           Data.Proxy
+import           Data.String.Conversions
+import           Data.Text                  (Text, pack, unpack)
+import           GHC.Exts                   (Constraint)
+import           GHC.Generics
+import           GHC.TypeLits
+import           Servant.API
+import           Servant.API.ContentTypes
+import           Servant.Utils.Links
+
+import qualified Data.HashMap.Strict        as HM
+import qualified Data.Text                  as T
+import qualified Network.HTTP.Media         as M
+
+-- | Supported HTTP request methods
+data Method = DocDELETE -- ^ the DELETE method
+            | DocGET    -- ^ the GET method
+            | DocPOST   -- ^ the POST method
+            | DocPUT    -- ^ the PUT method
+  deriving (Eq, Ord, Generic)
+
+instance Show Method where
+  show DocGET = "GET"
+  show DocPOST = "POST"
+  show DocDELETE = "DELETE"
+  show DocPUT = "PUT"
+
+instance Hashable Method
+
+-- | An 'Endpoint' type that holds the 'path' and the 'method'.
+--
+-- Gets used as the key in the 'API' hashmap. Modify 'defEndpoint'
+-- or any 'Endpoint' value you want using the 'path' and 'method'
+-- lenses to tweak.
+--
+-- @
+-- λ> 'defEndpoint'
+-- GET /
+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
+-- GET /foo
+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
+-- POST /foo
+-- @
+data Endpoint = Endpoint
+  { _path   :: [String] -- type collected
+  , _method :: Method   -- type collected
+  } deriving (Eq, Ord, Generic)
+
+instance Show Endpoint where
+  show (Endpoint p m) =
+    show m ++ " " ++ showPath p
+
+-- |
+-- Render a path as a '/'-delimited string
+--
+showPath :: [String] -> String
+showPath [] = "/"
+showPath ps = concatMap ('/' :) ps
+
+-- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'
+--
+-- Here's how you can modify it:
+--
+-- @
+-- λ> 'defEndpoint'
+-- GET /
+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
+-- GET /foo
+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
+-- POST /foo
+-- @
+defEndpoint :: Endpoint
+defEndpoint = Endpoint [] DocGET
+
+instance Hashable Endpoint
+
+-- | Our API documentation type, a product of top-level information and a good
+-- old hashmap from 'Endpoint' to 'Action'
+data API = API
+  { _apiIntros    :: [DocIntro]
+  , _apiEndpoints :: HashMap Endpoint Action
+  } deriving (Eq, Show)
+
+instance Monoid API where
+    API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2)
+    mempty = API mempty mempty
+
+-- | An empty 'API'
+emptyAPI :: API
+emptyAPI = mempty
+
+-- | A type to represent captures. Holds the name of the capture
+--   and a description.
+--
+-- Write a 'ToCapture' instance for your captured types.
+data DocCapture = DocCapture
+  { _capSymbol :: String -- type supplied
+  , _capDesc   :: String -- user supplied
+  } deriving (Eq, Ord, Show)
+
+-- | A type to represent a /GET/ parameter from the Query String. Holds its name,
+--   the possible values (leave empty if there isn't a finite number of them),
+--   and a description of how it influences the output or behavior.
+--
+-- Write a 'ToParam' instance for your GET parameter types
+data DocQueryParam = DocQueryParam
+  { _paramName   :: String   -- type supplied
+  , _paramValues :: [String] -- user supplied
+  , _paramDesc   :: String   -- user supplied
+  , _paramKind   :: ParamKind
+  } deriving (Eq, Ord, Show)
+
+-- | An introductory paragraph for your documentation. You can pass these to
+-- 'docsWithIntros'.
+data DocIntro = DocIntro
+  { _introTitle :: String   -- ^ Appears above the intro blob
+  , _introBody  :: [String] -- ^ Each String is a paragraph.
+  } deriving (Eq, Show)
+
+instance Ord DocIntro where
+    compare = comparing _introTitle
+
+-- | A type to represent extra notes that may be attached to an 'Action'.
+--
+-- This is intended to be used when writing your own HasDocs instances to
+-- add extra sections to your endpoint's documentation.
+data DocNote = DocNote
+  { _noteTitle :: String
+  , _noteBody  :: [String]
+  } deriving (Eq, Ord, Show)
+
+-- | Type of extra information that a user may wish to "union" with their
+-- documentation.
+--
+-- These are intended to be built using extraInfo.
+-- Multiple ExtraInfo may be combined with the monoid instance.
+newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action)
+instance Monoid (ExtraInfo a) where
+    mempty = ExtraInfo mempty
+    ExtraInfo a `mappend` ExtraInfo b =
+        ExtraInfo $ HM.unionWith combineAction a b
+
+-- | Type of GET parameter:
+--
+-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
+-- - List corresponds to @QueryParams@, i.e GET parameters with multiple values
+-- - Flag corresponds to @QueryFlag@, i.e a value-less GET parameter
+data ParamKind = Normal | List | Flag
+  deriving (Eq, Ord, Show)
+
+-- | A type to represent an HTTP response. Has an 'Int' status, a list of
+-- possible 'MediaType's, and a list of example 'ByteString' response bodies.
+-- Tweak 'defResponse' using the 'respStatus', 'respTypes' and 'respBody'
+-- lenses if you want.
+--
+-- If you want to respond with a non-empty response body, you'll most likely
+-- want to write a 'ToSample' instance for the type that'll be represented
+-- as encoded data in the response.
+--
+-- Can be tweaked with three lenses.
+--
+-- > λ> defResponse
+-- > Response {_respStatus = 200, _respTypes = [], _respBody = []}
+-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
+-- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
+data Response = Response
+  { _respStatus :: Int
+  , _respTypes  :: [M.MediaType]
+  , _respBody   :: [(Text, M.MediaType, ByteString)]
+  } deriving (Eq, Ord, Show)
+
+-- | Default response: status code 200, no response body.
+--
+-- Can be tweaked with two lenses.
+--
+-- > λ> defResponse
+-- > Response {_respStatus = 200, _respBody = Nothing}
+-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
+-- > Response {_respStatus = 204, _respBody = Just "[]"}
+defResponse :: Response
+defResponse = Response 200 [] []
+
+-- | A datatype that represents everything that can happen
+-- at an endpoint, with its lenses:
+--
+-- - List of captures ('captures')
+-- - List of GET parameters ('params')
+-- - What the request body should look like, if any is requested ('rqbody')
+-- - What the response should be if everything goes well ('response')
+--
+-- You can tweak an 'Action' (like the default 'defAction') with these lenses
+-- to transform an action and add some information to it.
+data Action = Action
+  { _captures :: [DocCapture]                -- type collected + user supplied info
+  , _headers  :: [Text]                      -- type collected
+  , _params   :: [DocQueryParam]             -- type collected + user supplied info
+  , _notes    :: [DocNote]                   -- user supplied
+  , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
+  , _rqtypes  :: [M.MediaType]               -- type collected
+  , _rqbody   :: [(M.MediaType, ByteString)] -- user supplied
+  , _response :: Response                    -- user supplied
+  } deriving (Eq, Ord, Show)
+
+-- | Combine two Actions, we can't make a monoid as merging Response breaks the
+-- laws.
+--
+-- As such, we invent a non-commutative, left associative operation
+-- 'combineAction' to mush two together taking the response, body and content
+-- types from the very left.
+combineAction :: Action -> Action -> Action
+Action c h p n m ts body resp `combineAction` Action c' h' p' n' m' _ _ _ =
+        Action (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
+
+-- Default 'Action'. Has no 'captures', no GET 'params', expects
+-- no request body ('rqbody') and the typical response is 'defResponse'.
+--
+-- Tweakable with lenses.
+--
+-- > λ> defAction
+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
+-- > λ> defAction & response.respStatus .~ 201
+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
+defAction :: Action
+defAction =
+  Action []
+         []
+         []
+         []
+         []
+         []
+         []
+         defResponse
+
+-- | Create an API that's comprised of a single endpoint.
+--   'API' is a 'Monoid', so combine multiple endpoints with
+--   'mappend' or '<>'.
+single :: Endpoint -> Action -> API
+single e a = API mempty (HM.singleton e a)
+
+-- gimme some lenses
+makeLenses ''API
+makeLenses ''Endpoint
+makeLenses ''DocCapture
+makeLenses ''DocQueryParam
+makeLenses ''DocIntro
+makeLenses ''DocNote
+makeLenses ''Response
+makeLenses ''Action
+
+-- | Generate the docs for a given API that implements 'HasDocs'. This is the
+-- default way to create documentation.
+docs :: HasDocs layout => Proxy layout -> API
+docs p = docsFor p (defEndpoint, defAction)
+
+-- | Closed type family, check if endpoint is exactly within API.
+
+-- We aren't sure what affects how an Endpoint is built up, so we require an
+-- exact match.
+type family IsIn (endpoint :: *) (api :: *) :: Constraint where
+    IsIn e (sa :<|> sb)                = Or (IsIn e sa) (IsIn e sb)
+    IsIn (e :> sa) (e :> sb)           = IsIn sa sb
+    IsIn e e                           = ()
+
+-- | Create an 'ExtraInfo' that is garunteed to be within the given API layout.
+--
+-- The safety here is to ensure that you only add custom documentation to an
+-- endpoint that actually exists within your API.
+--
+-- > extra :: ExtraInfo TestApi
+-- > extra =
+-- >     extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
+-- >              defAction & headers <>~ ["unicorns"]
+-- >                        & notes   <>~ [ DocNote "Title" ["This is some text"]
+-- >                                      , DocNote "Second secton" ["And some more"]
+-- >                                      ]
+
+extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
+          => Proxy endpoint -> Action -> ExtraInfo layout
+extraInfo p action =
+    let api = docsFor p (defEndpoint, defAction)
+    -- Assume one endpoint, HasLink constraint means that we should only ever
+    -- point at one endpoint.
+    in ExtraInfo $ api ^. apiEndpoints & traversed .~ action
+
+-- | Generate documentation given some extra introductions (in the form of
+-- 'DocInfo') and some extra endpoint documentation (in the form of
+-- 'ExtraInfo'.
+--
+-- The extra introductions will be prepended to the top of the documentation,
+-- before the specific endpoint documentation. The extra endpoint documentation
+-- will be "unioned" with the automatically generated endpoint documentation.
+--
+-- You are expected to build up the ExtraInfo with the Monoid instance and
+-- 'extraInfo'.
+--
+-- If you only want to add an introduction, use 'docsWithIntros'.
+docsWith :: HasDocs layout
+         => [DocIntro]
+         -> ExtraInfo layout
+         -> Proxy layout
+         -> API
+docsWith intros (ExtraInfo endpoints) p =
+    docs p & apiIntros <>~ intros
+           & apiEndpoints %~ HM.unionWith combineAction endpoints
+
+
+-- | Generate the docs for a given API that implements 'HasDocs' with with any
+-- number of introduction(s)
+docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
+docsWithIntros intros = docsWith intros mempty
+
+-- | The class that abstracts away the impact of API combinators
+--   on documentation generation.
+class HasDocs layout where
+  docsFor :: Proxy layout -> (Endpoint, Action) -> API
+
+-- | The class that lets us display a sample input or output in the supported
+-- content-types when generating documentation for endpoints that either:
+--
+-- - expect a request body, or
+-- - return a non empty response body
+--
+-- Example of an instance:
+--
+-- > {-# LANGUAGE DeriveGeneric #-}
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- >
+-- > import Data.Aeson
+-- > import Data.Text
+-- > import GHC.Generics
+-- >
+-- > data Greet = Greet { _msg :: Text }
+-- >   deriving (Generic, Show)
+-- >
+-- > instance FromJSON Greet
+-- > instance ToJSON Greet
+-- >
+-- > instance ToSample Greet where
+-- >   toSample = Just g
+-- >
+-- >     where g = Greet "Hello, haskeller!"
+--
+-- You can also instantiate this class using 'toSamples' instead of
+-- 'toSample': it lets you specify different responses along with
+-- some context (as 'Text') that explains when you're supposed to
+-- get the corresponding response.
+class ToSample a where
+  {-# MINIMAL (toSample | toSamples) #-}
+  toSample :: Maybe a
+  toSample = snd <$> listToMaybe samples
+    where samples = toSamples :: [(Text, a)]
+
+  toSamples :: [(Text, a)]
+  toSamples = maybe [] (return . ("",)) s
+    where s = toSample :: Maybe a
+
+-- | Synthesise a sample value of a type, encoded in the specified media types.
+sampleByteString
+    :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
+    => Proxy ctypes
+    -> Proxy a
+    -> [(M.MediaType, ByteString)]
+sampleByteString ctypes@Proxy Proxy =
+    maybe [] (allMimeRender ctypes) (toSample :: Maybe a)
+
+-- | Synthesise a list of sample values of a particular type, encoded in the
+-- specified media types.
+sampleByteStrings
+    :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
+    => Proxy ctypes
+    -> Proxy a
+    -> [(Text, M.MediaType, ByteString)]
+sampleByteStrings ctypes@Proxy Proxy =
+    let samples = toSamples :: [(Text, a)]
+        enc (t, s) = uncurry (t,,) <$> allMimeRender ctypes s
+    in concatMap enc samples
+
+-- | Generate a list of 'MediaType' values describing the content types
+-- accepted by an API component.
+class SupportedTypes (list :: [*]) where
+    supportedTypes :: Proxy list -> [M.MediaType]
+
+instance SupportedTypes '[] where
+    supportedTypes Proxy = []
+
+instance (Accept ctype, SupportedTypes rest) => SupportedTypes (ctype ': rest)
+  where
+    supportedTypes Proxy =
+        contentType (Proxy :: Proxy ctype) : supportedTypes (Proxy :: Proxy rest)
+
+-- | The class that helps us automatically get documentation
+--   for GET parameters.
+--
+-- Example of an instance:
+--
+-- > instance ToParam (QueryParam "capital" Bool) where
+-- >   toParam _ =
+-- >     DocQueryParam "capital"
+-- >                   ["true", "false"]
+-- >                   "Get the greeting message in uppercase (true) or not (false). Default is false."
+class ToParam t where
+  toParam :: Proxy t -> DocQueryParam
+
+-- | The class that helps us automatically get documentation
+--   for URL captures.
+--
+-- Example of an instance:
+--
+-- > instance ToCapture (Capture "name" Text) where
+-- >   toCapture _ = DocCapture "name" "name of the person to greet"
+class ToCapture c where
+  toCapture :: Proxy c -> DocCapture
+
+-- | Generate documentation in Markdown format for
+--   the given 'API'.
+markdown :: API -> String
+markdown api = unlines $
+       introsStr (api ^. apiIntros)
+    ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
+
+  where printEndpoint :: Endpoint -> Action -> [String]
+        printEndpoint endpoint action =
+          str :
+          "" :
+          notesStr (action ^. notes) ++
+          capturesStr (action ^. captures) ++
+          mxParamsStr (action ^. mxParams) ++
+          headersStr (action ^. headers) ++
+          paramsStr (action ^. params) ++
+          rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
+          responseStr (action ^. response) ++
+          []
+
+          where str = "## " ++ show (endpoint^.method)
+                    ++ " " ++ showPath (endpoint^.path)
+
+        introsStr :: [DocIntro] -> [String]
+        introsStr = concatMap introStr
+
+        introStr :: DocIntro -> [String]
+        introStr i =
+            ("#### " ++ i ^. introTitle) :
+            "" :
+            intersperse "" (i ^. introBody) ++
+            "" :
+            []
+
+        notesStr :: [DocNote] -> [String]
+        notesStr = concatMap noteStr
+
+        noteStr :: DocNote -> [String]
+        noteStr nt =
+            ("#### " ++ nt ^. noteTitle) :
+            "" :
+            intersperse "" (nt ^. noteBody) ++
+            "" :
+            []
+
+        capturesStr :: [DocCapture] -> [String]
+        capturesStr [] = []
+        capturesStr l =
+          "#### Captures:" :
+          "" :
+          map captureStr l ++
+          "" :
+          []
+
+        captureStr cap =
+          "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
+
+        mxParamsStr :: [(String, [DocQueryParam])] -> [String]
+        mxParamsStr [] = []
+        mxParamsStr l =
+          "#### Matrix Parameters:" :
+          "" :
+          map segmentStr l
+        segmentStr :: (String, [DocQueryParam]) -> String
+        segmentStr (segment, l) = unlines $
+          ("**" ++ segment ++ "**:") :
+          "" :
+          map paramStr l ++
+          "" :
+          []
+
+        headersStr :: [Text] -> [String]
+        headersStr [] = []
+        headersStr l = [""] ++ map headerStr l ++ [""]
+
+          where headerStr hname = "- This endpoint is sensitive to the value of the **"
+                               ++ unpack hname ++ "** HTTP header."
+
+        paramsStr :: [DocQueryParam] -> [String]
+        paramsStr [] = []
+        paramsStr l =
+          "#### GET Parameters:" :
+          "" :
+          map paramStr l ++
+          "" :
+          []
+
+        paramStr param = unlines $
+          ("- " ++ param ^. paramName) :
+          (if (not (null values) || param ^. paramKind /= Flag)
+            then ["     - **Values**: *" ++ intercalate ", " values ++ "*"]
+            else []) ++
+          ("     - **Description**: " ++ param ^. paramDesc) :
+          (if (param ^. paramKind == List)
+            then ["     - This parameter is a **list**. All GET parameters with the name "
+                  ++ param ^. paramName ++ "[] will forward their values in a list to the handler."]
+            else []) ++
+          (if (param ^. paramKind == Flag)
+            then ["     - This parameter is a **flag**. This means no value is expected to be associated to this parameter."]
+            else []) ++
+          []
+
+          where values = param ^. paramValues
+
+        rqbodyStr :: [M.MediaType] -> [(M.MediaType, ByteString)]-> [String]
+        rqbodyStr [] [] = []
+        rqbodyStr types samples =
+            ["#### Request:", ""]
+            <> formatTypes types
+            <> concatMap formatBody samples
+
+        formatTypes [] = []
+        formatTypes ts = ["- Supported content types are:", ""]
+            <> map (\t -> "    - `" <> show t <> "`") ts
+            <> [""]
+
+        formatBody (m, b) =
+          "- Example: `" <> cs (show m) <> "`" :
+          contentStr m b
+
+        markdownForType mime_type =
+            case (M.mainType mime_type, M.subType mime_type) of
+                ("text", "html") -> "html"
+                ("application", "xml") -> "xml"
+                ("application", "json") -> "javascript"
+                ("application", "javascript") -> "javascript"
+                ("text", "css") -> "css"
+                (_, _) -> ""
+
+        contentStr mime_type body =
+          "" :
+          "```" <> markdownForType mime_type :
+          cs body :
+          "```" :
+          "" :
+          []
+
+        responseStr :: Response -> [String]
+        responseStr resp =
+          "#### Response:" :
+          "" :
+          ("- Status code " ++ show (resp ^. respStatus)) :
+          "" :
+          formatTypes (resp ^. respTypes) ++
+          bodies
+
+          where bodies = case resp ^. respBody of
+                  []        -> ["- No response body\n"]
+                  [("", t, r)] -> "- Response body as below." : contentStr t r
+                  xs        ->
+                    concatMap (\(ctx, t, r) -> ("- " <> T.unpack ctx) : contentStr t r) xs
+
+-- * Instances
+
+-- | The generated docs for @a ':<|>' b@ just appends the docs
+--   for @a@ with the docs for @b@.
+instance (HasDocs layout1, HasDocs layout2)
+      => HasDocs (layout1 :<|> layout2) where
+
+  docsFor Proxy (ep, action) = docsFor p1 (ep, action) <> docsFor p2 (ep, action)
+
+    where p1 :: Proxy layout1
+          p1 = Proxy
+
+          p2 :: Proxy layout2
+          p2 = Proxy
+
+-- | @"books" :> 'Capture' "isbn" Text@ will appear as
+-- @/books/:isbn@ in the docs.
+instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
+      => HasDocs (Capture sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          captureP = Proxy :: Proxy (Capture sym a)
+
+          action' = over captures (|> toCapture captureP) action
+          endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
+          symP = Proxy :: Proxy sym
+
+
+instance HasDocs Delete where
+  docsFor Proxy (endpoint, action) =
+    single endpoint' action'
+
+    where endpoint' = endpoint & method .~ DocDELETE
+
+          action' = action & response.respBody .~ []
+                           & response.respStatus .~ 204
+
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
+    => HasDocs (Get cts a) where
+  docsFor Proxy (endpoint, action) =
+    single endpoint' action'
+
+    where endpoint' = endpoint & method .~ DocGET
+          action' = action & response.respBody .~ sampleByteStrings t p
+                           & response.respTypes .~ supportedTypes t
+          t = Proxy :: Proxy cts
+          p = Proxy :: Proxy a
+
+instance (KnownSymbol sym, HasDocs sublayout)
+      => HasDocs (Header sym a :> sublayout) where
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint, action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          action' = over headers (|> headername) action
+          headername = pack $ symbolVal (Proxy :: Proxy sym)
+
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
+    => HasDocs (Post cts a) where
+  docsFor Proxy (endpoint, action) =
+    single endpoint' action'
+
+    where endpoint' = endpoint & method .~ DocPOST
+          action' = action & response.respBody .~ sampleByteStrings t p
+                           & response.respTypes .~ supportedTypes t
+                           & response.respStatus .~ 201
+          t = Proxy :: Proxy cts
+          p = Proxy :: Proxy a
+
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
+    => HasDocs (Put cts a) where
+  docsFor Proxy (endpoint, action) =
+    single endpoint' action'
+
+    where endpoint' = endpoint & method .~ DocPUT
+          action' = action & response.respBody .~ sampleByteStrings t p
+                           & response.respTypes .~ supportedTypes t
+                           & response.respStatus .~ 200
+          t = Proxy :: Proxy cts
+          p = Proxy :: Proxy a
+
+instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
+      => HasDocs (QueryParam sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint, action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          paramP = Proxy :: Proxy (QueryParam sym a)
+          action' = over params (|> toParam paramP) action
+
+instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs sublayout)
+      => HasDocs (QueryParams sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint, action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          paramP = Proxy :: Proxy (QueryParams sym a)
+          action' = over params (|> toParam paramP) action
+
+
+instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
+      => HasDocs (QueryFlag sym :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint, action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          paramP = Proxy :: Proxy (QueryFlag sym)
+          action' = over params (|> toParam paramP) action
+
+
+instance (KnownSymbol sym, ToParam (MatrixParam sym a), HasDocs sublayout)
+      => HasDocs (MatrixParam sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          paramP = Proxy :: Proxy (MatrixParam sym a)
+          segment = endpoint ^. (path._last)
+          segment' = action ^. (mxParams._last._1)
+          endpoint' = over (path._last) (\p -> p ++ ";" ++ symbolVal symP ++ "=<value>") endpoint
+
+          action' = if segment' /= segment
+                    -- This is the first matrix parameter for this segment, insert a new entry into the mxParams list
+                    then over mxParams (|> (segment, [toParam paramP])) action
+                    -- We've already inserted a matrix parameter for this segment, append to the existing list
+                    else action & mxParams._last._2 <>~ [toParam paramP]
+          symP = Proxy :: Proxy sym
+
+
+instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout)
+      => HasDocs (MatrixParams sym a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action)
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP ++ "=<value>"]) endpoint
+          symP = Proxy :: Proxy sym
+
+
+instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
+      => HasDocs (MatrixFlag sym :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action)
+
+    where sublayoutP = Proxy :: Proxy sublayout
+
+          endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint
+          symP = Proxy :: Proxy sym
+
+instance HasDocs Raw where
+  docsFor _proxy (endpoint, action) =
+    single endpoint action
+
+-- TODO: We use 'AllMimeRender' here because we need to be able to show the
+-- example data. However, there's no reason to believe that the instances of
+-- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
+-- both are even defined) for any particular type.
+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout, SupportedTypes cts)
+      => HasDocs (ReqBody cts a :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint, action')
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          action' = action & rqbody .~ sampleByteString t p
+                           & rqtypes .~ supportedTypes t
+          t = Proxy :: Proxy cts
+          p = Proxy :: Proxy a
+
+instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor sublayoutP (endpoint', action)
+
+    where sublayoutP = Proxy :: Proxy sublayout
+          endpoint' = endpoint & path <>~ [symbolVal pa]
+          pa = Proxy :: Proxy path
+
+{-
+
+-- | Serve your API's docs as markdown embedded in an html \<pre> tag.
+--
+-- > type MyApi = "users" :> Get [User]
+-- >         :<|> "docs   :> Raw
+-- >
+-- > apiProxy :: Proxy MyApi
+-- > apiProxy = Proxy
+-- >
+-- > server :: Server MyApi
+-- > server = listUsers
+-- >     :<|> serveDocumentation apiProxy
+serveDocumentation :: HasDocs api => Proxy api -> Server Raw
+serveDocumentation proxy _request respond =
+  respond $ responseLBS ok200 [] $ cs $ toHtml $ markdown $ docs proxy
+
+toHtml :: String -> String
+toHtml md =
+  "<html>" ++
+  "<body>" ++
+  "<pre>" ++
+  md ++
+  "</pre>" ++
+  "</body>" ++
+  "</html>"
+-}
diff --git a/test/Servant/DocsSpec.hs b/test/Servant/DocsSpec.hs
new file mode 100644
index 00000000..bc8b75ab
--- /dev/null
+++ b/test/Servant/DocsSpec.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+module Servant.DocsSpec where
+
+import           Data.Aeson
+import           Data.Proxy
+import           Data.String.Conversions (cs)
+import           GHC.Generics
+import           Test.Hspec
+
+import           Servant.API
+import           Servant.Docs.Internal
+
+spec :: Spec
+spec = describe "Servant.Docs" $ do
+
+  describe "markdown" $ do
+    let md = markdown (docs (Proxy :: Proxy TestApi1))
+
+    it "mentions supported content-types" $ do
+      md `shouldContain` "application/json"
+      md `shouldContain` "text/plain;charset=utf-8"
+
+    it "mentions status codes" $ do
+      md `shouldContain` "Status code 200"
+      md `shouldContain` "Status code 201"
+
+    it "mentions methods" $ do
+      md `shouldContain` "POST"
+      md `shouldContain` "GET"
+
+    it "contains response samples" $ do
+      md `shouldContain` "{\"dt1field1\":\"field 1\",\"dt1field2\":13}"
+    it "contains request body samples" $ do
+      md `shouldContain` "17"
+-- * APIs
+
+data Datatype1 = Datatype1 { dt1field1 :: String
+                           , dt1field2 :: Int
+                           } deriving (Eq, Show, Generic)
+
+instance ToJSON Datatype1
+
+instance ToSample Datatype1 where
+  toSample = Just $ Datatype1 "field 1" 13
+
+instance ToSample String where
+  toSample = Just "a string"
+
+instance ToSample Int where
+  toSample = Just 17
+
+instance MimeRender PlainText Int where
+  toByteString _ = cs . show
+
+
+type TestApi1 = Get '[JSON, PlainText] Int
+           :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
+
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 00000000..a824f8c3
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

From b23b3341288a349b40182b94e510cb415e2fb849 Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Sun, 19 Apr 2015 14:35:42 +0200
Subject: [PATCH 52/54] Canonicalize API before generating docs.

---
 CHANGELOG.md                 | 1 +
 src/Servant/Docs/Internal.hs | 8 ++++----
 2 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 2263072d..a0c1330b 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,6 +5,7 @@
 * Render endpoints in a canonical order (https://github.com/haskell-servant/servant-docs/pull/15)
 * Remove ToJSON superclass from ToSample
 * Split out Internal module
+* `Canonicalize` API types before generating the docs for them
 
 0.3
 ---
diff --git a/src/Servant/Docs/Internal.hs b/src/Servant/Docs/Internal.hs
index 786157cd..408e1cdb 100644
--- a/src/Servant/Docs/Internal.hs
+++ b/src/Servant/Docs/Internal.hs
@@ -273,8 +273,8 @@ makeLenses ''Action
 
 -- | Generate the docs for a given API that implements 'HasDocs'. This is the
 -- default way to create documentation.
-docs :: HasDocs layout => Proxy layout -> API
-docs p = docsFor p (defEndpoint, defAction)
+docs :: HasDocs (Canonicalize layout) => Proxy layout -> API
+docs p = docsFor (canonicalize p) (defEndpoint, defAction)
 
 -- | Closed type family, check if endpoint is exactly within API.
 
@@ -318,7 +318,7 @@ extraInfo p action =
 -- 'extraInfo'.
 --
 -- If you only want to add an introduction, use 'docsWithIntros'.
-docsWith :: HasDocs layout
+docsWith :: HasDocs (Canonicalize layout)
          => [DocIntro]
          -> ExtraInfo layout
          -> Proxy layout
@@ -330,7 +330,7 @@ docsWith intros (ExtraInfo endpoints) p =
 
 -- | Generate the docs for a given API that implements 'HasDocs' with with any
 -- number of introduction(s)
-docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
+docsWithIntros :: HasDocs (Canonicalize layout) => [DocIntro] -> Proxy layout -> API
 docsWithIntros intros = docsWith intros mempty
 
 -- | The class that abstracts away the impact of API combinators

From 47aeb20c4b4d809473a82e2b10f800b462a734bd Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Sun, 19 Apr 2015 14:51:34 +0200
Subject: [PATCH 53/54] Fix mimeRender name change

---
 example/greet.hs         | 2 +-
 test/Servant/DocsSpec.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index e5734472..fc649607 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -27,7 +27,7 @@ instance ToJSON Greet
 
 -- | We can also implement 'MimeRender' for additional formats like 'PlainText'.
 instance MimeRender PlainText Greet where
-    toByteString Proxy (Greet s) = "\"" <> cs s <> "\""
+    mimeRender Proxy (Greet s) = "\"" <> cs s <> "\""
 
 -- We add some useful annotations to our captures,
 -- query parameters and request body to make the docs
diff --git a/test/Servant/DocsSpec.hs b/test/Servant/DocsSpec.hs
index bc8b75ab..803823ba 100644
--- a/test/Servant/DocsSpec.hs
+++ b/test/Servant/DocsSpec.hs
@@ -56,7 +56,7 @@ instance ToSample Int where
   toSample = Just 17
 
 instance MimeRender PlainText Int where
-  toByteString _ = cs . show
+  mimeRender _ = cs . show
 
 
 type TestApi1 = Get '[JSON, PlainText] Int

From 88f1a3fc15dd28d4936aef862813ae748af54e95 Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Mon, 20 Apr 2015 11:19:48 +0200
Subject: [PATCH 54/54] prepare merge

---
 .gitignore                                    | 17 ----------------
 .travis.yml                                   | 20 -------------------
 CHANGELOG.md => servant-docs/CHANGELOG.md     |  0
 LICENSE => servant-docs/LICENSE               |  0
 README.md => servant-docs/README.md           |  0
 Setup.hs => servant-docs/Setup.hs             |  0
 default.nix => servant-docs/default.nix       |  0
 docs.sh => servant-docs/docs.sh               |  0
 {example => servant-docs/example}/greet.hs    |  0
 {example => servant-docs/example}/greet.md    |  0
 .../servant-docs.cabal                        |  0
 shell.nix => servant-docs/shell.nix           |  0
 {src => servant-docs/src}/Servant/Docs.hs     |  0
 .../src}/Servant/Docs/Internal.hs             |  0
 .../test}/Servant/DocsSpec.hs                 |  0
 {test => servant-docs/test}/Spec.hs           |  0
 16 files changed, 37 deletions(-)
 delete mode 100644 .gitignore
 delete mode 100644 .travis.yml
 rename CHANGELOG.md => servant-docs/CHANGELOG.md (100%)
 rename LICENSE => servant-docs/LICENSE (100%)
 rename README.md => servant-docs/README.md (100%)
 rename Setup.hs => servant-docs/Setup.hs (100%)
 rename default.nix => servant-docs/default.nix (100%)
 rename docs.sh => servant-docs/docs.sh (100%)
 rename {example => servant-docs/example}/greet.hs (100%)
 rename {example => servant-docs/example}/greet.md (100%)
 rename servant-docs.cabal => servant-docs/servant-docs.cabal (100%)
 rename shell.nix => servant-docs/shell.nix (100%)
 rename {src => servant-docs/src}/Servant/Docs.hs (100%)
 rename {src => servant-docs/src}/Servant/Docs/Internal.hs (100%)
 rename {test => servant-docs/test}/Servant/DocsSpec.hs (100%)
 rename {test => servant-docs/test}/Spec.hs (100%)

diff --git a/.gitignore b/.gitignore
deleted file mode 100644
index 0855a79b..00000000
--- a/.gitignore
+++ /dev/null
@@ -1,17 +0,0 @@
-dist
-cabal-dev
-*.o
-*.hi
-*.chi
-*.chs.h
-*.dyn_o
-*.dyn_hi
-.virtualenv
-.hpc
-.hsenv
-.cabal-sandbox/
-cabal.sandbox.config
-cabal.config
-*.prof
-*.aux
-*.hp
diff --git a/.travis.yml b/.travis.yml
deleted file mode 100644
index 41be6fa3..00000000
--- a/.travis.yml
+++ /dev/null
@@ -1,20 +0,0 @@
-language: haskell
-
-ghc:
-  - 7.8
-
-before_install:
-  - git clone https://github.com/haskell-servant/servant.git
-  - cabal sandbox init
-  - cabal sandbox add-source servant/
-
-notifications:
-  irc:
-    channels:
-      - "irc.freenode.org#servant"
-    template:
-      - "%{repository}#%{build_number} - %{commit} on %{branch} by %{author}: %{message}"
-      - "Build details: %{build_url} - Change view: %{compare_url}"
-    skip_join: true
-    on_success: change
-    on_failure: always
diff --git a/CHANGELOG.md b/servant-docs/CHANGELOG.md
similarity index 100%
rename from CHANGELOG.md
rename to servant-docs/CHANGELOG.md
diff --git a/LICENSE b/servant-docs/LICENSE
similarity index 100%
rename from LICENSE
rename to servant-docs/LICENSE
diff --git a/README.md b/servant-docs/README.md
similarity index 100%
rename from README.md
rename to servant-docs/README.md
diff --git a/Setup.hs b/servant-docs/Setup.hs
similarity index 100%
rename from Setup.hs
rename to servant-docs/Setup.hs
diff --git a/default.nix b/servant-docs/default.nix
similarity index 100%
rename from default.nix
rename to servant-docs/default.nix
diff --git a/docs.sh b/servant-docs/docs.sh
similarity index 100%
rename from docs.sh
rename to servant-docs/docs.sh
diff --git a/example/greet.hs b/servant-docs/example/greet.hs
similarity index 100%
rename from example/greet.hs
rename to servant-docs/example/greet.hs
diff --git a/example/greet.md b/servant-docs/example/greet.md
similarity index 100%
rename from example/greet.md
rename to servant-docs/example/greet.md
diff --git a/servant-docs.cabal b/servant-docs/servant-docs.cabal
similarity index 100%
rename from servant-docs.cabal
rename to servant-docs/servant-docs.cabal
diff --git a/shell.nix b/servant-docs/shell.nix
similarity index 100%
rename from shell.nix
rename to servant-docs/shell.nix
diff --git a/src/Servant/Docs.hs b/servant-docs/src/Servant/Docs.hs
similarity index 100%
rename from src/Servant/Docs.hs
rename to servant-docs/src/Servant/Docs.hs
diff --git a/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs
similarity index 100%
rename from src/Servant/Docs/Internal.hs
rename to servant-docs/src/Servant/Docs/Internal.hs
diff --git a/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs
similarity index 100%
rename from test/Servant/DocsSpec.hs
rename to servant-docs/test/Servant/DocsSpec.hs
diff --git a/test/Spec.hs b/servant-docs/test/Spec.hs
similarity index 100%
rename from test/Spec.hs
rename to servant-docs/test/Spec.hs