Extended HeaderArg to allow header arguments to replace the contents of a template, allowing specially composed headers to create specially formatted headers
This commit is contained in:
parent
3dc9424765
commit
e16f90f107
4 changed files with 46 additions and 9 deletions
|
@ -31,7 +31,7 @@ flag example
|
|||
library
|
||||
exposed-modules: Servant.JQuery
|
||||
other-modules: Servant.JQuery.Internal
|
||||
build-depends: base >=4.5 && <5, servant >= 0.2.1, lens >= 4
|
||||
build-depends: base >=4.5 && <5, servant >= 0.2.1, lens >= 4, MissingH
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
@ -68,5 +68,6 @@ test-suite spec
|
|||
, servant-jquery
|
||||
, servant
|
||||
, hspec >= 2.0
|
||||
, hspec-expectations
|
||||
, language-ecmascript == 0.16.*
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -44,7 +44,7 @@ generateJS req = "\n" <>
|
|||
args = captures
|
||||
++ map (view argName) queryparams
|
||||
++ body
|
||||
++ map ("header"++) hs
|
||||
++ map ((<>) "header" . headerArgName) hs
|
||||
++ ["onSuccess", "onError"]
|
||||
|
||||
captures = map captureArg
|
||||
|
@ -67,10 +67,10 @@ generateJS req = "\n" <>
|
|||
reqheaders =
|
||||
if null hs
|
||||
then ""
|
||||
else "\n , headers: { " ++ headersStr ++ " } }\n"
|
||||
else "\n , headers: { " ++ headersStr ++ " }\n"
|
||||
|
||||
where headersStr = intercalate ", " $ map headerStr hs
|
||||
headerStr hname = "\"" ++ hname ++ "\": header" ++ hname
|
||||
headerStr header = "\"" ++ headerArgName header ++ "\": " ++ show header
|
||||
|
||||
fname = req ^. funcName
|
||||
method = req ^. reqMethod
|
||||
|
|
|
@ -9,8 +9,10 @@ module Servant.JQuery.Internal where
|
|||
import Control.Applicative
|
||||
import Control.Lens
|
||||
import Data.Char (toLower)
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Data.Proxy
|
||||
import Data.String.Utils
|
||||
import GHC.TypeLits
|
||||
import Servant.API
|
||||
|
||||
|
@ -53,7 +55,25 @@ data QueryArg = QueryArg
|
|||
, _argType :: ArgType
|
||||
} deriving (Eq, Show)
|
||||
|
||||
type HeaderArg = String
|
||||
data HeaderArg = HeaderArg
|
||||
{ headerArgName :: String
|
||||
}
|
||||
| ReplaceHeaderArg
|
||||
{ headerArgName :: String
|
||||
, headerPattern :: String
|
||||
} deriving (Eq)
|
||||
|
||||
instance Show HeaderArg where
|
||||
show (HeaderArg n) = "header" <> n
|
||||
show (ReplaceHeaderArg n p)
|
||||
| pn `startswith` p = pv <> " + \"" <> rp <> "\""
|
||||
| pn `endswith` p = "\"" <> rp <> "\" + " <> pv
|
||||
| pn `isInfixOf` p = "\"" <> replace pn ("\"" <> pv <> "\"") p <> "\""
|
||||
| otherwise = p
|
||||
where
|
||||
pv = "header" <> n
|
||||
pn = "{header" <> n <> "}"
|
||||
rp = replace pn "" p
|
||||
|
||||
data Url = Url
|
||||
{ _path :: Path
|
||||
|
@ -144,7 +164,7 @@ instance (KnownSymbol sym, HasJQ sublayout)
|
|||
type JQ (Header sym a :> sublayout) = JQ sublayout
|
||||
|
||||
jqueryFor Proxy req =
|
||||
jqueryFor subP (req & reqHeaders <>~ [hname])
|
||||
jqueryFor subP (req & reqHeaders <>~ [HeaderArg hname])
|
||||
|
||||
where hname = symbolVal (Proxy :: Proxy sym)
|
||||
subP = Proxy :: Proxy sublayout
|
||||
|
|
|
@ -1,6 +1,9 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Servant.JQuerySpec where
|
||||
|
||||
|
@ -20,6 +23,12 @@ GET /has.extension Bool
|
|||
type TopLevelRawAPI = "something" :> Get Int
|
||||
:<|> Raw
|
||||
|
||||
type HeaderHandlingAPI = "something" :> Header "Foo" String
|
||||
:> Get Int
|
||||
|
||||
headerHandlingProxy :: Proxy HeaderHandlingAPI
|
||||
headerHandlingProxy = Proxy
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Servant.JQuery"
|
||||
generateJSSpec
|
||||
|
@ -37,3 +46,10 @@ generateJSSpec = describe "generateJS" $ do
|
|||
print $ generateJS $ topLevel "GET"
|
||||
parseFromString (generateJS $ topLevel "GET") `shouldSatisfy` isRight
|
||||
|
||||
it "should handle simple HTTP headers" $ do
|
||||
let jsText = generateJS $ jquery headerHandlingProxy
|
||||
print jsText
|
||||
parseFromString jsText `shouldSatisfy` isRight
|
||||
jsText `shouldContain` "headerFoo"
|
||||
jsText `shouldContain` "headers: { \"Foo\": headerFoo }\n"
|
||||
|
||||
|
|
Loading…
Reference in a new issue