Added test cases for matrix parameters. Added some missing cases in the IsElem type family (QueryParams and QueryFlag)
This commit is contained in:
parent
0b29d1d690
commit
0b2f2ae490
4 changed files with 64 additions and 16 deletions
|
@ -58,6 +58,7 @@ import Servant.API.Post ( Post )
|
||||||
import Servant.API.Put ( Put )
|
import Servant.API.Put ( Put )
|
||||||
import Servant.API.Delete ( Delete )
|
import Servant.API.Delete ( Delete )
|
||||||
import Servant.API.QueryParam ( QueryParam )
|
import Servant.API.QueryParam ( QueryParam )
|
||||||
|
import Servant.API.MatrixParam ( MatrixParam )
|
||||||
import Servant.API.ReqBody ( ReqBody )
|
import Servant.API.ReqBody ( ReqBody )
|
||||||
import Servant.API.Sub ( (:>) )
|
import Servant.API.Sub ( (:>) )
|
||||||
import Servant.API.Alternative ( (:<|>) )
|
import Servant.API.Alternative ( (:<|>) )
|
||||||
|
@ -68,15 +69,16 @@ import Servant.API.Alternative ( (:<|>) )
|
||||||
-- only one of 'get', 'post', 'put', and 'delete' in a value), but
|
-- only one of 'get', 'post', 'put', and 'delete' in a value), but
|
||||||
-- sometimes requires a little more work.
|
-- sometimes requires a little more work.
|
||||||
class ExpSYM repr' repr | repr -> repr', repr' -> repr where
|
class ExpSYM repr' repr | repr -> repr', repr' -> repr where
|
||||||
lit :: String -> repr' -> repr
|
lit :: String -> repr' -> repr
|
||||||
capture :: String -> String -> repr -> repr
|
capture :: String -> String -> repr -> repr
|
||||||
reqBody :: String -> repr -> repr
|
reqBody :: String -> repr -> repr
|
||||||
queryParam :: String -> String -> repr -> repr
|
queryParam :: String -> String -> repr -> repr
|
||||||
conj :: repr' -> repr -> repr
|
matrixParam :: String -> String -> repr -> repr
|
||||||
get :: String -> repr
|
conj :: repr' -> repr -> repr
|
||||||
post :: String -> repr
|
get :: String -> repr
|
||||||
put :: String -> repr
|
post :: String -> repr
|
||||||
delete :: String -> repr
|
put :: String -> repr
|
||||||
|
delete :: String -> repr
|
||||||
|
|
||||||
|
|
||||||
infixr 6 >:
|
infixr 6 >:
|
||||||
|
@ -90,7 +92,9 @@ instance ExpSYM Type Type where
|
||||||
capture name typ r = AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))
|
capture name typ r = AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))
|
||||||
(ConT $ mkName typ) >: r
|
(ConT $ mkName typ) >: r
|
||||||
reqBody typ r = AppT (ConT ''ReqBody) (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
|
(ConT $ mkName typ) >: r
|
||||||
conj x = AppT (AppT (ConT ''(:>)) x)
|
conj x = AppT (AppT (ConT ''(:>)) x)
|
||||||
get typ = AppT (ConT ''Get) (ConT $ mkName typ)
|
get typ = AppT (ConT ''Get) (ConT $ mkName typ)
|
||||||
|
@ -111,17 +115,27 @@ parseUrlSegment = try parseCapture
|
||||||
<|> try parseLit
|
<|> try parseLit
|
||||||
where
|
where
|
||||||
parseCapture = do
|
parseCapture = do
|
||||||
cname <- many (noneOf " ?/:")
|
cname <- many (noneOf " ?/:;")
|
||||||
char ':'
|
char ':'
|
||||||
ctyp <- many (noneOf " ?/:")
|
ctyp <- many (noneOf " ?/:;")
|
||||||
return $ capture cname ctyp
|
mx <- many parseMatrixParam
|
||||||
|
return $ capture cname ctyp . foldr (.) id mx
|
||||||
parseQueryParam = do
|
parseQueryParam = do
|
||||||
char '?'
|
char '?'
|
||||||
cname <- many (noneOf " ?/:")
|
cname <- many (noneOf " ?/:;")
|
||||||
char ':'
|
char ':'
|
||||||
ctyp <- many (noneOf " ?/:")
|
ctyp <- many (noneOf " ?/:;")
|
||||||
return $ queryParam cname ctyp
|
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 :: ExpSYM repr repr => Parser (repr -> repr)
|
||||||
parseUrl = do
|
parseUrl = do
|
||||||
|
|
|
@ -54,6 +54,7 @@ import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
|
||||||
import Servant.API.Capture ( Capture )
|
import Servant.API.Capture ( Capture )
|
||||||
import Servant.API.ReqBody ( ReqBody )
|
import Servant.API.ReqBody ( ReqBody )
|
||||||
import Servant.API.QueryParam ( QueryParam )
|
import Servant.API.QueryParam ( QueryParam )
|
||||||
|
import Servant.API.MatrixParam ( MatrixParam )
|
||||||
import Servant.API.Get ( Get )
|
import Servant.API.Get ( Get )
|
||||||
import Servant.API.Post ( Post )
|
import Servant.API.Post ( Post )
|
||||||
import Servant.API.Put ( Put )
|
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 (e :> sa) (Capture x y :> sb) = IsElem sa sb
|
||||||
IsElem sa (ReqBody x :> sb) = IsElem sa sb
|
IsElem sa (ReqBody x :> sb) = IsElem sa sb
|
||||||
IsElem sa (QueryParam x y :> 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 e = 'True
|
||||||
IsElem e a = 'False
|
IsElem e a = 'False
|
||||||
|
|
||||||
|
|
|
@ -85,6 +85,20 @@ type SimpleQueryParam' = "hello" :> QueryParam "p" Int :> Post Bool
|
||||||
type SimpleQueryParam'' = "hello" :> QueryParam "r" Int :> Post Bool
|
type SimpleQueryParam'' = "hello" :> QueryParam "r" Int :> Post Bool
|
||||||
type SimpleQueryParam''' = "hello" :> QueryParam "p" Bool :> 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 ----------------------------------------------------------
|
-- Combinations ----------------------------------------------------------
|
||||||
|
|
||||||
type TwoPaths = [sitemap|
|
type TwoPaths = [sitemap|
|
||||||
|
@ -153,6 +167,14 @@ spec = do
|
||||||
(u::SimpleQueryParam) ~= (u::SimpleQueryParam' ) ~> True
|
(u::SimpleQueryParam) ~= (u::SimpleQueryParam' ) ~> True
|
||||||
(u::SimpleQueryParam) ~= (u::SimpleQueryParam'') ~> False
|
(u::SimpleQueryParam) ~= (u::SimpleQueryParam'') ~> False
|
||||||
(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
|
it "Handles multiples paths" $ do
|
||||||
(u::TwoPaths) ~= (u::TwoPaths') ~> True
|
(u::TwoPaths) ~= (u::TwoPaths') ~> True
|
||||||
it "Ignores inline comments" $ do
|
it "Ignores inline comments" $ do
|
||||||
|
|
|
@ -14,12 +14,15 @@ import Servant.Utils.Links ( IsElem, IsLink )
|
||||||
type TestApi =
|
type TestApi =
|
||||||
"hello" :> Capture "name" String :> QueryParam "capital" Bool :> Get Bool
|
"hello" :> Capture "name" String :> QueryParam "capital" Bool :> Get Bool
|
||||||
:<|> "greet" :> ReqBody 'True :> Post Bool
|
:<|> "greet" :> ReqBody 'True :> Post Bool
|
||||||
|
:<|> "parent" :> MatrixParams "name" String :> "child" :> MatrixParam "gender" String :> Get String
|
||||||
|
|
||||||
type TestLink = "hello" :> "hi" :> Get Bool
|
type TestLink = "hello" :> "hi" :> Get Bool
|
||||||
type TestLink2 = "greet" :> Post Bool
|
type TestLink2 = "greet" :> Post Bool
|
||||||
|
type TestLink3 = "parent" :> "child" :> Get String
|
||||||
|
|
||||||
type BadTestLink = "hallo" :> "hi" :> Get Bool
|
type BadTestLink = "hallo" :> "hi" :> Get Bool
|
||||||
type BadTestLink2 = "greet" :> Get Bool
|
type BadTestLink2 = "greet" :> Get Bool
|
||||||
|
type BadTestLink3 = "parent" :> "child" :> MatrixFlag "male" :> Get String
|
||||||
|
|
||||||
type NotALink = "hello" :> Capture "x" Bool :> Get Bool
|
type NotALink = "hello" :> Capture "x" Bool :> Get Bool
|
||||||
type NotALink2 = "hello" :> ReqBody 'True :> 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
|
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 TestLink TestApi)) ~> True
|
||||||
reflected (Proxy::Proxy (IsElem TestLink2 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
|
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 BadTestLink TestApi)) ~> False
|
||||||
reflected (Proxy::Proxy (IsElem BadTestLink2 TestApi)) ~> False
|
reflected (Proxy::Proxy (IsElem BadTestLink2 TestApi)) ~> False
|
||||||
|
reflected (Proxy::Proxy (IsElem BadTestLink3 TestApi)) ~> False
|
||||||
|
|
||||||
isLink :: Spec
|
isLink :: Spec
|
||||||
isLink = describe "IsLink" $ do
|
isLink = describe "IsLink" $ do
|
||||||
it "is True when all Subs are paths and the last is a method" $ 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 TestLink)) ~> True
|
||||||
reflected (Proxy::Proxy (IsLink TestLink2)) ~> True
|
reflected (Proxy::Proxy (IsLink TestLink2)) ~> True
|
||||||
|
reflected (Proxy::Proxy (IsLink TestLink3)) ~> True
|
||||||
it "is False of anything with captures" $ do
|
it "is False of anything with captures" $ do
|
||||||
reflected (Proxy::Proxy (IsLink NotALink)) ~> False
|
reflected (Proxy::Proxy (IsLink NotALink)) ~> False
|
||||||
reflected (Proxy::Proxy (IsLink NotALink2)) ~> False
|
reflected (Proxy::Proxy (IsLink NotALink2)) ~> False
|
||||||
|
|
Loading…
Reference in a new issue