From fe541f3bf485978f3c6461b2aaa0b1abae281143 Mon Sep 17 00:00:00 2001 From: Daniel Larsson Date: Sun, 28 Dec 2014 22:56:58 +0100 Subject: [PATCH 1/3] Added support for matrix parameters --- servant.cabal | 1 + src/Servant/API.hs | 3 +++ src/Servant/API/MatrixParam.hs | 35 ++++++++++++++++++++++++++++++++++ 3 files changed, 39 insertions(+) create mode 100644 src/Servant/API/MatrixParam.hs diff --git a/servant.cabal b/servant.cabal index dce0d075..66d3c288 100644 --- a/servant.cabal +++ b/servant.cabal @@ -34,6 +34,7 @@ library Servant.API.Post Servant.API.Put Servant.API.QueryParam + Servant.API.MatrixParam Servant.API.Raw Servant.API.ReqBody Servant.API.Sub diff --git a/src/Servant/API.hs b/src/Servant/API.hs index 67064ec7..d6c2d483 100644 --- a/src/Servant/API.hs +++ b/src/Servant/API.hs @@ -15,6 +15,8 @@ module Servant.API ( module Servant.API.QueryParam, -- | Accessing the request body as a JSON-encoded type: @'ReqBody'@ module Servant.API.ReqBody, + -- | Retrieving matrix parameters from the 'URI' segment: @'MatrixParam'@ + module Servant.API.MatrixParam, -- * Actual endpoints, distinguished by HTTP method -- | GET requests @@ -45,6 +47,7 @@ import Servant.API.Header import Servant.API.Post import Servant.API.Put import Servant.API.QueryParam +import Servant.API.MatrixParam import Servant.API.Raw import Servant.API.ReqBody import Servant.API.Sub diff --git a/src/Servant/API/MatrixParam.hs b/src/Servant/API/MatrixParam.hs new file mode 100644 index 00000000..5e826571 --- /dev/null +++ b/src/Servant/API/MatrixParam.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE PolyKinds #-} +module Servant.API.MatrixParam where + +-- | Lookup the value associated to the @sym@ matrix string parameter +-- and try to extract it as a value of type @a@. +-- +-- Example: +-- +-- > -- /books;author= +-- > type MyApi = "books" :> MatrixParam "author" Text :> Get [Book] +data MatrixParam sym a + +-- | Lookup the values associated to the @sym@ matrix string parameter +-- and try to extract it as a value of type @[a]@. This is typically +-- meant to support matrix string parameters of the form +-- @param[]=val1;param[]=val2@ and so on. Note that servant doesn't actually +-- require the @[]@s and will fetch the values just fine with +-- @param=val1;param=val2@, too. +-- +-- Example: +-- +-- > -- /books;authors[]=;authors[]=;... +-- > type MyApi = "books" :> MatrixParams "authors" Text :> Get [Book] +data MatrixParams sym a + +-- | Lookup a potentially value-less matrix string parameter +-- with boolean semantics. If the param @sym@ is there without any value, +-- or if it's there with value "true" or "1", it's interpreted as 'True'. +-- Otherwise, it's interpreted as 'False'. +-- +-- Example: +-- +-- > -- /books;published +-- > type MyApi = "books" :> MatrixFlag "published" :> Get [Book] +data MatrixFlag sym From 80b82fd885d1914645fa690f792f07459ca89345 Mon Sep 17 00:00:00 2001 From: Daniel Larsson Date: Thu, 1 Jan 2015 22:46:58 +0100 Subject: [PATCH 2/3] Bumped version number, and added a .gitignore file. --- .gitignore | 17 +++++++++++++++++ servant.cabal | 2 +- 2 files changed, 18 insertions(+), 1 deletion(-) 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/servant.cabal b/servant.cabal index 66d3c288..7c39011a 100644 --- a/servant.cabal +++ b/servant.cabal @@ -1,5 +1,5 @@ name: servant -version: 0.2.1 +version: 0.2.2 synopsis: A family of combinators for defining webservices APIs description: A family of combinators for defining webservices APIs and serving them From 409a10442d4d9e845f69336b480329a954feb92e Mon Sep 17 00:00:00 2001 From: Daniel Larsson Date: Sun, 4 Jan 2015 18:14:27 +0100 Subject: [PATCH 3/3] Added test cases for matrix parameters. Added some missing cases in the IsElem type family (QueryParams and QueryFlag) --- src/Servant/QQ.hs | 46 +++++++++++++++++++++------------ src/Servant/Utils/Links.hs | 6 +++++ test/Servant/QQSpec.hs | 22 ++++++++++++++++ test/Servant/Utils/LinksSpec.hs | 6 +++++ 4 files changed, 64 insertions(+), 16 deletions(-) diff --git a/src/Servant/QQ.hs b/src/Servant/QQ.hs index f6331f54..0da8d861 100644 --- a/src/Servant/QQ.hs +++ b/src/Servant/QQ.hs @@ -40,6 +40,7 @@ import Servant.API.Post import Servant.API.Put import Servant.API.Delete import Servant.API.QueryParam +import Servant.API.MatrixParam import Servant.API.ReqBody import Servant.API.Sub import Servant.API.Alternative @@ -50,15 +51,16 @@ import Servant.API.Alternative -- only one of 'get', 'post', 'put', and 'delete' in a value), but -- sometimes requires a little more work. class ExpSYM repr' repr | repr -> repr', repr' -> repr where - lit :: String -> repr' -> repr - capture :: String -> String -> repr -> repr - reqBody :: String -> repr -> repr - queryParam :: String -> String -> repr -> repr - conj :: repr' -> repr -> repr - get :: String -> repr - post :: String -> repr - put :: String -> repr - delete :: String -> repr + lit :: String -> repr' -> repr + capture :: String -> String -> repr -> repr + reqBody :: String -> repr -> repr + queryParam :: String -> String -> repr -> repr + matrixParam :: String -> String -> repr -> repr + conj :: repr' -> repr -> repr + get :: String -> repr + post :: String -> repr + put :: String -> repr + delete :: String -> repr infixr 6 >: @@ -72,7 +74,9 @@ instance ExpSYM Type Type where capture name typ r = AppT (AppT (ConT ''Capture) (LitT (StrTyLit name))) (ConT $ mkName typ) >: r reqBody typ r = AppT (ConT ''ReqBody) (ConT $ mkName typ) >: r - queryParam name typ r = AppT (AppT (ConT ''QueryParam) (LitT (StrTyLit name))) + queryParam name typ r = AppT (AppT (ConT ''QueryParam) (LitT (StrTyLit name))) + (ConT $ mkName typ) >: r + matrixParam name typ r = AppT (AppT (ConT ''MatrixParam) (LitT (StrTyLit name))) (ConT $ mkName typ) >: r conj x = AppT (AppT (ConT ''(:>)) x) get typ = AppT (ConT ''Get) (ConT $ mkName typ) @@ -93,17 +97,27 @@ parseUrlSegment = try parseCapture <|> try parseLit where parseCapture = do - cname <- many (noneOf " ?/:") + cname <- many (noneOf " ?/:;") char ':' - ctyp <- many (noneOf " ?/:") - return $ capture cname ctyp + ctyp <- many (noneOf " ?/:;") + mx <- many parseMatrixParam + return $ capture cname ctyp . foldr (.) id mx parseQueryParam = do char '?' - cname <- many (noneOf " ?/:") + cname <- many (noneOf " ?/:;") char ':' - ctyp <- many (noneOf " ?/:") + ctyp <- many (noneOf " ?/:;") return $ queryParam cname ctyp - parseLit = lit <$> many (noneOf " ?/:") + parseLit = do + lt <- many (noneOf " ?/:;") + mx <- many parseMatrixParam + return $ lit lt . foldr (.) id mx + parseMatrixParam = do + char ';' + cname <- many (noneOf " ?/:;") + char ':' + ctyp <- many (noneOf " ?/:;") + return $ matrixParam cname ctyp parseUrl :: ExpSYM repr repr => Parser (repr -> repr) parseUrl = do diff --git a/src/Servant/Utils/Links.hs b/src/Servant/Utils/Links.hs index f2f4fe82..3d3b5c00 100644 --- a/src/Servant/Utils/Links.hs +++ b/src/Servant/Utils/Links.hs @@ -54,6 +54,7 @@ import GHC.TypeLits import Servant.API.Capture import Servant.API.ReqBody import Servant.API.QueryParam +import Servant.API.MatrixParam import Servant.API.Get import Servant.API.Post import Servant.API.Put @@ -78,6 +79,11 @@ type family IsElem a s where IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb IsElem sa (ReqBody x :> sb) = IsElem sa sb IsElem sa (QueryParam x y :> sb) = IsElem sa sb + IsElem sa (QueryParams x y :> sb) = IsElem sa sb + IsElem sa (QueryFlag x :> sb) = IsElem sa sb + IsElem sa (MatrixParam x y :> sb) = IsElem sa sb + IsElem sa (MatrixParams x y :> sb) = IsElem sa sb + IsElem sa (MatrixFlag x :> sb) = IsElem sa sb IsElem e e = 'True IsElem e a = 'False diff --git a/test/Servant/QQSpec.hs b/test/Servant/QQSpec.hs index adf59611..11e34c0a 100644 --- a/test/Servant/QQSpec.hs +++ b/test/Servant/QQSpec.hs @@ -76,6 +76,20 @@ type SimpleQueryParam' = "hello" :> QueryParam "p" Int :> Post Bool type SimpleQueryParam'' = "hello" :> QueryParam "r" Int :> Post Bool type SimpleQueryParam''' = "hello" :> QueryParam "p" Bool :> Post Bool +type SimpleMatrixParam = [sitemap| +POST hello;p:Int Bool +|] +type SimpleMatrixParam' = "hello" :> MatrixParam "p" Int :> Post Bool +type SimpleMatrixParam'' = "hello" :> MatrixParam "r" Int :> Post Bool +type SimpleMatrixParam''' = "hello" :> MatrixParam "p" Bool :> Post Bool + +type ComplexMatrixParam = [sitemap| +POST hello;p:Int;q:String/world;r:Int Bool +|] +type ComplexMatrixParam' = "hello" :> MatrixParam "p" Int :> MatrixParam "q" String :> "world" :> MatrixParam "r" Int :> Post Bool +type ComplexMatrixParam'' = "hello" :> MatrixParam "p" Int :> MatrixParam "q" String :> "world" :> MatrixParam "s" Int :> Post Bool +type ComplexMatrixParam''' = "hello" :> MatrixParam "p" Int :> MatrixParam "q" String :> "world" :> MatrixParam "r" Bool :> Post Bool + -- Combinations ---------------------------------------------------------- type TwoPaths = [sitemap| @@ -144,6 +158,14 @@ spec = do (u::SimpleQueryParam) ~= (u::SimpleQueryParam' ) ~> True (u::SimpleQueryParam) ~= (u::SimpleQueryParam'') ~> False (u::SimpleQueryParam) ~= (u::SimpleQueryParam''') ~> False + it "Handles simple matrix parameters" $ do + (u::SimpleMatrixParam) ~= (u::SimpleMatrixParam' ) ~> True + (u::SimpleMatrixParam) ~= (u::SimpleMatrixParam'') ~> False + (u::SimpleMatrixParam) ~= (u::SimpleMatrixParam''') ~> False + it "Handles more complex matrix parameters" $ do + (u::ComplexMatrixParam) ~= (u::ComplexMatrixParam' ) ~> True + (u::ComplexMatrixParam) ~= (u::ComplexMatrixParam'') ~> False + (u::ComplexMatrixParam) ~= (u::ComplexMatrixParam''') ~> False it "Handles multiples paths" $ do (u::TwoPaths) ~= (u::TwoPaths') ~> True it "Ignores inline comments" $ do diff --git a/test/Servant/Utils/LinksSpec.hs b/test/Servant/Utils/LinksSpec.hs index 3f16d71b..373a4f0e 100644 --- a/test/Servant/Utils/LinksSpec.hs +++ b/test/Servant/Utils/LinksSpec.hs @@ -12,12 +12,15 @@ import Servant.Utils.Links (IsElem, IsLink) type TestApi = "hello" :> Capture "name" String :> QueryParam "capital" Bool :> Get Bool :<|> "greet" :> ReqBody 'True :> Post Bool + :<|> "parent" :> MatrixParams "name" String :> "child" :> MatrixParam "gender" String :> Get String type TestLink = "hello" :> "hi" :> Get Bool type TestLink2 = "greet" :> Post Bool +type TestLink3 = "parent" :> "child" :> Get String type BadTestLink = "hallo" :> "hi" :> Get Bool type BadTestLink2 = "greet" :> Get Bool +type BadTestLink3 = "parent" :> "child" :> MatrixFlag "male" :> Get String type NotALink = "hello" :> Capture "x" Bool :> Get Bool type NotALink2 = "hello" :> ReqBody 'True :> Get Bool @@ -37,15 +40,18 @@ isElem = describe "IsElem" $ do it "is True when the first argument is an url within the second" $ do reflected (Proxy::Proxy (IsElem TestLink TestApi)) ~> True reflected (Proxy::Proxy (IsElem TestLink2 TestApi)) ~> True + reflected (Proxy::Proxy (IsElem TestLink3 TestApi)) ~> True it "is False when the first argument is not an url within the second" $ do reflected (Proxy::Proxy (IsElem BadTestLink TestApi)) ~> False reflected (Proxy::Proxy (IsElem BadTestLink2 TestApi)) ~> False + reflected (Proxy::Proxy (IsElem BadTestLink3 TestApi)) ~> False isLink :: Spec isLink = describe "IsLink" $ do it "is True when all Subs are paths and the last is a method" $ do reflected (Proxy::Proxy (IsLink TestLink)) ~> True reflected (Proxy::Proxy (IsLink TestLink2)) ~> True + reflected (Proxy::Proxy (IsLink TestLink3)) ~> True it "is False of anything with captures" $ do reflected (Proxy::Proxy (IsLink NotALink)) ~> False reflected (Proxy::Proxy (IsLink NotALink2)) ~> False