e16f90f · servant · git.iko.soy

git.iko.soy/servant

Extended HeaderArg to allow header arguments to replace the contents of a template, allowing specially composed headers to create specially formatted headers

commite16f90f107923e5b968a1be05391606131e3c0cf authorGeoffrey Roberts <groberts@anchor.net.au> dateWed 21 Jan 2015, 18:27 (12 years ago) parent3dc9424

4 files changed+46−9

compare with master

unifiedsplit

servant-jquery.cabal+2−1 src/Servant/JQuery.hs+3−3 src/Servant/JQuery/Internal.hs+22−2 test/Servant/JQuerySpec.hs+19−3

servant-jquery.cabal+2−1

@@ -31,7 +31,7 @@ flag example

3131library

3232 exposed-modules: Servant.JQuery

3333 other-modules: Servant.JQuery.Internal

34− build-depends: base >=4.5 && <5, servant >= 0.2.1, lens >= 4

34+ build-depends: base >=4.5 && <5, servant >= 0.2.1, lens >= 4, MissingH

3535 hs-source-dirs: src

3636 default-language: Haskell2010

3737 ghc-options: -Wall

@@ -68,5 +68,6 @@ test-suite spec

6868 , servant-jquery

6969 , servant

7070 , hspec >= 2.0

71+ , hspec-expectations

7172 , language-ecmascript == 0.16.*

7273 default-language: Haskell2010

src/Servant/JQuery.hs+3−3

@@ -44,7 +44,7 @@ generateJS req = "\n" <>

4444 args = captures

4545 ++ map (view argName) queryparams

4646 ++ body

47− ++ map ("header"++) hs

47+ ++ map ((<>) "header" . headerArgName) hs

4848 ++ ["onSuccess", "onError"]

4949

5050 captures = map captureArg

@@ -67,10 +67,10 @@ generateJS req = "\n" <>

6767 reqheaders =

6868 if null hs

6969 then ""

70− else "\n , headers: { " ++ headersStr ++ " } }\n"

70+ else "\n , headers: { " ++ headersStr ++ " }\n"

7171

7272 where headersStr = intercalate ", " $ map headerStr hs

73− headerStr hname = "\"" ++ hname ++ "\": header" ++ hname

73+ headerStr header = "\"" ++ headerArgName header ++ "\": " ++ show header

7474

7575 fname = req ^. funcName

7676 method = req ^. reqMethod

src/Servant/JQuery/Internal.hs+22−2

@@ -9,8 +9,10 @@ module Servant.JQuery.Internal where

99import Control.Applicative

1010import Control.Lens

1111import Data.Char (toLower)

12+import Data.List

1213import Data.Monoid

1314import Data.Proxy

15+import Data.String.Utils

1416import GHC.TypeLits

1517import Servant.API

1618

@@ -53,7 +55,25 @@ data QueryArg = QueryArg

5355 , _argType :: ArgType

5456 } deriving (Eq, Show)

5557

56−type HeaderArg = String

58+data HeaderArg = HeaderArg

59+ { headerArgName :: String

60+ }

61+ | ReplaceHeaderArg

62+ { headerArgName :: String

63+ , headerPattern :: String

64+ } deriving (Eq)

65+

66+instance Show HeaderArg where

67+ show (HeaderArg n) = "header" <> n

68+ show (ReplaceHeaderArg n p)

69+ | pn `startswith` p = pv <> " + \"" <> rp <> "\""

70+ | pn `endswith` p = "\"" <> rp <> "\" + " <> pv

71+ | pn `isInfixOf` p = "\"" <> replace pn ("\"" <> pv <> "\"") p <> "\""

72+ | otherwise = p

73+ where

74+ pv = "header" <> n

75+ pn = "{header" <> n <> "}"

76+ rp = replace pn "" p

5777

5878data Url = Url

5979 { _path :: Path

@@ -144,7 +164,7 @@ instance (KnownSymbol sym, HasJQ sublayout)

144164 type JQ (Header sym a :> sublayout) = JQ sublayout

145165

146166 jqueryFor Proxy req =

147− jqueryFor subP (req & reqHeaders <>~ [hname])

167+ jqueryFor subP (req & reqHeaders <>~ [HeaderArg hname])

148168

149169 where hname = symbolVal (Proxy :: Proxy sym)

150170 subP = Proxy :: Proxy sublayout

test/Servant/JQuerySpec.hs+19−3

@@ -1,6 +1,9 @@

1−{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE QuasiQuotes #-}

3−{-# LANGUAGE TypeOperators #-}

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE QuasiQuotes #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

5+{-# LANGUAGE TypeFamilies #-}

6+{-# LANGUAGE TypeOperators #-}

47{-# OPTIONS_GHC -fno-warn-orphans #-}

58module Servant.JQuerySpec where

@@ -20,6 +23,12 @@ GET /has.extension Bool

2023type TopLevelRawAPI = "something" :> Get Int

2124 :<|> Raw

2225

26+type HeaderHandlingAPI = "something" :> Header "Foo" String

27+ :> Get Int

28+

29+headerHandlingProxy :: Proxy HeaderHandlingAPI

30+headerHandlingProxy = Proxy

31+

2332spec :: Spec

2433spec = describe "Servant.JQuery"

2534 generateJSSpec

@@ -37,3 +46,10 @@ generateJSSpec = describe "generateJS" $ do

3746 print $ generateJS $ topLevel "GET"

3847 parseFromString (generateJS $ topLevel "GET") `shouldSatisfy` isRight

3948

49+ it "should handle simple HTTP headers" $ do

50+ let jsText = generateJS $ jquery headerHandlingProxy

51+ print jsText

52+ parseFromString jsText `shouldSatisfy` isRight

53+ jsText `shouldContain` "headerFoo"

54+ jsText `shouldContain` "headers: { \"Foo\": headerFoo }\n"

55+