b59a62e · typeable/servant

servant-foreign/servant-foreign.cabal−2

compare with master

unifiedsplit

@@ -20,10 +20,8 @@ source-repository head

20library

21 exposed-modules: Servant.Foreign

22 build-depends: base == 4.*

23− , charset

24 , lens >= 4

23 , lens >= 4

25 , servant >= 0.5

24 , servant >= 0.5

26− , text

27 hs-source-dirs: src

25 hs-source-dirs: src

28 default-language: Haskell2010

26 default-language: Haskell2010

29 ghc-options: -Wall

27 ghc-options: -Wall

servant-foreign/src/Servant/Foreign.hs+2−57

@@ -21,7 +21,6 @@ module Servant.Foreign

21 , HeaderArg(..)

22 , ArgType(..)

23 , Req

24− , toValidFunctionName

25 , captureArg

24 , captureArg

26 , defReq

25 , defReq

27 , concatCase

26 , concatCase

@@ -48,12 +47,8 @@ import Control.Applicative

48#endif

47#endif

49import Control.Lens hiding (List)

48import Control.Lens hiding (List)

50import Data.Char (toLower, toUpper)

49import Data.Char (toLower, toUpper)

51−import qualified Data.CharSet as Set

52−import qualified Data.CharSet.Unicode.Category as Set

53import Data.List

50import Data.List

54−import Data.Monoid

55import Data.Proxy

51import Data.Proxy

56−import qualified Data.Text as T

57import GHC.Exts (Constraint)

52import GHC.Exts (Constraint)

58import GHC.TypeLits

53import GHC.TypeLits

59import Servant.API

54import Servant.API

@@ -105,58 +100,8 @@ data HeaderArg = HeaderArg

105 | ReplaceHeaderArg

100 | ReplaceHeaderArg

106 { headerArgName :: String

101 { headerArgName :: String

107 , headerPattern :: String

102 , headerPattern :: String

108− } deriving (Eq)

103+ } deriving (Eq, Show)

109−

104+

110−

111−-- |

112−instance Show HeaderArg where

113− show (HeaderArg n) = toValidFunctionName ("header" <> n)

114− show (ReplaceHeaderArg n p)

115− | pn `isPrefixOf` p = pv <> " + \"" <> rp <> "\""

116− | pn `isSuffixOf` p = "\"" <> rp <> "\" + " <> pv

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

118− <> "\""

119− | otherwise = p

120− where

121− pv = toValidFunctionName ("header" <> n)

122− pn = "{" <> n <> "}"

123− rp = replace pn "" p

124− -- Use replace method from Data.Text

125− replace old new = T.unpack .

126− T.replace (T.pack old) (T.pack new) .

127− T.pack

128−

129−-- | Attempts to reduce the function name provided to that allowed by @'Foreign'@.

130−--

131−-- Here we are making an assumption that js identifiers are common enough.

132−-- https://mathiasbynens.be/notes/javascript-identifiers

133−-- Couldn't work out how to handle zero-width characters.

134−-- TODO: compare it with other generated languages(such as ruby via lackey)

135−-- and generalize.

136−--

137−-- @TODO: specify better default function name, or throw error?

138−toValidFunctionName :: String -> String

139−toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs

140− where

141− setFirstChar c = if firstChar c

142− then c

143− else '_'

144− firstChar c = prefixOK c || any (Set.member c) firstLetterOK

145− remainder c = prefixOK c || any (Set.member c) remainderOK

146− -- Valid prefixes

147− prefixOK c = c `elem` ['$','_']

148− -- Unicode character sets

149− firstLetterOK = [ Set.lowercaseLetter

150− , Set.uppercaseLetter

151− , Set.titlecaseLetter

152− , Set.modifierLetter

153− , Set.otherLetter

154− , Set.letterNumber ]

155− remainderOK = firstLetterOK <> [ Set.nonSpacingMark

156− , Set.spacingCombiningMark

157− , Set.decimalNumber

158− , Set.connectorPunctuation ]

159−toValidFunctionName [] = "_"

160

105

161type MatrixArg = QueryArg

106type MatrixArg = QueryArg

162

107

servant-js/servant-js.cabal+3

@@ -41,8 +41,10 @@ library

41 Servant.JS.JQuery

42 Servant.JS.Vanilla

43 build-depends: base >=4.5 && <5

44+ , charset

44 , lens >= 4

45 , lens >= 4

45 , servant-foreign >= 0.1

46 , servant-foreign >= 0.1

47+ , text

46 hs-source-dirs: src

48 hs-source-dirs: src

47 default-language: Haskell2010

49 default-language: Haskell2010

48 ghc-options: -Wall

50 ghc-options: -Wall

@@ -82,4 +84,5 @@ test-suite spec

