Merge pull request #160 from haskell-servant/jkarni/fix-is-elem-header

Fix IsElem for Header.
This commit is contained in:
Alp Mestanogullari 2015-07-23 13:50:53 +02:00
commit 710c560de8
3 changed files with 3 additions and 2 deletions

View file

@ -2,6 +2,7 @@ HEAD
---- ----
* Add `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators * Add `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
* Fix safeLink, so Header is not in fact required.
0.4.2 0.4.2
----- -----

View file

@ -166,7 +166,7 @@ type family IsElem' a s :: Constraint
type family IsElem endpoint api :: Constraint where type family IsElem endpoint api :: Constraint where
IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb) IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
IsElem (e :> sa) (e :> sb) = IsElem sa sb IsElem (e :> sa) (e :> sb) = IsElem sa sb
IsElem sa (Header x :> sb) = IsElem sa sb IsElem sa (Header sym x :> sb) = IsElem sa sb
IsElem sa (ReqBody y x :> sb) = IsElem sa sb IsElem sa (ReqBody y x :> sb) = IsElem sa sb
IsElem (Capture z y :> sa) (Capture x y :> sb) IsElem (Capture z y :> sa) (Capture x y :> sb)
= IsElem sa sb = IsElem sa sb

View file

@ -25,7 +25,7 @@ type TestApi =
:<|> "get" :> Get '[JSON] () :<|> "get" :> Get '[JSON] ()
:<|> "put" :> Put '[JSON] () :<|> "put" :> Put '[JSON] ()
:<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] () :<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] ()
:<|> "delete" :> Header "ponies" :> Delete '[JSON] () :<|> "delete" :> Header "ponies" String :> Delete '[JSON] ()
:<|> "raw" :> Raw :<|> "raw" :> Raw
type TestLink = "hello" :> "hi" :> Get '[JSON] Bool type TestLink = "hello" :> "hi" :> Get '[JSON] Bool