diff --git a/src/Servant/QQ.hs b/src/Servant/QQ.hs index 71c8d5af..ee5d7ae2 100644 --- a/src/Servant/QQ.hs +++ b/src/Servant/QQ.hs @@ -58,6 +58,7 @@ import Servant.API.Post ( Post ) import Servant.API.Put ( Put ) import Servant.API.Delete ( Delete ) import Servant.API.QueryParam ( QueryParam ) +import Servant.API.MatrixParam ( MatrixParam ) import Servant.API.ReqBody ( ReqBody ) import Servant.API.Sub ( (:>) ) import Servant.API.Alternative ( (:<|>) ) @@ -68,15 +69,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 >: @@ -90,7 +92,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) @@ -111,17 +115,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 3be24844..bb9c9dbb 100644 --- a/src/Servant/Utils/Links.hs +++ b/src/Servant/Utils/Links.hs @@ -54,6 +54,7 @@ import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal ) import Servant.API.Capture ( Capture ) import Servant.API.ReqBody ( ReqBody ) import Servant.API.QueryParam ( QueryParam ) +import Servant.API.MatrixParam ( MatrixParam ) import Servant.API.Get ( Get ) import Servant.API.Post ( Post ) import Servant.API.Put ( 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 837ab806..9352ad9e 100644 --- a/test/Servant/QQSpec.hs +++ b/test/Servant/QQSpec.hs @@ -85,6 +85,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| @@ -153,6 +167,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 2eb43744..403b245e 100644 --- a/test/Servant/Utils/LinksSpec.hs +++ b/test/Servant/Utils/LinksSpec.hs @@ -14,12 +14,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 @@ -39,15 +42,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