Added test cases for matrix parameters. Added some missing cases in the IsElem type family (QueryParams and QueryFlag)

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 ( (:<|>) )
@@ -72,6 +73,7 @@ class ExpSYM repr' repr | repr -> repr', repr' -> repr where
     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
@@ -92,6 +94,8 @@ instance ExpSYM Type Type where
     reqBody typ r      = AppT (ConT ''ReqBody) (ConT $ mkName typ) >: r
     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)
     post typ           = AppT (ConT ''Post) (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 " ?/:")
+         ctyp  <- many (noneOf " ?/:;")
-         return $ capture cname ctyp
+         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

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
 

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

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