From 6f106628873fc6a6f83580a4937e7c5ed79d9c7a Mon Sep 17 00:00:00 2001 From: Daniel Larsson Date: Thu, 1 Jan 2015 23:42:06 +0100 Subject: [PATCH 1/2] Initial support for matrix parameters. Not complete, not sure how to document them yet, since documentation is focused on endpoints, not individual path fragments. --- .gitignore | 17 +++++++++++++++++ src/Servant/Docs.hs | 37 +++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 00000000..0855a79b --- /dev/null +++ b/.gitignore @@ -0,0 +1,17 @@ +dist +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.virtualenv +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +cabal.config +*.prof +*.aux +*.hp diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs index a3bcf5ee..507209e5 100644 --- a/src/Servant/Docs.hs +++ b/src/Servant/Docs.hs @@ -556,6 +556,43 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout) paramP = Proxy :: Proxy (QueryFlag sym) action' = over params (|> toParam paramP) action + +instance (KnownSymbol sym, {- ToParam (MatrixParam sym a), -} HasDocs sublayout) + => HasDocs (MatrixParam sym a :> sublayout) where + + docsFor Proxy (endpoint, action) = + docsFor sublayoutP (endpoint', action) + + where sublayoutP = Proxy :: Proxy sublayout + + endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint + symP = Proxy :: Proxy sym + + +instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout) + => HasDocs (MatrixParams sym a :> sublayout) where + + docsFor Proxy (endpoint, action) = + docsFor sublayoutP (endpoint', action) + + where sublayoutP = Proxy :: Proxy sublayout + + endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint + symP = Proxy :: Proxy sym + + +instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout) + => HasDocs (MatrixFlag sym :> sublayout) where + + docsFor Proxy (endpoint, action) = + docsFor sublayoutP (endpoint', action) + + where sublayoutP = Proxy :: Proxy sublayout + + endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint + symP = Proxy :: Proxy sym + + instance HasDocs Raw where docsFor _proxy (endpoint, action) = single endpoint action From d81704abc76cb559c90fc31c28e6488a47049638 Mon Sep 17 00:00:00 2001 From: Daniel Larsson Date: Tue, 6 Jan 2015 14:30:01 +0100 Subject: [PATCH 2/2] Added support for matrix parameters --- example/greet.hs | 9 +++++++- src/Servant/Docs.hs | 53 ++++++++++++++++++++++++++++++++++----------- 2 files changed, 48 insertions(+), 14 deletions(-) diff --git a/example/greet.hs b/example/greet.hs index 38a29292..ba44f4e1 100644 --- a/example/greet.hs +++ b/example/greet.hs @@ -36,6 +36,13 @@ instance ToParam (QueryParam "capital" Bool) where "Get the greeting message in uppercase (true) or not (false). Default is false." Normal +instance ToParam (MatrixParam "lang" String) where + toParam _ = + DocQueryParam "lang" + ["en", "sv", "fr"] + "Get the greeting message selected language. Default is en." + Normal + instance ToSample Greet where toSample = Just $ Greet "Hello, haskeller!" @@ -47,7 +54,7 @@ instance ToSample Greet where -- API specification type TestApi = -- GET /hello/:name?capital={true, false} returns a Greet as JSON - "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet + "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet -- POST /greet with a Greet as JSON in the request body, -- returns a Greet as JSON diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs index 09d4e428..a228140d 100644 --- a/src/Servant/Docs.hs +++ b/src/Servant/Docs.hs @@ -216,6 +216,7 @@ data DocQueryParam = DocQueryParam , _paramKind :: ParamKind } deriving (Eq, Show) + -- | Type of GET parameter: -- -- - Normal corresponds to @QueryParam@, i.e your usual GET parameter @@ -265,11 +266,12 @@ defResponse = Response 200 [] -- You can tweak an 'Action' (like the default 'defAction') with these lenses -- to transform an action and add some information to it. data Action = Action - { _captures :: [DocCapture] -- type collected + user supplied info - , _headers :: [Text] -- type collected - , _params :: [DocQueryParam] -- type collected + user supplied info - , _rqbody :: Maybe ByteString -- user supplied - , _response :: Response -- user supplied + { _captures :: [DocCapture] -- type collected + user supplied info + , _headers :: [Text] -- type collected + , _params :: [DocQueryParam] -- type collected + user supplied info + , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info + , _rqbody :: Maybe ByteString -- user supplied + , _response :: Response -- user supplied } deriving (Eq, Show) -- Default 'Action'. Has no 'captures', no GET 'params', expects @@ -278,12 +280,13 @@ data Action = Action -- Tweakable with lenses. -- -- > λ> defAction --- > Action {_captures = [], _params = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}} +-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}} -- > λ> defAction & response.respStatus .~ 201 --- > Action {_captures = [], _params = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}} +-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}} defAction :: Action defAction = Action [] + [] [] [] Nothing @@ -393,6 +396,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList replicate len '-' : "" : capturesStr (action ^. captures) ++ + mxParamsStr (action ^. mxParams) ++ headersStr (action ^. headers) ++ paramsStr (action ^. params) ++ rqbodyStr (action ^. rqbody) ++ @@ -413,6 +417,22 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList captureStr cap = "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc) + mxParamsStr :: [(String, [DocQueryParam])] -> [String] + mxParamsStr [] = [] + mxParamsStr l = + "**Matrix Parameters**: " : + "" : + map segmentStr l ++ + "" : + [] + segmentStr :: (String, [DocQueryParam]) -> String + segmentStr (segment, l) = unlines $ + ("**" ++ segment ++ "**: ") : + "" : + map paramStr l ++ + "" : + [] + headersStr :: [Text] -> [String] headersStr [] = [] headersStr l = [""] ++ map headerStr l ++ [""] @@ -584,15 +604,23 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout) action' = over params (|> toParam paramP) action -instance (KnownSymbol sym, {- ToParam (MatrixParam sym a), -} HasDocs sublayout) +instance (KnownSymbol sym, ToParam (MatrixParam sym a), HasDocs sublayout) => HasDocs (MatrixParam sym a :> sublayout) where docsFor Proxy (endpoint, action) = - docsFor sublayoutP (endpoint', action) + docsFor sublayoutP (endpoint', action') where sublayoutP = Proxy :: Proxy sublayout + paramP = Proxy :: Proxy (MatrixParam sym a) + segment = endpoint ^. (path._last) + segment' = action ^. (mxParams._last._1) + endpoint' = over (path._last) (\p -> p ++ ";" ++ symbolVal symP ++ "=") endpoint - endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint + action' = if segment' /= segment + -- This is the first matrix parameter for this segment, insert a new entry into the mxParams list + then over mxParams (|> (segment, [toParam paramP])) action + -- We've already inserted a matrix parameter for this segment, append to the existing list + else action & mxParams._last._2 <>~ [toParam paramP] symP = Proxy :: Proxy sym @@ -603,8 +631,7 @@ instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout docsFor sublayoutP (endpoint', action) where sublayoutP = Proxy :: Proxy sublayout - - endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint + endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP ++ "="]) endpoint symP = Proxy :: Proxy sym @@ -616,7 +643,7 @@ instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout) where sublayoutP = Proxy :: Proxy sublayout - endpoint' = over path (\p -> p++";"++symbolVal symP) endpoint + endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint symP = Proxy :: Proxy sym