Merged in 0.3

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.

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
 

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

example/greet.md

@@ -1,4 +1,3 @@
-
 POST /greet
 -----------
 
@@ -13,11 +12,19 @@ POST /greet
 **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"
 }
 ```
 
@@ -38,11 +45,19 @@ GET /hello/:name
 **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"
 }
 ```
 

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

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(..)
 
@@ -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
@@ -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
@@ -148,19 +150,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
+  { _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 +178,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
 
@@ -226,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.
@@ -243,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:
@@ -327,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 Proxy = fmap encodePretty (toSample :: Maybe a)
 
+sampleByteStrings :: forall a. 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.
 --
@@ -376,7 +399,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]
@@ -441,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
 
@@ -472,7 +499,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
 
 
@@ -482,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
@@ -490,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)
@@ -508,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
@@ -519,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
@@ -614,7 +641,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
 
 {-