@@ -0,0 +1,403 @@
1+{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE TemplateHaskell #-}
5+-------------------------------------------------------------------------------
7+-- Module : Servant.Docs
9+-- Maintainer : alpmestan@gmail.com
10+-- Stability : provisional
11+-- Portability : TH, TypeFamilies, DeriveGeneric
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':
16+-- @docs :: 'HasDocs' api => 'Proxy' api -> 'API'@
18+-- You can then call 'printMarkdown' on it:
20+-- @printMarkdown :: 'API' -> IO ()@
22+-- or define a custom pretty printer:
24+-- @yourPrettyDocs :: 'API' -> IO () -- or blaze-html's HTML, or ...@
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.
29+-- Here's a little (but complete) example that you can run to see the
30+-- markdown pretty printer in action:
32+-- > {-# LANGUAGE DataKinds #-}
33+-- > {-# LANGUAGE PolyKinds #-}
34+-- > {-# LANGUAGE TypeFamilies #-}
35+-- > {-# LANGUAGE DeriveGeneric #-}
36+-- > {-# LANGUAGE TypeOperators #-}
37+-- > {-# LANGUAGE FlexibleInstances #-}
38+-- > {-# LANGUAGE OverloadedStrings #-}
40+-- > import Data.Proxy
43+-- > import Servant.Docs
45+-- > -- our type for a Greeting message
46+-- > data Greet = Greet { _msg :: Text }
47+-- > deriving (Generic, Show)
49+-- > -- we get our JSON serialization for free
50+-- > instance FromJSON Greet
51+-- > instance ToJSON Greet
53+-- > -- we provide a sample value for the 'Greet' type
54+-- > instance ToSample Greet where
55+-- > toSample Proxy = Just (encode g)
57+-- > where g = Greet "Hello, haskeller!"
59+-- > instance ToParam (GetParam "capital" Bool) where
61+-- > DocGetParam "capital"
62+-- > ["true", "false"]
63+-- > "Get the greeting message in uppercase (true) or not (false). Default is false."
65+-- > instance ToCapture (Capture "name" Text) where
66+-- > toCapture _ = DocCapture "name" "name of the person to greet"
68+-- > instance ToCapture (Capture "greetid" Text) where
69+-- > toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
71+-- > -- API specification
73+-- > "hello" :> Capture "name" Text :> GetParam "capital" Bool :> Get Greet
74+-- > :<|> "greet" :> RQBody Greet :> Post Greet
75+-- > :<|> "delete" :> Capture "greetid" Text :> Delete
77+-- > testApi :: Proxy TestApi
80+-- > -- Generate the Documentation's ADT
82+-- > greetDocs = docs testApi
85+-- > main = printMarkdown greetDocs
87+ ( -- * 'HasDocs' class and key functions
88+ HasDocs(..), docs, printMarkdown
90+ , -- * Classes you need to implement for your types
91+ ToSample(..), ToParam(..), ToCapture(..)
93+ , -- * ADTs to represent an 'API'
95+ , Endpoint, path, method, defEndpoint
97+ , DocCapture(..), capSymbol, capDesc
98+ , DocGetParam(..), paramName, paramValues, paramDesc
99+ , Response, respStatus, respBody, defResponse
100+ , Action, captures, params, rqbody, response, defAction
103+ , -- * Useful modules when defining your own instances
105+ , module Data.Monoid
108+import Control.Lens hiding (Action)
109+import Control.Monad (when)
111+import Data.ByteString.Lazy.Char8 (ByteString)
113+import Data.HashMap.Strict (HashMap)
119+import qualified Data.ByteString.Lazy.Char8 as LB
120+import qualified Data.HashMap.Strict as HM
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)
129+instance Show Method where
131+ show DocPOST = "POST"
132+ show DocDELETE = "DELETE"
135+instance Hashable Method
137+-- | An 'Endpoint' type that holds the 'path' and the 'method'.
139+-- Gets used as the key in the 'API' hashmap. Modify 'defEndpoint'
140+-- or any 'Endpoint' value you want using the 'path' and 'method'
146+-- λ> 'defEndpoint' & 'path' '<>~' "foo"
148+-- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST'
151+data Endpoint = Endpoint
152+ { _path :: String -- type collected
153+ , _method :: Method -- type collected
154+ } deriving (Eq, Generic)
156+instance Show Endpoint where
157+ show (Endpoint p m) =
160+-- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'
162+-- Here's how you can modify it:
167+-- λ> 'defEndpoint' & 'path' '<>~' "foo"
169+-- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST'
172+defEndpoint :: Endpoint
173+defEndpoint = Endpoint "/" DocGET
175+instance Hashable Endpoint
177+-- | Our API type, a good old hashmap from 'Endpoint' to 'Action'
178+type API = HashMap Endpoint Action
184+-- | A type to represent captures. Holds the name of the capture
185+-- and a description.
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)
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.
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)
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.
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.
212+-- Can be tweaked with two lenses.
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)
223+-- | Default response: status code 200, no response body.
225+-- Can be tweaked with two lenses.
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
234+-- | A datatype that represents everything that can happen
235+-- at an endpoint, with its lenses:
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')
242+-- You can tweak an 'Action' (like the default 'defAction') with these lenses
243+-- to transform an action and add some information to it.
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)
251+-- Default 'Action'. Has no 'captures', no GET 'params', expects
252+-- no request body ('rqbody') and the typical response is 'defResponse'.
254+-- Tweakable with lenses.
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}}
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
274+makeLenses ''Endpoint
275+makeLenses ''DocCapture
276+makeLenses ''DocGetParam
277+makeLenses ''Response
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)
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
289+-- | The class that lets us display a sample JSON input or output
290+-- when generating documentation for endpoints that either:
292+-- - expect a request body, or
293+-- - return a non empty response body
295+-- Example of an instance:
297+-- > {-# LANGUAGE DeriveGeneric #-}
298+-- > {-# LANGUAGE OverloadedStrings #-}
300+-- > import Data.Aeson
301+-- > import Data.Text
302+-- > import GHC.Generics
304+-- > data Greet = Greet { _msg :: Text }
305+-- > deriving (Generic, Show)
307+-- > instance FromJSON Greet
308+-- > instance ToJSON Greet
310+-- > instance ToSample Greet where
311+-- > toSample Proxy = Just (encode g)
313+-- > where g = Greet "Hello, haskeller!"
314+class ToJSON a => ToSample a where
315+ toSample :: Proxy a -> Maybe ByteString
317+-- | The class that helps us automatically get documentation
318+-- for GET parameters.
320+-- Example of an instance:
322+-- > instance ToParam (GetParam "capital" Bool) where
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
330+-- | The class that helps us automatically get documentation
333+-- Example of an instance:
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
340+-- | Print documentation in Markdown format for
341+-- the given 'API', on standard output.
342+printMarkdown :: API -> IO ()
343+printMarkdown = imapM_ printEndpoint
345+ where printEndpoint endpoint action = do
347+ putStrLn $ replicate len '-'
349+ capturesStr (action ^. captures)
350+ paramsStr (action ^. params)
351+ rqbodyStr (action ^. rqbody)
352+ responseStr (action ^. response)
354+ where str = show (endpoint^.method) ++ " " ++ endpoint^.path
357+ capturesStr :: [DocCapture] -> IO ()
358+ capturesStr [] = return ()
360+ putStrLn "**Captures**: "
365+ putStrLn $ "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
367+ paramsStr :: [DocGetParam] -> IO ()
368+ paramsStr [] = return ()
370+ putStrLn "**GET Parameters**: "
375+ putStrLn $ " - " ++ param ^. paramName
376+ when (not $ null values) $
377+ putStrLn $ " - **Values**: *" ++ intercalate ", " values ++ "*"
378+ putStrLn $ " - **Description**: " ++ param ^. paramDesc
380+ where values = param ^. paramValues
382+ rqbodyStr :: Maybe ByteString -> IO ()
383+ rqbodyStr Nothing = return ()
384+ rqbodyStr (Just b) = do
385+ putStrLn "**Request Body**: "
390+ putStrLn "``` javascript"
395+ responseStr :: Response -> IO ()
396+ responseStr resp = do
397+ putStrLn $ "**Response**: "
399+ putStrLn $ " - Status code " ++ show (resp ^. respStatus)
401+ maybe (putStrLn " - No response body")
402+ (\b -> putStrLn " - Response body as below." >> jsonStr b)