@@ -1,426 +0,0 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−{-# LANGUAGE TemplateHaskell #-}
5−
6−-------------------------------------------------------------------------------
7−-- | This module lets you get API docs for free. It lets generate
8−-- an 'API' from the type that represents your API using 'docs':
9−--
10−-- @docs :: 'HasDocs' api => 'Proxy' api -> 'API'@
11−--
12−-- You can then call 'markdown' on it:
13−--
14−-- @printMarkdown :: 'API' -> String@
15−--
16−-- or define a custom pretty printer:
17−--
18−-- @yourPrettyDocs :: 'API' -> String -- or blaze-html's HTML, or ...@
19−--
20−-- The only thing you'll need to do will be to implement some classes
21−-- for your captures, get parameters and request or response bodies.
22−--
23−-- Here's a little (but complete) example that you can run to see the
24−-- markdown pretty printer in action:
25−--
26−-- > {-# LANGUAGE DataKinds #-}
27−-- > {-# LANGUAGE PolyKinds #-}
28−-- > {-# LANGUAGE TypeFamilies #-}
29−-- > {-# LANGUAGE DeriveGeneric #-}
30−-- > {-# LANGUAGE TypeOperators #-}
31−-- > {-# LANGUAGE FlexibleInstances #-}
32−-- > {-# LANGUAGE OverloadedStrings #-}
33−-- >
34−-- > import Data.Proxy
35−-- > import Data.Text
36−-- > import Servant
37−-- >
38−-- > -- our type for a Greeting message
39−-- > data Greet = Greet { _msg :: Text }
40−-- > deriving (Generic, Show)
41−-- >
42−-- > -- we get our JSON serialization for free
43−-- > instance FromJSON Greet
44−-- > instance ToJSON Greet
45−-- >
46−-- > -- we provide a sample value for the 'Greet' type
47−-- > instance ToSample Greet where
48−-- > toSample = Just g
49−-- >
50−-- > where g = Greet "Hello, haskeller!"
51−-- >
52−-- > instance ToParam (QueryParam "capital" Bool) where
53−-- > toParam _ =
54−-- > DocQueryParam "capital"
55−-- > ["true", "false"]
56−-- > "Get the greeting message in uppercase (true) or not (false). Default is false."
57−-- >
58−-- > instance ToCapture (Capture "name" Text) where
59−-- > toCapture _ = DocCapture "name" "name of the person to greet"
60−-- >
61−-- > instance ToCapture (Capture "greetid" Text) where
62−-- > toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
63−-- >
64−-- > -- API specification
65−-- > type TestApi =
66−-- > "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
67−-- > :<|> "greet" :> RQBody Greet :> Post Greet
68−-- > :<|> "delete" :> Capture "greetid" Text :> Delete
69−-- >
70−-- > testApi :: Proxy TestApi
71−-- > testApi = Proxy
72−-- >
73−-- > -- Generate the Documentation's ADT
74−-- > greetDocs :: API
75−-- > greetDocs = docs testApi
76−-- >
77−-- > main :: IO ()
78−-- > main = putStrLn $ markdown greetDocs
79−module Servant.Docs
80− ( -- * 'HasDocs' class and key functions
81− HasDocs(..), docs, markdown
82−
83− , -- * Classes you need to implement for your types
84− ToSample(..)
85− , sampleByteString
86− , ToParam(..)
87− , ToCapture(..)
88−
89− , -- * ADTs to represent an 'API'
90− Method(..)
91− , Endpoint, path, method, defEndpoint
92− , API, emptyAPI
93− , DocCapture(..), capSymbol, capDesc
94− , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
95− , Response, respStatus, respBody, defResponse
96− , Action, captures, params, rqbody, response, defAction
97− , single
98−
99− , -- * Useful modules when defining your doc printers
100− module Control.Lens
101− , module Data.Monoid
102− ) where
103−
104−import Control.Lens hiding (Action)
105−import Data.Aeson
106−import Data.ByteString.Lazy.Char8 (ByteString)
107−import Data.Hashable
108−import Data.HashMap.Strict (HashMap)
109−import Data.List
110−import Data.Monoid
111−import Data.Proxy
112−import Data.String.Conversions
113−import GHC.Generics
114−
115−import qualified Data.HashMap.Strict as HM
116−
117−-- | Supported HTTP request methods
118−data Method = DocDELETE -- ^ the DELETE method
119− | DocGET -- ^ the GET method
120− | DocPOST -- ^ the POST method
121− | DocPUT -- ^ the PUT method
122− deriving (Eq, Generic)
123−
124−instance Show Method where
125− show DocGET = "GET"
126− show DocPOST = "POST"
127− show DocDELETE = "DELETE"
128− show DocPUT = "PUT"
129−
130−instance Hashable Method
131−
132−-- | An 'Endpoint' type that holds the 'path' and the 'method'.
133−--
134−-- Gets used as the key in the 'API' hashmap. Modify 'defEndpoint'
135−-- or any 'Endpoint' value you want using the 'path' and 'method'
136−-- lenses to tweak.
137−--
138−-- @
139−-- λ> 'defEndpoint'
140−-- GET /
141−-- λ> 'defEndpoint' & 'path' '<>~' "foo"
142−-- GET /foo
143−-- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST'
144−-- POST /foo
145−-- @
146−data Endpoint = Endpoint
147− { _path :: String -- type collected
148− , _method :: Method -- type collected
149− } deriving (Eq, Generic)
150−
151−instance Show Endpoint where
152− show (Endpoint p m) =
153− show m ++ " " ++ p
154−
155−-- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'
156−--
157−-- Here's how you can modify it:
158−--
159−-- @
160−-- λ> 'defEndpoint'
161−-- GET /
162−-- λ> 'defEndpoint' & 'path' '<>~' "foo"
163−-- GET /foo
164−-- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST'
165−-- POST /foo
166−-- @
167−defEndpoint :: Endpoint
168−defEndpoint = Endpoint "/" DocGET
169−
170−instance Hashable Endpoint
171−
172−-- | Our API type, a good old hashmap from 'Endpoint' to 'Action'
173−type API = HashMap Endpoint Action
174−
175−-- | An empty 'API'
176−emptyAPI :: API
177−emptyAPI = HM.empty
178−
179−-- | A type to represent captures. Holds the name of the capture
180−-- and a description.
181−--
182−-- Write a 'ToCapture' instance for your captured types.
183−data DocCapture = DocCapture
184− { _capSymbol :: String -- type supplied
185− , _capDesc :: String -- user supplied
186− } deriving (Eq, Show)
187−
188−-- | A type to represent a /GET/ parameter from the Query String. Holds its name,
189−-- the possible values (leave empty if there isn't a finite number of them),
190−-- and a description of how it influences the output or behavior.
191−--
192−-- Write a 'ToParam' instance for your GET parameter types
193−data DocQueryParam = DocQueryParam
194− { _paramName :: String -- type supplied
195− , _paramValues :: [String] -- user supplied
196− , _paramDesc :: String -- user supplied
197− , _paramKind :: ParamKind
198− } deriving (Eq, Show)
199−
200−-- | Type of GET parameter:
201−--
202−-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
203−-- - List corresponds to @QueryParams@, i.e GET parameters with multiple values
204−-- - Flag corresponds to @QueryFlag@, i.e a value-less GET parameter
205−data ParamKind = Normal | List | Flag
206− deriving (Eq, Show)
207−
208−-- | A type to represent an HTTP response. Has an 'Int' status and
209−-- a 'Maybe ByteString' response body. Tweak 'defResponse' using
210−-- the 'respStatus' and 'respBody' lenses if you want.
211−--
212−-- If you want to respond with a non-empty response body, you'll most likely
213−-- want to write a 'ToSample' instance for the type that'll be represented
214−-- as some JSON in the response.
215−--
216−-- Can be tweaked with two lenses.
217−--
218−-- > λ> defResponse
219−-- > Response {_respStatus = 200, _respBody = Nothing}
220−-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
221−-- > Response {_respStatus = 204, _respBody = Just "[]"}
222−data Response = Response
223− { _respStatus :: Int
224− , _respBody :: Maybe ByteString
225− } deriving (Eq, Show)
226−
227−-- | Default response: status code 200, no response body.
228−--
229−-- Can be tweaked with two lenses.
230−--
231−-- > λ> defResponse
232−-- > Response {_respStatus = 200, _respBody = Nothing}
233−-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
234−-- > Response {_respStatus = 204, _respBody = Just "[]"}
235−defResponse :: Response
236−defResponse = Response 200 Nothing
237−
238−-- | A datatype that represents everything that can happen
239−-- at an endpoint, with its lenses:
240−--
241−-- - List of captures ('captures')
242−-- - List of GET parameters ('params')
243−-- - What the request body should look like, if any is requested ('rqbody')
244−-- - What the response should be if everything goes well ('response')
245−--
246−-- You can tweak an 'Action' (like the default 'defAction') with these lenses
247−-- to transform an action and add some information to it.
248−data Action = Action
249− { _captures :: [DocCapture] -- type collected + user supplied info
250− , _params :: [DocQueryParam] -- type collected + user supplied info
251− , _rqbody :: Maybe ByteString -- user supplied
252− , _response :: Response -- user supplied
253− } deriving (Eq, Show)
254−
255−-- Default 'Action'. Has no 'captures', no GET 'params', expects
256−-- no request body ('rqbody') and the typical response is 'defResponse'.
257−--
258−-- Tweakable with lenses.
259−--
260−-- > λ> defAction
261−-- > Action {_captures = [], _params = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
262−-- > λ> defAction & response.respStatus .~ 201
263−-- > Action {_captures = [], _params = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
264−defAction :: Action
265−defAction =
266− Action []
267− []
268− Nothing
269− defResponse
270−
271−-- | Create an API that's comprised of a single endpoint.
272−-- 'API' is a 'Monoid', so combine multiple endpoints with
273−-- 'mappend' or '<>'.
274−single :: Endpoint -> Action -> API
275−single = HM.singleton
276−
277−-- gimme some lenses
278−makeLenses ''Endpoint
279−makeLenses ''DocCapture
280−makeLenses ''DocQueryParam
281−makeLenses ''Response
282−makeLenses ''Action
283−
284−-- | Generate the docs for a given API that implements 'HasDocs'.
285−docs :: HasDocs layout => Proxy layout -> API
286−docs p = docsFor p (defEndpoint, defAction)
287−
288−-- | The class that abstracts away the impact of API combinators
289−-- on documentation generation.
290−class HasDocs layout where
291− docsFor :: Proxy layout -> (Endpoint, Action) -> API
292−
293−-- | The class that lets us display a sample JSON input or output
294−-- when generating documentation for endpoints that either:
295−--
296−-- - expect a request body, or
297−-- - return a non empty response body
298−--
299−-- Example of an instance:
300−--
301−-- > {-# LANGUAGE DeriveGeneric #-}
302−-- > {-# LANGUAGE OverloadedStrings #-}
303−-- >
304−-- > import Data.Aeson
305−-- > import Data.Text
306−-- > import GHC.Generics
307−-- >
308−-- > data Greet = Greet { _msg :: Text }
309−-- > deriving (Generic, Show)
310−-- >
311−-- > instance FromJSON Greet
312−-- > instance ToJSON Greet
313−-- >
314−-- > instance ToSample Greet where
315−-- > toSample = Just g
316−-- >
317−-- > where g = Greet "Hello, haskeller!"
318−class ToJSON a => ToSample a where
319− toSample :: Maybe a
320−
321−instance ToSample () where
322− toSample = Just ()
323−
324−sampleByteString :: forall a . ToSample a => Proxy a -> Maybe ByteString
325−sampleByteString Proxy = fmap encode (toSample :: Maybe a)
326−
327−-- | The class that helps us automatically get documentation
328−-- for GET parameters.
329−--
330−-- Example of an instance:
331−--
332−-- > instance ToParam (QueryParam "capital" Bool) where
333−-- > toParam _ =
334−-- > DocQueryParam "capital"
335−-- > ["true", "false"]
336−-- > "Get the greeting message in uppercase (true) or not (false). Default is false."
337−class ToParam t where
338− toParam :: Proxy t -> DocQueryParam
339−
340−-- | The class that helps us automatically get documentation
341−-- for URL captures.
342−--
343−-- Example of an instance:
344−--
345−-- > instance ToCapture (Capture "name" Text) where
346−-- > toCapture _ = DocCapture "name" "name of the person to greet"
347−class ToCapture c where
348− toCapture :: Proxy c -> DocCapture
349−
350−-- | Generate documentation in Markdown format for
351−-- the given 'API'.
352−markdown :: API -> String
353−markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
354−
355− where printEndpoint :: Endpoint -> Action -> [String]
356− printEndpoint endpoint action =
357− str :
358− replicate len '-' :
359− "" :
360− capturesStr (action ^. captures) ++
361− paramsStr (action ^. params) ++
362− rqbodyStr (action ^. rqbody) ++
363− responseStr (action ^. response) ++
364− []
365−
366− where str = show (endpoint^.method) ++ " " ++ endpoint^.path
367− len = length str
368−
369− capturesStr :: [DocCapture] -> [String]
370− capturesStr [] = []
371− capturesStr l =
372− "**Captures**: " :
373− "" :
374− map captureStr l ++
375− "" :
376− []
377− captureStr cap =
378− "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
379−
380− paramsStr :: [DocQueryParam] -> [String]
381− paramsStr [] = []
382− paramsStr l =
383− "**GET Parameters**: " :
384− "" :
385− map paramStr l ++
386− "" :
387− []
388− paramStr param = unlines $
389− (" - " ++ param ^. paramName) :
390− (if (not (null values) || param ^. paramKind /= Flag)
391− then [" - **Values**: *" ++ intercalate ", " values ++ "*"]
392− else []) ++
393− (" - **Description**: " ++ param ^. paramDesc) :
394− (if (param ^. paramKind == List)
395− then [" - This parameter is a **list**. All GET parameters with the name "
396− ++ param ^. paramName ++ "[] will forward their values in a list to the handler."]
397− else []) ++
398− (if (param ^. paramKind == Flag)
399− then [" - This parameter is a **flag**. This means no value is expected to be associated to this parameter."]
400− else []) ++
401− []
402−
403− where values = param ^. paramValues
404−
405− rqbodyStr :: Maybe ByteString -> [String]
406− rqbodyStr Nothing = []
407− rqbodyStr (Just b) =
408− "**Request Body**: " :
409− jsonStr b
410−
411− jsonStr b =
412− "" :
413− "``` javascript" :
414− cs b :
415− "```" :
416− "" :
417− []
418−
419− responseStr :: Response -> [String]
420− responseStr resp =
421− "**Response**: " :
422− "" :
423− (" - Status code " ++ show (resp ^. respStatus)) :
424− (resp ^. respBody &
425− maybe [" - No response body\n"]
426− (\b -> " - Response body as below." : jsonStr b))