745dbd0 · typeable/servant

servant-jquery.cabal+5−1

compare with master

unifiedsplit

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

31library

32 exposed-modules: Servant.JQuery

33 other-modules: Servant.JQuery.Internal

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

34+ build-depends: base >=4.5 && <5

35+ , servant >= 0.2.1

36+ , lens >= 4

37+ , MissingH

38+ , charset

35 hs-source-dirs: src

39 hs-source-dirs: src

36 default-language: Haskell2010

40 default-language: Haskell2010

37 ghc-options: -Wall

41 ghc-options: -Wall

src/Servant/JQuery.hs+4−2

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

44 args = captures

45 ++ map (view argName) queryparams

46 ++ body

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

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

48 ++ ["onSuccess", "onError"]

49

50 captures = map captureArg

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

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

71

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

73+ headerStr header = "\"" ++

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

74+ headerArgName header ++

75+ "\": " ++ show header

74

76

75 fname = req ^. funcName

77 fname = req ^. funcName

76 method = req ^. reqMethod

78 method = req ^. reqMethod

src/Servant/JQuery/Internal.hs+32−3

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

9import Control.Applicative

10import Control.Lens

11import Data.Char (toLower)

12+import qualified Data.CharSet as Set

13+import qualified Data.CharSet.Unicode.Category as Set

12import Data.List

14import Data.List

13import Data.Monoid

15import Data.Monoid

14import Data.Proxy

16import Data.Proxy

@@ -64,17 +66,44 @@ data HeaderArg = HeaderArg

64 } deriving (Eq)

66 } deriving (Eq)

65

67

66instance Show HeaderArg where

68instance Show HeaderArg where

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

69+ show (HeaderArg n) = toValidFunctionName ("header" <> n)

68 show (ReplaceHeaderArg n p)

70 show (ReplaceHeaderArg n p)

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

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

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

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

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

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

72 | otherwise = p

74 | otherwise = p

73 where

75 where

74− pv = "header" <> n

76+ pv = toValidFunctionName ("header" <> n)

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

77 pn = "{" <> n <> "}"

76 rp = replace pn "" p

78 rp = replace pn "" p

77

79

80+-- | Attempts to reduce the function name provided to that allowed by JS.

81+-- https://mathiasbynens.be/notes/javascript-identifiers

82+-- Couldn't work out how to handle zero-width characters.

83+-- @TODO: specify better default function name, or throw error?

84+toValidFunctionName :: String -> String

85+toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs

86+ where

87+ setFirstChar c = if firstChar c

88+ then c

89+ else '_'

90+ firstChar c = (prefixOK c) || (or . map (Set.member c) $ firstLetterOK)

91+ remainder c = (prefixOK c) || (or . map (Set.member c) $ remainderOK)

92+ -- Valid prefixes

93+ prefixOK c = c `elem` ['$','_']

94+ -- Unicode character sets

95+ firstLetterOK = [ Set.lowercaseLetter

96+ , Set.uppercaseLetter

97+ , Set.titlecaseLetter

98+ , Set.modifierLetter

99+ , Set.otherLetter

100+ , Set.letterNumber ]

101+ remainderOK = firstLetterOK <> [ Set.nonSpacingMark

102+ , Set.spacingCombiningMark

103+ , Set.decimalNumber

104+ , Set.connectorPunctuation ]

105+toValidFunctionName [] = "_"

106+

78data Url = Url

107data Url = Url

79 { _path :: Path

108 { _path :: Path

80 , _queryStr :: [QueryArg]

109 , _queryStr :: [QueryArg]

test/Servant/JQuerySpec.hs+12

@@ -30,12 +30,18 @@ type HeaderHandlingAPI = "something" :> Header "Foo" String

30type CustomAuthAPI = "something" :> Authorization "Basic" String

31 :> Get Int

32

33+type CustomHeaderAPI = "something" :> MyLovelyHorse String

34+ :> Get Int

35+

33headerHandlingProxy :: Proxy HeaderHandlingAPI

36headerHandlingProxy :: Proxy HeaderHandlingAPI

34headerHandlingProxy = Proxy

37headerHandlingProxy = Proxy

35

38

36customAuthProxy :: Proxy CustomAuthAPI

39customAuthProxy :: Proxy CustomAuthAPI

37customAuthProxy = Proxy

40customAuthProxy = Proxy

38

41

42+customHeaderProxy :: Proxy CustomHeaderAPI

43+customHeaderProxy = Proxy

44+

39spec :: Spec

45spec :: Spec

40spec = describe "Servant.JQuery"

46spec = describe "Servant.JQuery"

41 generateJSSpec

47 generateJSSpec

@@ -67,3 +73,9 @@ generateJSSpec = describe "generateJS" $ do

67 jsText `shouldContain` "headerAuthorization"

73 jsText `shouldContain` "headerAuthorization"

68 jsText `shouldContain` "headers: { \"Authorization\": \"Basic \" + headerAuthorization }\n"

74 jsText `shouldContain` "headers: { \"Authorization\": \"Basic \" + headerAuthorization }\n"

69

75

76+ it "should handle complex, custom HTTP headers" $ do

77+ let jsText = generateJS $ jquery customHeaderProxy

78+ print jsText

79+ parseFromString jsText `shouldSatisfy` isRight

80+ jsText `shouldContain` "headerXMyLovelyHorse"

81+ jsText `shouldContain` "headers: { \"X-MyLovelyHorse\": \"I am good friends with \" + headerXMyLovelyHorse }\n"

test/Servant/JQuerySpec/CustomHeaders.hs+15−3

@@ -21,11 +21,23 @@ import Servant.JQuery

21data Authorization (sym :: Symbol) a

22

23instance (KnownSymbol sym, HasJQ sublayout)

24− => HasJQ (Authorization sym a :> sublayout) where

24+ => HasJQ (Authorization sym a :> sublayout) where

25 type JQ (Authorization sym a :> sublayout) = JQ sublayout

26

27 jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $

28 req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $

29− tokenType (symbolVal (Proxy :: Proxy sym)) ]

29+ tokenType (symbolVal (Proxy :: Proxy sym)) ]

30 where

31− tokenType t = t <> " {Authorization}"

31+ tokenType t = t <> " {Authorization}"

32+

33+-- | This is a combinator that fetches an X-MyLovelyHorse header.

34+data MyLovelyHorse a

35+

36+instance (HasJQ sublayout)

37+ => HasJQ (MyLovelyHorse a :> sublayout) where

38+ type JQ (MyLovelyHorse a :> sublayout) = JQ sublayout

39+

40+ jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $

41+ req & reqHeaders <>~ [ ReplaceHeaderArg "X-MyLovelyHorse" tpl ]

42+ where

43+ tpl = "I am good friends with {X-MyLovelyHorse}"