add doc generation support for QueryParams and QueryFlag

This commit is contained in:
Alp Mestanogullari 2014-10-30 12:15:52 +01:00
parent e774af7707
commit df12f9b9bd
3 changed files with 37 additions and 2 deletions

View file

@ -43,6 +43,7 @@ instance ToParam (QueryParam "capital" Bool) where
DocQueryParam "capital" DocQueryParam "capital"
["true", "false"] ["true", "false"]
"Get the greeting message in uppercase (true) or not (false). Default is false." "Get the greeting message in uppercase (true) or not (false). Default is false."
Normal
instance ToSample Greet where instance ToSample Greet where
toSample Proxy = Just (encode g) toSample Proxy = Just (encode g)

View file

@ -110,6 +110,16 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
pname' = symbolVal (Proxy :: Proxy sym) pname' = symbolVal (Proxy :: Proxy sym)
paramlist' = map (Just . toText) paramlist paramlist' = map (Just . toText) paramlist
instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs sublayout)
=> HasDocs (QueryParams sym a :> sublayout) where
docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint, action')
where sublayoutP = Proxy :: Proxy sublayout
paramP = Proxy :: Proxy (QueryParams sym a)
action' = over params (|> toParam paramP) action
-- | Retrieve a value-less boolean from the query string. -- | Retrieve a value-less boolean from the query string.
data QueryFlag a data QueryFlag a
@ -142,3 +152,13 @@ instance (KnownSymbol sym, HasClient sublayout)
else req else req
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
=> HasDocs (QueryFlag sym :> sublayout) where
docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint, action')
where sublayoutP = Proxy :: Proxy sublayout
paramP = Proxy :: Proxy (QueryFlag sym)
action' = over params (|> toParam paramP) action

View file

@ -95,7 +95,7 @@ module Servant.Docs
, Endpoint, path, method, defEndpoint , Endpoint, path, method, defEndpoint
, API, emptyAPI , API, emptyAPI
, DocCapture(..), capSymbol, capDesc , DocCapture(..), capSymbol, capDesc
, DocQueryParam(..), paramName, paramValues, paramDesc , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
, Response, respStatus, respBody, defResponse , Response, respStatus, respBody, defResponse
, Action, captures, params, rqbody, response, defAction , Action, captures, params, rqbody, response, defAction
, single , single
@ -199,8 +199,17 @@ data DocQueryParam = DocQueryParam
{ _paramName :: String -- type supplied { _paramName :: String -- type supplied
, _paramValues :: [String] -- user supplied , _paramValues :: [String] -- user supplied
, _paramDesc :: String -- user supplied , _paramDesc :: String -- user supplied
, _paramKind :: ParamKind
} deriving (Eq, Show) } deriving (Eq, Show)
-- | Type of GET parameter:
--
-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
-- - List corresponds to @QueryParams@, i.e GET parameters with multiple values
-- - Flag corresponds to @QueryFlag@, i.e a value-less GET parameter
data ParamKind = Normal | List | Flag
deriving (Eq, Show)
-- | A type to represent an HTTP response. Has an 'Int' status and -- | A type to represent an HTTP response. Has an 'Int' status and
-- a 'Maybe ByteString' response body. Tweak 'defResponse' using -- a 'Maybe ByteString' response body. Tweak 'defResponse' using
-- the 'respStatus' and 'respBody' lenses if you want. -- the 'respStatus' and 'respBody' lenses if you want.
@ -373,9 +382,14 @@ printMarkdown = imapM_ printEndpoint
putStrLn "" putStrLn ""
paramStr param = do paramStr param = do
putStrLn $ " - " ++ param ^. paramName putStrLn $ " - " ++ param ^. paramName
when (not $ null values) $ when (not (null values) || param ^. paramKind /= Flag) $
putStrLn $ " - **Values**: *" ++ intercalate ", " values ++ "*" putStrLn $ " - **Values**: *" ++ intercalate ", " values ++ "*"
putStrLn $ " - **Description**: " ++ param ^. paramDesc putStrLn $ " - **Description**: " ++ param ^. paramDesc
when (param ^. paramKind == List) $
putStrLn $ " - This parameter is a **list**. All GET parameters with the name "
++ param ^. paramName ++ "[] will forward their values in a list to the handler."
when (param ^. paramKind == Flag) $
putStrLn $ " - This parameter is a **flag**. This means no value is expected to be associated to this parameter."
where values = param ^. paramValues where values = param ^. paramValues