eeva/servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Daniel Larsson 2015-01-04 18:14:27 +01:00
parent 80b82fd885
commit 409a10442d
4 changed files with 64 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
src/Servant/QQ.hs
View File

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

6
src/Servant/Utils/Links.hs
View File

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

22
test/Servant/QQSpec.hs
View File

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

6
test/Servant/Utils/LinksSpec.hs
View File

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