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