@@ -1,10 +1,12 @@
11{-# LANGUAGE TypeFamilies #-}
22{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE TupleSections #-}
34{-# LANGUAGE TypeOperators #-}
5+{-# LANGUAGE TemplateHaskell #-}
46{-# LANGUAGE FlexibleContexts #-}
57{-# LANGUAGE FlexibleInstances #-}
8+{-# LANGUAGE OverloadedStrings #-}
69{-# LANGUAGE ScopedTypeVariables #-}
7−{-# LANGUAGE TemplateHaskell #-}
810
911-------------------------------------------------------------------------------
1012-- | This module lets you get API docs for free. It lets generate
@@ -83,12 +85,10 @@ module Servant.Docs
8385 ( -- * 'HasDocs' class and key functions
8486 HasDocs(..), docs, markdown
8587
86− {- , -- * Serving the documentation
87− serveDocumentation -}
88−
8988 , -- * Classes you need to implement for your types
9089 ToSample(..)
9190 , sampleByteString
91+ , sampleByteStrings
9292 , ToParam(..)
9393 , ToCapture(..)
9494
@@ -99,7 +99,7 @@ module Servant.Docs
9999 , DocCapture(..), capSymbol, capDesc
100100 , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
101101 , Response, respStatus, respBody, defResponse
102− , Action, captures, params, rqbody, response, defAction
102+ , Action, captures, headers, params, rqbody, response, defAction
103103 , single
104104
105105 , -- * Useful modules when defining your doc printers
@@ -114,6 +114,7 @@ import Data.ByteString.Lazy.Char8 (ByteString)
114114import Data.Hashable
115115import Data.HashMap.Strict (HashMap)
116116import Data.List
117+import Data.Maybe (listToMaybe)
117118import Data.Monoid
118119import Data.Proxy
119120import Data.Text (Text, pack, unpack)
@@ -123,6 +124,7 @@ import GHC.TypeLits
123124import Servant.API
124125
125126import qualified Data.HashMap.Strict as HM
127+import qualified Data.Text as T
126128
127129-- | Supported HTTP request methods
128130data Method = DocDELETE -- ^ the DELETE method
@@ -148,19 +150,26 @@ instance Hashable Method
148150-- @
149151-- λ> 'defEndpoint'
150152-- GET /
151−-- λ> 'defEndpoint' & 'path' '<>~' "foo"
153+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
152154-- GET /foo
153−-- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST'
155+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
154156-- POST /foo
155157-- @
156158data Endpoint = Endpoint
157− { _path :: String -- type collected
158− , _method :: Method -- type collected
159+ { _path :: [String] -- type collected
160+ , _method :: Method -- type collected
159161 } deriving (Eq, Generic)
160162
161163instance Show Endpoint where
162164 show (Endpoint p m) =
163− show m ++ " " ++ p
165+ show m ++ " " ++ showPath p
166+
167+-- |
168+-- Render a path as a '/'-delimited string
169+--
170+showPath :: [String] -> String
171+showPath [] = "/"
172+showPath ps = concatMap ('/' :) ps
164173
165174-- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'
166175--
@@ -169,13 +178,13 @@ instance Show Endpoint where
169178-- @
170179-- λ> 'defEndpoint'
171180-- GET /
172−-- λ> 'defEndpoint' & 'path' '<>~' "foo"
181+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
173182-- GET /foo
174−-- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST'
183+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
175184-- POST /foo
176185-- @
177186defEndpoint :: Endpoint
178−defEndpoint = Endpoint "/" DocGET
187+defEndpoint = Endpoint [] DocGET
179188
180189instance Hashable Endpoint
181190
@@ -226,12 +235,12 @@ data ParamKind = Normal | List | Flag
226235-- Can be tweaked with two lenses.
227236--
228237-- > λ> defResponse
229−-- > Response {_respStatus = 200, _respBody = Nothing}
230−-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
231−-- > Response {_respStatus = 204, _respBody = Just "[]"}
238+-- > Response {_respStatus = 200, _respBody = []}
239+-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
240+-- > Response {_respStatus = 204, _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
232241data Response = Response
233242 { _respStatus :: Int
234− , _respBody :: Maybe ByteString
243+ , _respBody :: [(Text, ByteString)]
235244 } deriving (Eq, Show)
236245
237246-- | Default response: status code 200, no response body.
@@ -243,7 +252,7 @@ data Response = Response
243252-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
244253-- > Response {_respStatus = 204, _respBody = Just "[]"}
245254defResponse :: Response
246−defResponse = Response 200 Nothing
255+defResponse = Response 200 []
247256
248257-- | A datatype that represents everything that can happen
249258-- at an endpoint, with its lenses:
@@ -327,15 +336,29 @@ class HasDocs layout where
327336-- > toSample = Just g
328337-- >
329338-- > where g = Greet "Hello, haskeller!"
339+--
340+-- You can also instantiate this class using 'toSamples' instead of
341+-- 'toSample': it lets you specify different responses along with
342+-- some context (as 'Text') that explains when you're supposed to
343+-- get the corresponding response.
330344class ToJSON a => ToSample a where
345+ {-# MINIMAL (toSample | toSamples) #-}
331346 toSample :: Maybe a
347+ toSample = fmap snd $ listToMaybe samples
348+ where samples = toSamples :: [(Text, a)]
332349
333−instance ToSample () where
334− toSample = Just ()
350+ toSamples :: [(Text, a)]
351+ toSamples = maybe [] (return . ("",)) s
352+ where s = toSample :: Maybe a
335353
336−sampleByteString :: forall a . ToSample a => Proxy a -> Maybe ByteString
354+sampleByteString :: forall a. ToSample a => Proxy a -> Maybe ByteString
337355sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a)
338356
357+sampleByteStrings :: forall a. ToSample a => Proxy a -> [(Text, ByteString)]
358+sampleByteStrings Proxy = samples & traverse._2 %~ encodePretty
359+
360+ where samples = toSamples :: [(Text, a)]
361+
339362-- | The class that helps us automatically get documentation
340363-- for GET parameters.
341364--
@@ -376,7 +399,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
376399 responseStr (action ^. response) ++
377400 []
378401
379− where str = show (endpoint^.method) ++ " " ++ endpoint^.path
402+ where str = show (endpoint^.method) ++ " " ++ showPath (endpoint^.path)
380403 len = length str
381404
382405 capturesStr :: [DocCapture] -> [String]
@@ -441,9 +464,13 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
441464 "**Response**: " :
442465 "" :
443466 (" - Status code " ++ show (resp ^. respStatus)) :
444− (resp ^. respBody &
445− maybe [" - No response body\n"]
446− (\b -> " - Response body as below." : jsonStr b))
467+ bodies
468+
469+ where bodies = case resp ^. respBody of
470+ [] -> [" - No response body\n"]
471+ [("", r)] -> " - Response body as below." : jsonStr r
472+ xs ->
473+ concatMap (\(ctx, r) -> (" - " <> T.unpack ctx) : jsonStr r) xs
447474
448475-- * Instances
449476
@@ -472,7 +499,7 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
472499 captureP = Proxy :: Proxy (Capture sym a)
473500
474501 action' = over captures (|> toCapture captureP) action
475− endpoint' = over path (\p -> p++"/:"++symbolVal symP) endpoint
502+ endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
476503 symP = Proxy :: Proxy sym
477504
478505
@@ -482,7 +509,7 @@ instance HasDocs Delete where
482509
483510 where endpoint' = endpoint & method .~ DocDELETE
484511
485− action' = action & response.respBody .~ Nothing
512+ action' = action & response.respBody .~ []
486513 & response.respStatus .~ 204
487514
488515instance ToSample a => HasDocs (Get a) where
@@ -490,7 +517,7 @@ instance ToSample a => HasDocs (Get a) where
490517 single endpoint' action'
491518
492519 where endpoint' = endpoint & method .~ DocGET
493− action' = action & response.respBody .~ sampleByteString p
520+ action' = action & response.respBody .~ sampleByteStrings p
494521 p = Proxy :: Proxy a
495522
496523instance (KnownSymbol sym, HasDocs sublayout)
@@ -508,7 +535,7 @@ instance ToSample a => HasDocs (Post a) where
508535
509536 where endpoint' = endpoint & method .~ DocPOST
510537
511− action' = action & response.respBody .~ sampleByteString p
538+ action' = action & response.respBody .~ sampleByteStrings p
512539 & response.respStatus .~ 201
513540
514541 p = Proxy :: Proxy a
@@ -519,7 +546,7 @@ instance ToSample a => HasDocs (Put a) where
519546
520547 where endpoint' = endpoint & method .~ DocPUT
521548
522− action' = action & response.respBody .~ sampleByteString p
549+ action' = action & response.respBody .~ sampleByteStrings p
523550 & response.respStatus .~ 200
524551
525552 p = Proxy :: Proxy a
@@ -614,7 +641,7 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh
614641 docsFor sublayoutP (endpoint', action)
615642
616643 where sublayoutP = Proxy :: Proxy sublayout
617− endpoint' = endpoint & path <>~ symbolVal pa
644+ endpoint' = endpoint & path <>~ [symbolVal pa]
618645 pa = Proxy :: Proxy path
619646
620647{-