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

Correct ReqBody instance for link generation. Was partially applied

Browse Source
This commit is contained in:
Christian Marie 2015-03-17 12:10:24 +11:00
parent 47a30c6411
commit 7d91e50fc7
2 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -159,7 +159,7 @@ type family IsElem' a s :: Constraint
type family IsElem endpoint api :: Constraint where
IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
IsElem (e :> sa) (e :> sb) = IsElem sa sb
IsElem sa (Header x :> sb) = IsElem sa sb
IsElem sa (Header x :> sb) = IsElem sa sb
IsElem sa (ReqBody y x :> sb) = IsElem sa sb
IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb
IsElem sa (QueryParam x y :> sb) = IsElem sa sb
@ -320,8 +320,8 @@ instance (KnownSymbol sym, HasLink sub)
k = symbolVal (Proxy :: Proxy sym)
-- Misc instances
instance HasLink sub => HasLink (ReqBody a :> sub) where
type MkLink (ReqBody a :> sub) = MkLink sub
instance HasLink sub => HasLink (ReqBody ct a :> sub) where
type MkLink (ReqBody ct a :> sub) = MkLink sub
toLink _ = toLink (Proxy :: Proxy sub)
instance (ToText v, HasLink sub)

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

@ -29,7 +29,7 @@ type TestApi =
:<|> "raw" :> Raw
type TestLink = "hello" :> "hi" :> Get '[JSON] Bool
type TestLink2 = "greet" :> Post '[PlainText] Bool
type TestLink2 = "greet" :> ReqBody '[JSON] [Int] :> Post '[PlainText] Bool
type TestLink3 = "parent" :> "child" :> Get '[JSON] String
type BadTestLink = "hallo" :> "hi" :> Get '[JSON] Bool