82 , lens >= 4

84 , lens >= 4

83 , servant

85 , servant

84 , servant-js

86 , servant-js

87+ , text

85 default-language: Haskell2010

88 default-language: Haskell2010

servant-js/src/Servant/JS/Angular.hs+1−1

@@ -109,7 +109,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>

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

110 headerStr header = "\"" ++

111 headerArgName header ++

112− "\": " ++ show header

112+ "\": " ++ toJSHeader header

113

114 namespace =

115 if hasService

servant-js/src/Servant/JS/Axios.hs+1−1

@@ -104,7 +104,7 @@ generateAxiosJSWith aopts opts req = "\n" <>

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

105 headerStr header = "\"" ++

106 headerArgName header ++

107− "\": " ++ show header

107+ "\": " ++ toJSHeader header

108

109 namespace =

110 if hasNoModule

servant-js/src/Servant/JS/Internal.hs+54−2

@@ -10,6 +10,8 @@ module Servant.JS.Internal

10 , jsGParams

11 , jsMParams

12 , paramToStr

13+ , toValidFunctionName

14+ , toJSHeader

13 -- re-exports

15 -- re-exports

14 , (:<|>)(..)

16 , (:<|>)(..)

15 , (:>)

17 , (:>)

@@ -29,8 +31,13 @@ module Servant.JS.Internal

29 , Header

31 , Header

30 ) where

32 ) where

31

33

32−import Control.Lens hiding (List)

34+import Control.Lens hiding (List)

35+import qualified Data.CharSet as Set

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

37+import Data.List

38+import Data.Monoid

39+import qualified Data.Text as T

33−import Servant.Foreign

40+import Servant.Foreign

34

41

35type AjaxReq = Req

42type AjaxReq = Req

36

43

@@ -74,6 +81,51 @@ defCommonGeneratorOptions = CommonGeneratorOptions

74 , urlPrefix = ""

81 , urlPrefix = ""

75 }

82 }

76

83

84+-- | Attempts to reduce the function name provided to that allowed by @'Foreign'@.

85+--

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

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

88+--

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

90+toValidFunctionName :: String -> String

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

92+ where

93+ setFirstChar c = if firstChar c then c else '_'

94+ firstChar c = prefixOK c || any (Set.member c) firstLetterOK

95+ remainder c = prefixOK c || any (Set.member c) remainderOK

96+ -- Valid prefixes

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

98+ -- Unicode character sets

99+ firstLetterOK = [ Set.lowercaseLetter

100+ , Set.uppercaseLetter

101+ , Set.titlecaseLetter

102+ , Set.modifierLetter

103+ , Set.otherLetter

104+ , Set.letterNumber ]

105+ remainderOK = firstLetterOK

106+ <> [ Set.nonSpacingMark

107+ , Set.spacingCombiningMark

108+ , Set.decimalNumber

109+ , Set.connectorPunctuation ]

110+toValidFunctionName [] = "_"

111+

112+toJSHeader :: HeaderArg -> String

113+toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n)

114+toJSHeader (ReplaceHeaderArg n p)

115+ | pn `isPrefixOf` p = pv <> " + \"" <> rp <> "\""

116+ | pn `isSuffixOf` p = "\"" <> rp <> "\" + " <> pv

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

118+ <> "\""

119+ | otherwise = p

120+ where

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

122+ pn = "{" <> n <> "}"

123+ rp = replace pn "" p

124+ -- Use replace method from Data.Text

125+ replace old new = T.unpack

126+ . T.replace (T.pack old) (T.pack new)

127+ . T.pack

128+

77jsSegments :: [Segment] -> String

129jsSegments :: [Segment] -> String

78jsSegments [] = ""

130jsSegments [] = ""

79jsSegments [x] = "/" ++ segmentToStr x False

131jsSegments [x] = "/" ++ segmentToStr x False

servant-js/src/Servant/JS/JQuery.hs+1−1

@@ -72,7 +72,7 @@ generateJQueryJSWith opts req = "\n" <>

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

73 headerStr header = "\"" ++

74 headerArgName header ++

75− "\": " ++ show header

75+ "\": " ++ toJSHeader header

76

77 namespace = if null (moduleName opts)

78 then "var "

servant-js/src/Servant/JS/Vanilla.hs+1−1

@@ -79,7 +79,7 @@ generateVanillaJSWith opts req = "\n" <>

79 where headersStr = intercalate "\n" $ map headerStr hs

80 headerStr header = " xhr.setRequestHeader(\"" ++

81 headerArgName header ++

82− "\", " ++ show header ++ ");"

82+ "\", " ++ toJSHeader header ++ ");"

83

84 namespace = if null (moduleName opts)

85 then "var "