diff --git a/example/greet.hs b/example/greet.hs index 5a6ae4dd..0584c246 100644 --- a/example/greet.hs +++ b/example/greet.hs @@ -43,6 +43,7 @@ instance ToParam (QueryParam "capital" Bool) where DocQueryParam "capital" ["true", "false"] "Get the greeting message in uppercase (true) or not (false). Default is false." + Normal instance ToSample Greet where toSample Proxy = Just (encode g) diff --git a/src/Servant/API/QueryParam.hs b/src/Servant/API/QueryParam.hs index 07a37c30..ea6e3087 100644 --- a/src/Servant/API/QueryParam.hs +++ b/src/Servant/API/QueryParam.hs @@ -110,6 +110,16 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout) pname' = symbolVal (Proxy :: Proxy sym) 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. data QueryFlag a @@ -142,3 +152,13 @@ instance (KnownSymbol sym, HasClient sublayout) else req 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 diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs index 45c6f79f..765d49dd 100644 --- a/src/Servant/Docs.hs +++ b/src/Servant/Docs.hs @@ -95,7 +95,7 @@ module Servant.Docs , Endpoint, path, method, defEndpoint , API, emptyAPI , DocCapture(..), capSymbol, capDesc - , DocQueryParam(..), paramName, paramValues, paramDesc + , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind , Response, respStatus, respBody, defResponse , Action, captures, params, rqbody, response, defAction , single @@ -199,8 +199,17 @@ data DocQueryParam = DocQueryParam { _paramName :: String -- type supplied , _paramValues :: [String] -- user supplied , _paramDesc :: String -- user supplied + , _paramKind :: ParamKind } 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 'Maybe ByteString' response body. Tweak 'defResponse' using -- the 'respStatus' and 'respBody' lenses if you want. @@ -373,9 +382,14 @@ printMarkdown = imapM_ printEndpoint putStrLn "" paramStr param = do putStrLn $ " - " ++ param ^. paramName - when (not $ null values) $ + when (not (null values) || param ^. paramKind /= Flag) $ putStrLn $ " - **Values**: *" ++ intercalate ", " values ++ "*" 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