Merge pull request #4 from dlarsson/master

Support for matrix parameters

.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

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
@@ -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

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 ( Header )
 import Servant.API.Post ( Post )
 import Servant.API.Put ( Put )
 import Servant.API.QueryParam ( QueryFlag, QueryParams, QueryParam )
+import Servant.API.MatrixParam ( MatrixFlag, MatrixParams, MatrixParam )
 import Servant.API.Raw ( Raw )
 import Servant.API.ReqBody ( ReqBody )
 import Servant.API.Sub ( (:>)(..) )

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=<author name>
+-- > 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[]=<author1>;authors[]=<author2>;...
+-- > 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

src/Servant/QQ.hs

@@ -29,7 +29,6 @@
 module Servant.QQ (sitemap) where
 
 import Control.Monad ( void )
-import Control.Applicative ( (<$>) )
 import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
 import Language.Haskell.TH
     ( mkName, Type(AppT, ConT, LitT), TyLit(StrTyLit) )
@@ -58,6 +57,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 +72,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 +93,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 +114,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

@@ -53,7 +53,8 @@ import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
 
 import Servant.API.Capture ( Capture )
 import Servant.API.ReqBody ( ReqBody )
-import Servant.API.QueryParam ( QueryParam )
+import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )
+import Servant.API.MatrixParam ( MatrixParam, MatrixParams, MatrixFlag )
 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

@@ -15,6 +15,7 @@ import Servant.API
     ( (:<|>),
       ReqBody,
       QueryParam,
+      MatrixParam,
       Put,
       Get,
       Post,
@@ -85,6 +86,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 +168,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

@@ -6,7 +6,7 @@ module Servant.Utils.LinksSpec where
 import Test.Hspec ( Spec, it, describe )
 
 import Servant.API
-    ( type (:<|>), ReqBody, QueryParam, Get, Post, Capture, type (:>) )
+    ( type (:<|>), ReqBody, QueryParam, MatrixParam, MatrixParams, MatrixFlag, Get, Post, Capture, type (:>) )
 import Servant.QQSpec ( (~>) )
 import Servant.Utils.Links ( IsElem, IsLink )
 
@@ -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