Add a test to explicitly cover header variable template replacement

This commit is contained in:
Geoffrey Roberts 2015-01-22 11:41:06 +11:00
parent 8aa5ce504e
commit d7f9e30fc8
2 changed files with 25 additions and 0 deletions

View file

@ -33,6 +33,9 @@ type CustomAuthAPI = "something" :> Authorization "Basic" String
type CustomHeaderAPI = "something" :> MyLovelyHorse String
:> Get Int
type CustomHeaderAPI2 = "something" :> WhatsForDinner String
:> Get Int
headerHandlingProxy :: Proxy HeaderHandlingAPI
headerHandlingProxy = Proxy
@ -42,6 +45,9 @@ customAuthProxy = Proxy
customHeaderProxy :: Proxy CustomHeaderAPI
customHeaderProxy = Proxy
customHeaderProxy2 :: Proxy CustomHeaderAPI2
customHeaderProxy2 = Proxy
spec :: Spec
spec = describe "Servant.JQuery"
generateJSSpec
@ -79,3 +85,10 @@ generateJSSpec = describe "generateJS" $ do
parseFromString jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerXMyLovelyHorse"
jsText `shouldContain` "headers: { \"X-MyLovelyHorse\": \"I am good friends with \" + headerXMyLovelyHorse }\n"
it "should handle complex, custom HTTP headers (template replacement)" $ do
let jsText = generateJS $ jquery customHeaderProxy2
print jsText
parseFromString jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerXWhatsForDinner"
jsText `shouldContain` "headers: { \"X-WhatsForDinner\": \"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\" }\n"

View file

@ -41,3 +41,15 @@ instance (HasJQ sublayout)
req & reqHeaders <>~ [ ReplaceHeaderArg "X-MyLovelyHorse" tpl ]
where
tpl = "I am good friends with {X-MyLovelyHorse}"
-- | This is a combinator that fetches an X-WhatsForDinner header.
data WhatsForDinner a
instance (HasJQ sublayout)
=> HasJQ (WhatsForDinner a :> sublayout) where
type JQ (WhatsForDinner a :> sublayout) = JQ sublayout
jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $
req & reqHeaders <>~ [ ReplaceHeaderArg "X-WhatsForDinner" tpl ]
where
tpl = "I would like {X-WhatsForDinner} with a cherry on top."