05623f5 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Merge pull request #243 from arianvp/foreign-text

05623f5Julian Arni11 years ago

servant-client/CHANGELOG.md+1

compare with master

unifiedsplit

@@ -1,6 +1,7 @@

1HEAD

2----

4+* Use the `text` package instead of `String`.

4* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators

5* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators

5* Added support for `path` on `BaseUrl`.

6* Added support for `path` on `BaseUrl`.

6* `client` now takes an explicit `Manager` argument.

7* `client` now takes an explicit `Manager` argument.

servant-examples/tutorial/T9.hs+5−4

@@ -16,6 +16,7 @@ import Servant.JS

16import System.Random

18import qualified Data.Text as T

19+import qualified Data.Text.IO as TIO

19import qualified Language.Javascript.JQuery as JQ

20import qualified Language.Javascript.JQuery as JQ

21data Point = Point

22data Point = Point

@@ -91,14 +92,14 @@ server' :: Server API'

91server' = server

92server' = server

92 :<|> serveDirectory "tutorial/t9"

93 :<|> serveDirectory "tutorial/t9"

94−apiJS :: String

95+apiJS :: Text

95apiJS = jsForAPI api jquery

96apiJS = jsForAPI api jquery

97writeJSFiles :: IO ()

98writeJSFiles :: IO ()

98writeJSFiles = do

99writeJSFiles = do

99− writeFile "tutorial/t9/api.js" apiJS

100+ TIO.writeFile "tutorial/t9/api.js" apiJS

100− jq <- readFile =<< JQ.file

101+ jq <- TIO.readFile =<< JQ.file

101− writeFile "tutorial/t9/jq.js" jq

102+ TIO.writeFile "tutorial/t9/jq.js" jq

102

103

103app :: Application

104app :: Application

104app = serve api' server'

105app = serve api' server'

servant-foreign/CHANGELOG.md+2−2

@@ -1,4 +1,4 @@

1−0.5

1+HEAD

2-----

3−

3+* Use the `text` package instead of `String`.

4* Extract javascript-oblivious types and helpers to *servant-foreign*

servant-foreign/servant-foreign.cabal+2−1

@@ -29,6 +29,7 @@ library

29 build-depends: base == 4.*

30 , lens == 4.*

31 , servant == 0.5.*

32+ , text >= 1.2 && < 1.3

32 hs-source-dirs: src

33 hs-source-dirs: src

33 default-language: Haskell2010

34 default-language: Haskell2010

34− ghc-options: -Wall

35+ ghc-options: -Wall

servant-foreign/src/Servant/Foreign.hs+26−29

@@ -12,6 +12,7 @@

12{-# LANGUAGE TypeFamilies #-}

13{-# LANGUAGE TypeOperators #-}

14{-# LANGUAGE UndecidableInstances #-}

15+{-# LANGUAGE OverloadedStrings #-}

16-- | Generalizes all the data needed to make code generation work with

17-- | Generalizes all the data needed to make code generation work with

17-- arbitrary programming languages.

18-- arbitrary programming languages.

@@ -46,43 +47,39 @@ module Servant.Foreign

46 , module Servant.API

47 , module Servant.API

47 ) where

48 ) where

49−#if !MIN_VERSION_base(4,8,0)

50−import Control.Applicative

51−#endif

52import Control.Lens (makeLenses, (%~), (&), (.~),

50import Control.Lens (makeLenses, (%~), (&), (.~),

53 (<>~), _last)

51 (<>~), _last)

54−import Data.Char (toLower, toUpper)

52+import Data.Monoid ((<>))

55−import Data.List

53+import Data.Text

56import Data.Proxy

54import Data.Proxy

57import GHC.Exts (Constraint)

55import GHC.Exts (Constraint)

58import GHC.TypeLits

56import GHC.TypeLits

59import Servant.API

57import Servant.API

58+import Prelude hiding (concat)

61-- | Function name builder that simply concat each part together

60-- | Function name builder that simply concat each part together

62−concatCase :: FunctionName -> String

61+concatCase :: FunctionName -> Text

63concatCase = concat

62concatCase = concat

65-- | Function name builder using the snake_case convention.

64-- | Function name builder using the snake_case convention.

66-- each part is separated by a single underscore character.

65-- each part is separated by a single underscore character.

67−snakeCase :: FunctionName -> String

66+snakeCase :: FunctionName -> Text

68snakeCase = intercalate "_"

67snakeCase = intercalate "_"

70-- | Function name builder using the CamelCase convention.

69-- | Function name builder using the CamelCase convention.

71-- each part begins with an upper case character.

70-- each part begins with an upper case character.

72−camelCase :: FunctionName -> String

71+camelCase :: FunctionName -> Text

73camelCase [] = ""

72camelCase [] = ""

74camelCase (p:ps) = concat $ p : camelCase' ps

73camelCase (p:ps) = concat $ p : camelCase' ps

75 where camelCase' [] = []

74 where camelCase' [] = []

76− camelCase' (r:rs) = capitalize r : camelCase' rs

75+ camelCase' (r:rs) = toUpper r : camelCase' rs

77− capitalize [] = []

78− capitalize (x:xs) = toUpper x : xs

80−type Arg = String

77+type Arg = Text

82data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] }

79data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] }

83 deriving (Eq, Show)

80 deriving (Eq, Show)

85−data SegmentType = Static String -- ^ a static path segment. like "/foo"

82+data SegmentType = Static Text -- ^ a static path segment. like "/foo"

86 | Cap Arg -- ^ a capture. like "/:userid"

83 | Cap Arg -- ^ a capture. like "/:userid"

87 deriving (Eq, Show)

84 deriving (Eq, Show)

@@ -100,11 +97,11 @@ data QueryArg = QueryArg

100 } deriving (Eq, Show)

97 } deriving (Eq, Show)

101

102data HeaderArg = HeaderArg

99data HeaderArg = HeaderArg

103− { headerArgName :: String

100+ { headerArgName :: Text

104 }

101 }

105 | ReplaceHeaderArg

102 | ReplaceHeaderArg

106− { headerArgName :: String

103+ { headerArgName :: Text

107− , headerPattern :: String

104+ , headerPattern :: Text

108 } deriving (Eq, Show)

105 } deriving (Eq, Show)

109

106

110

107

@@ -118,8 +115,8 @@ data Url = Url

118defUrl :: Url

115defUrl :: Url

119defUrl = Url [] []

116defUrl = Url [] []

120

117

121−type FunctionName = [String]

118+type FunctionName = [Text]

122−type Method = String

119+type Method = Text

123

120

124data Req = Req

121data Req = Req

125 { _reqUrl :: Url

122 { _reqUrl :: Url

@@ -175,7 +172,7 @@ instance (KnownSymbol sym, HasForeign sublayout)

175 req & reqUrl.path <>~ [Segment (Cap str) []]

172 req & reqUrl.path <>~ [Segment (Cap str) []]

176 & funcName %~ (++ ["by", str])

173 & funcName %~ (++ ["by", str])

177

174

178− where str = symbolVal (Proxy :: Proxy sym)

175+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

179

176

180instance Elem JSON list => HasForeign (Delete list a) where

177instance Elem JSON list => HasForeign (Delete list a) where

181 type Foreign (Delete list a) = Req

178 type Foreign (Delete list a) = Req

@@ -198,7 +195,7 @@ instance (KnownSymbol sym, HasForeign sublayout)

198 foreignFor Proxy req =

195 foreignFor Proxy req =

199 foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])

196 foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])

200

197

201− where hname = symbolVal (Proxy :: Proxy sym)

198+ where hname = pack . symbolVal $ (Proxy :: Proxy sym)

202 subP = Proxy :: Proxy sublayout

199 subP = Proxy :: Proxy sublayout

203

200

204instance Elem JSON list => HasForeign (Post list a) where

201instance Elem JSON list => HasForeign (Post list a) where

@@ -223,7 +220,7 @@ instance (KnownSymbol sym, HasForeign sublayout)

223 foreignFor (Proxy :: Proxy sublayout) $

220 foreignFor (Proxy :: Proxy sublayout) $

224 req & reqUrl.queryStr <>~ [QueryArg str Normal]

221 req & reqUrl.queryStr <>~ [QueryArg str Normal]

225

222

226− where str = symbolVal (Proxy :: Proxy sym)

223+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

227

224

228instance (KnownSymbol sym, HasForeign sublayout)

225instance (KnownSymbol sym, HasForeign sublayout)

229 => HasForeign (QueryParams sym a :> sublayout) where

226 => HasForeign (QueryParams sym a :> sublayout) where

@@ -233,7 +230,7 @@ instance (KnownSymbol sym, HasForeign sublayout)

233 foreignFor (Proxy :: Proxy sublayout) $

230 foreignFor (Proxy :: Proxy sublayout) $

234 req & reqUrl.queryStr <>~ [QueryArg str List]

231 req & reqUrl.queryStr <>~ [QueryArg str List]

235

232

236− where str = symbolVal (Proxy :: Proxy sym)

233+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

237

234

238instance (KnownSymbol sym, HasForeign sublayout)

235instance (KnownSymbol sym, HasForeign sublayout)

239 => HasForeign (QueryFlag sym :> sublayout) where

236 => HasForeign (QueryFlag sym :> sublayout) where

@@ -243,7 +240,7 @@ instance (KnownSymbol sym, HasForeign sublayout)

243 foreignFor (Proxy :: Proxy sublayout) $

240 foreignFor (Proxy :: Proxy sublayout) $

244 req & reqUrl.queryStr <>~ [QueryArg str Flag]

241 req & reqUrl.queryStr <>~ [QueryArg str Flag]

245

242

246− where str = symbolVal (Proxy :: Proxy sym)

243+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

247

244

248instance (KnownSymbol sym, HasForeign sublayout)

245instance (KnownSymbol sym, HasForeign sublayout)

249 => HasForeign (MatrixParam sym a :> sublayout) where

246 => HasForeign (MatrixParam sym a :> sublayout) where

@@ -253,8 +250,8 @@ instance (KnownSymbol sym, HasForeign sublayout)

253 foreignFor (Proxy :: Proxy sublayout) $

250 foreignFor (Proxy :: Proxy sublayout) $

254 req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal]

251 req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal]

255

252

256− where str = symbolVal (Proxy :: Proxy sym)

253+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

257− strArg = str ++ "Value"

254+ strArg = str <> "Value"

258

255

259instance (KnownSymbol sym, HasForeign sublayout)

256instance (KnownSymbol sym, HasForeign sublayout)

260 => HasForeign (MatrixParams sym a :> sublayout) where

257 => HasForeign (MatrixParams sym a :> sublayout) where

@@ -264,7 +261,7 @@ instance (KnownSymbol sym, HasForeign sublayout)

264 foreignFor (Proxy :: Proxy sublayout) $

261 foreignFor (Proxy :: Proxy sublayout) $

265 req & reqUrl.path._last.matrix <>~ [QueryArg str List]

262 req & reqUrl.path._last.matrix <>~ [QueryArg str List]

266

263

267− where str = symbolVal (Proxy :: Proxy sym)

264+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

268

265

269instance (KnownSymbol sym, HasForeign sublayout)

266instance (KnownSymbol sym, HasForeign sublayout)

270 => HasForeign (MatrixFlag sym :> sublayout) where

267 => HasForeign (MatrixFlag sym :> sublayout) where

@@ -274,13 +271,13 @@ instance (KnownSymbol sym, HasForeign sublayout)

274 foreignFor (Proxy :: Proxy sublayout) $

271 foreignFor (Proxy :: Proxy sublayout) $

275 req & reqUrl.path._last.matrix <>~ [QueryArg str Flag]

272 req & reqUrl.path._last.matrix <>~ [QueryArg str Flag]

276

273

277− where str = symbolVal (Proxy :: Proxy sym)

274+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

278

275

279instance HasForeign Raw where

276instance HasForeign Raw where

280 type Foreign Raw = Method -> Req

277 type Foreign Raw = Method -> Req

281

278

282 foreignFor Proxy req method =

279 foreignFor Proxy req method =

283− req & funcName %~ ((toLower <$> method) :)

280+ req & funcName %~ ((toLower method) :)

284 & reqMethod .~ method

281 & reqMethod .~ method

285

282

286instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where

283instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where

@@ -299,7 +296,7 @@ instance (KnownSymbol path, HasForeign sublayout)

299 req & reqUrl.path <>~ [Segment (Static str) []]

296 req & reqUrl.path <>~ [Segment (Static str) []]

300 & funcName %~ (++ [str])

297 & funcName %~ (++ [str])

301

298

302− where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path)

299+ where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)

303

300

304instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where

301instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where

305 type Foreign (RemoteHost :> sublayout) = Foreign sublayout

302 type Foreign (RemoteHost :> sublayout) = Foreign sublayout

servant-js/src/Servant/JS.hs+6−3

@@ -39,7 +39,7 @@

39-- Let's keep it simple and produce vanilla Javascript code with the default options.

40--

41-- @

42−-- jsCode :: String

42+-- jsCode :: Text

43-- jsCode = 'jsForAPI' api 'vanillaJS'

44-- @

45--

@@ -60,7 +60,7 @@

60-- All you need to do to use it is to use 'vanillaJSWith' and pass it @myOptions@.

61--

62-- @

63−-- jsCodeWithMyOptions :: String

63+-- jsCodeWithMyOptions :: Text

64-- jsCodeWithMyOptions = 'jsForAPI' api ('vanillaJSWith' myOptions)

65-- @

66--

@@ -112,7 +112,10 @@ module Servant.JS

112 , GenerateList(..)

113 ) where

114

115+import Prelude hiding (writeFile)

115import Data.Proxy

116import Data.Proxy

117+import Data.Text

118+import Data.Text.IO (writeFile)

116import Servant.JS.Angular

119import Servant.JS.Angular

117import Servant.JS.Axios

120import Servant.JS.Axios

118import Servant.JS.Internal

121import Servant.JS.Internal

@@ -131,7 +134,7 @@ javascript p = foreignFor p defReq

131jsForAPI :: (HasForeign api, GenerateList (Foreign api))

134jsForAPI :: (HasForeign api, GenerateList (Foreign api))

132 => Proxy api -- ^ proxy for your API type

135 => Proxy api -- ^ proxy for your API type

133 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)

136 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)

134− -> String -- ^ a string that you can embed in your pages or write to a file

137+ -> Text -- ^ a text that you can embed in your pages or write to a file

135jsForAPI p gen = gen (listFromAPI p)

138jsForAPI p gen = gen (listFromAPI p)

136

139

137-- | Directly generate all the javascript functions for your API

140-- | Directly generate all the javascript functions for your API

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

@@ -1,17 +1,19 @@

1+{-#LANGUAGE OverloadedStrings #-}

1module Servant.JS.Angular where

2module Servant.JS.Angular where

3import Control.Lens

4import Control.Lens

4−import Data.List

5import Data.Monoid

6+import qualified Data.Text as T

7+import Data.Text (Text)

6import Servant.Foreign

8import Servant.Foreign

7import Servant.JS.Internal

9import Servant.JS.Internal

9-- | Options specific to the angular code generator

11-- | Options specific to the angular code generator

10data AngularOptions = AngularOptions

12data AngularOptions = AngularOptions

11− { serviceName :: String -- ^ When generating code with wrapInService,

13+ { serviceName :: Text -- ^ When generating code with wrapInService,

12 -- name of the service to generate

14 -- name of the service to generate

13− , prologue :: String -> String -> String -- ^ beginning of the service definition

15+ , prologue :: Text -> Text -> Text -- ^ beginning of the service definition

14− , epilogue :: String -- ^ end of the service definition

16+ , epilogue :: Text -- ^ end of the service definition

15 }

17 }

17-- | Default options for the Angular codegen. Used by 'wrapInService'.

19-- | Default options for the Angular codegen. Used by 'wrapInService'.

@@ -34,12 +36,12 @@ angularService ngOpts = angularServiceWith ngOpts defCommonGeneratorOptions

34angularServiceWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator

36angularServiceWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator

35angularServiceWith ngOpts opts reqs =

37angularServiceWith ngOpts opts reqs =

36 prologue ngOpts svc mName

38 prologue ngOpts svc mName

37− <> intercalate "," (map generator reqs) <>

39+ <> T.intercalate "," (map generator reqs) <>

38 epilogue ngOpts

40 epilogue ngOpts

39 where

41 where

40 generator req = generateAngularJSWith ngOpts opts req

42 generator req = generateAngularJSWith ngOpts opts req

41 svc = serviceName ngOpts

43 svc = serviceName ngOpts

42− mName = if null (moduleName opts)

44+ mName = if moduleName opts == ""

43 then "app."

45 then "app."

44 else moduleName opts <> "."

46 else moduleName opts <> "."

@@ -50,14 +52,14 @@ angular ngopts = angularWith ngopts defCommonGeneratorOptions

51-- | Generate regular javascript functions that use the $http service.

53-- | Generate regular javascript functions that use the $http service.

52angularWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator

54angularWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator

53−angularWith ngopts opts = intercalate "\n\n" . map (generateAngularJSWith ngopts opts)

55+angularWith ngopts opts = T.intercalate "\n\n" . map (generateAngularJSWith ngopts opts)

55-- | js codegen using $http service from Angular using default options

57-- | js codegen using $http service from Angular using default options

56−generateAngularJS :: AngularOptions -> AjaxReq -> String

58+generateAngularJS :: AngularOptions -> AjaxReq -> Text

57generateAngularJS ngOpts = generateAngularJSWith ngOpts defCommonGeneratorOptions

59generateAngularJS ngOpts = generateAngularJSWith ngOpts defCommonGeneratorOptions

59-- | js codegen using $http service from Angular

61-- | js codegen using $http service from Angular

60−generateAngularJSWith :: AngularOptions -> CommonGeneratorOptions -> AjaxReq -> String

62+generateAngularJSWith :: AngularOptions -> CommonGeneratorOptions -> AjaxReq -> Text

61generateAngularJSWith ngOptions opts req = "\n" <>

63generateAngularJSWith ngOptions opts req = "\n" <>

62 fname <> fsep <> " function(" <> argsStr <> ")\n"

64 fname <> fsep <> " function(" <> argsStr <> ")\n"

63 <> "{\n"

65 <> "{\n"

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

69 <> " });\n"

71 <> " });\n"

70 <> "}\n"

72 <> "}\n"

72− where argsStr = intercalate ", " args

74+ where argsStr = T.intercalate ", " args

73 args = http

75 args = http

74 ++ captures

76 ++ captures

75 ++ map (view argName) queryparams

77 ++ map (view argName) queryparams

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

79 -- If we want to generate Top Level Function, they must depend on

81 -- If we want to generate Top Level Function, they must depend on

80 -- the $http service, if we generate a service, the functions will

82 -- the $http service, if we generate a service, the functions will

81 -- inherit this dependency from the service

83 -- inherit this dependency from the service

82− http = case length (serviceName ngOptions) of

84+ http = case T.length (serviceName ngOptions) of

83 0 -> ["$http"]

85 0 -> ["$http"]

84 _ -> []

86 _ -> []

@@ -104,12 +106,12 @@ generateAngularJSWith ngOptions opts req = "\n" <>

104 reqheaders =

106 reqheaders =

105 if null hs

107 if null hs

106 then ""

108 then ""

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

109+ else " , headers: { " <> headersStr <> " }\n"

108

110

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

111+ where headersStr = T.intercalate ", " $ map headerStr hs

110− headerStr header = "\"" ++

112+ headerStr header = "\"" <>

111− headerArgName header ++

113+ headerArgName header <>

112− "\": " ++ toJSHeader header

114+ "\": " <> toJSHeader header

113

115

114 namespace =

116 namespace =

115 if hasService

117 if hasService

@@ -118,9 +120,9 @@ generateAngularJSWith ngOptions opts req = "\n" <>

118 then "var "

120 then "var "

119 else (moduleName opts) <> "."

121 else (moduleName opts) <> "."

120 where

122 where

121− hasNoModule = null (moduleName opts)

123+ hasNoModule = moduleName opts == ""

122

124

123− hasService = not $ null (serviceName ngOptions)

125+ hasService = serviceName ngOptions /= ""

124

126

125 fsep = if hasService then ":" else " ="

127 fsep = if hasService then ":" else " ="

126

128

@@ -129,13 +131,13 @@ generateAngularJSWith ngOptions opts req = "\n" <>

129 method = req ^. reqMethod

131 method = req ^. reqMethod

130 url = if url' == "'" then "'/'" else url'

132 url = if url' == "'" then "'/'" else url'

131 url' = "'"

133 url' = "'"

132− ++ urlPrefix opts

134+ <> urlPrefix opts

133− ++ urlArgs

135+ <> urlArgs

134− ++ queryArgs

136+ <> queryArgs

135

137

136 urlArgs = jsSegments

138 urlArgs = jsSegments

137 $ req ^.. reqUrl.path.traverse

139 $ req ^.. reqUrl.path.traverse

138

140

139 queryArgs = if null queryparams

141 queryArgs = if null queryparams

140 then ""

142 then ""

141− else " + '?" ++ jsParams queryparams

143+ else " + '?" <> jsParams queryparams

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

@@ -1,9 +1,10 @@

1+{-#LANGUAGE OverloadedStrings #-}

1module Servant.JS.Axios where

2module Servant.JS.Axios where

3import Control.Lens

4import Control.Lens

4−import Data.Char (toLower)

5−import Data.List

6import Data.Monoid

5import Data.Monoid

6+import Data.Text (Text)

7+import qualified Data.Text as T

7import Servant.Foreign

8import Servant.Foreign

8import Servant.JS.Internal

9import Servant.JS.Internal

@@ -14,9 +15,9 @@ data AxiosOptions = AxiosOptions

14 -- should be made using credentials

15 -- should be made using credentials

15 withCredentials :: !Bool

16 withCredentials :: !Bool

16 -- | the name of the cookie to use as a value for xsrf token

17 -- | the name of the cookie to use as a value for xsrf token

17− , xsrfCookieName :: !(Maybe String)

18+ , xsrfCookieName :: !(Maybe Text)

18 -- | the name of the header to use as a value for xsrf token

19 -- | the name of the header to use as a value for xsrf token

19− , xsrfHeaderName :: !(Maybe String)

20+ , xsrfHeaderName :: !(Maybe Text)

20 }

21 }

22-- | Default instance of the AxiosOptions

23-- | Default instance of the AxiosOptions

@@ -36,14 +37,14 @@ axios aopts = axiosWith aopts defCommonGeneratorOptions

37-- | Generate regular javascript functions that use the axios library.

38-- | Generate regular javascript functions that use the axios library.

38axiosWith :: AxiosOptions -> CommonGeneratorOptions -> JavaScriptGenerator

39axiosWith :: AxiosOptions -> CommonGeneratorOptions -> JavaScriptGenerator

39−axiosWith aopts opts = intercalate "\n\n" . map (generateAxiosJSWith aopts opts)

40+axiosWith aopts opts = T.intercalate "\n\n" . map (generateAxiosJSWith aopts opts)

41-- | js codegen using axios library using default options

42-- | js codegen using axios library using default options

42−generateAxiosJS :: AxiosOptions -> AjaxReq -> String

43+generateAxiosJS :: AxiosOptions -> AjaxReq -> Text

43generateAxiosJS aopts = generateAxiosJSWith aopts defCommonGeneratorOptions

44generateAxiosJS aopts = generateAxiosJSWith aopts defCommonGeneratorOptions

45-- | js codegen using axios library

46-- | js codegen using axios library

46−generateAxiosJSWith :: AxiosOptions -> CommonGeneratorOptions -> AjaxReq -> String

47+generateAxiosJSWith :: AxiosOptions -> CommonGeneratorOptions -> AjaxReq -> Text

47generateAxiosJSWith aopts opts req = "\n" <>

48generateAxiosJSWith aopts opts req = "\n" <>

48 fname <> " = function(" <> argsStr <> ")\n"

49 fname <> " = function(" <> argsStr <> ")\n"

49 <> "{\n"

50 <> "{\n"

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

57 <> " });\n"

58 <> " });\n"

58 <> "}\n"

59 <> "}\n"

60− where argsStr = intercalate ", " args

61+ where argsStr = T.intercalate ", " args

61 args = captures

62 args = captures

62 ++ map (view argName) queryparams

63 ++ map (view argName) queryparams

63 ++ body

64 ++ body

@@ -101,30 +102,30 @@ generateAxiosJSWith aopts opts req = "\n" <>

101 then ""

102 then ""

102 else " , headers: { " <> headersStr <> " }\n"

103 else " , headers: { " <> headersStr <> " }\n"

103

104

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

105+ where headersStr = T.intercalate ", " $ map headerStr hs

105− headerStr header = "\"" ++

106+ headerStr header = "\"" <>

106− headerArgName header ++

107+ headerArgName header <>

107− "\": " ++ toJSHeader header

108+ "\": " <> toJSHeader header

108

109

109 namespace =

110 namespace =

110 if hasNoModule

111 if hasNoModule

111 then "var "

112 then "var "

112 else (moduleName opts) <> "."

113 else (moduleName opts) <> "."

113 where

114 where

114− hasNoModule = null (moduleName opts)

115+ hasNoModule = moduleName opts == ""

115

116

116 fname = namespace <> (functionNameBuilder opts $ req ^. funcName)

117 fname = namespace <> (functionNameBuilder opts $ req ^. funcName)

117

118

118− method = map toLower $ req ^. reqMethod

119+ method = T.toLower $ req ^. reqMethod

119 url = if url' == "'" then "'/'" else url'

120 url = if url' == "'" then "'/'" else url'

120 url' = "'"

121 url' = "'"

121− ++ urlPrefix opts

122+ <> urlPrefix opts

122− ++ urlArgs

123+ <> urlArgs

123− ++ queryArgs

124+ <> queryArgs

124

125

125 urlArgs = jsSegments

126 urlArgs = jsSegments

126 $ req ^.. reqUrl.path.traverse

127 $ req ^.. reqUrl.path.traverse

127

128

128 queryArgs = if null queryparams

129 queryArgs = if null queryparams

129 then ""

130 then ""

130− else " + '?" ++ jsParams queryparams

131+ else " + '?" <> jsParams queryparams

servant-js/src/Servant/JS/Internal.hs+57−55

@@ -1,3 +1,4 @@

1+{-#LANGUAGE OverloadedStrings #-}

1module Servant.JS.Internal

2module Servant.JS.Internal

2 ( JavaScriptGenerator

3 ( JavaScriptGenerator

3 , CommonGeneratorOptions(..)

4 , CommonGeneratorOptions(..)

@@ -34,28 +35,28 @@ module Servant.JS.Internal

34import Control.Lens ((^.))

35import Control.Lens ((^.))

35import qualified Data.CharSet as Set

36import qualified Data.CharSet as Set

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

37import qualified Data.CharSet.Unicode.Category as Set

37−import Data.List

38import Data.Monoid

39import qualified Data.Text as T

40+import Data.Text (Text)

40import Servant.Foreign

41import Servant.Foreign

42type AjaxReq = Req

43type AjaxReq = Req

44-- A 'JavascriptGenerator' just takes the data found in the API type

45-- A 'JavascriptGenerator' just takes the data found in the API type

45−-- for each endpoint and generates Javascript code in a String. Several

46+-- for each endpoint and generates Javascript code in a Text. Several

46-- generators are available in this package.

47-- generators are available in this package.

47−type JavaScriptGenerator = [Req] -> String

48+type JavaScriptGenerator = [Req] -> Text

49-- | This structure is used by specific implementations to let you

50-- | This structure is used by specific implementations to let you

50-- customize the output

51-- customize the output

51data CommonGeneratorOptions = CommonGeneratorOptions

52data CommonGeneratorOptions = CommonGeneratorOptions

52 {

53 {

53− functionNameBuilder :: FunctionName -> String -- ^ function generating function names

54+ functionNameBuilder :: FunctionName -> Text -- ^ function generating function names

54− , requestBody :: String -- ^ name used when a user want to send the request body (to let you redefine it)

55+ , requestBody :: Text -- ^ name used when a user want to send the request body (to let you redefine it)

55− , successCallback :: String -- ^ name of the callback parameter when the request was successful

56+ , successCallback :: Text -- ^ name of the callback parameter when the request was successful

56− , errorCallback :: String -- ^ name of the callback parameter when the request reported an error

57+ , errorCallback :: Text -- ^ name of the callback parameter when the request reported an error

57− , moduleName :: String -- ^ namespace on which we define the foreign function (empty mean local var)

58+ , moduleName :: Text -- ^ namespace on which we define the foreign function (empty mean local var)

58− , urlPrefix :: String -- ^ a prefix we should add to the Url in the codegen

59+ , urlPrefix :: Text -- ^ a prefix we should add to the Url in the codegen

59 }

60 }

61-- | Default options.

62-- | Default options.

@@ -87,80 +88,81 @@ defCommonGeneratorOptions = CommonGeneratorOptions

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

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

88--

89--

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

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

90−toValidFunctionName :: String -> String

91+toValidFunctionName :: Text -> Text

92+toValidFunctionName t =

93+ case T.uncons t of

94+ Just (x,xs) ->

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

95+ setFirstChar x `T.cons` T.filter remainder xs

96+ Nothing -> "_"

92 where

97 where

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

98 setFirstChar c = if firstChar c then c else '_'

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

99+ firstChar c = prefixOK c || Set.member c firstLetterOK

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

100+ remainder c = prefixOK c || Set.member c remainderOK

96− -- Valid prefixes

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

101 prefixOK c = c `elem` ['$','_']

98− -- Unicode character sets

102+ firstLetterOK = mconcat

99− firstLetterOK = [ Set.lowercaseLetter

103+ [ Set.lowercaseLetter

100− , Set.uppercaseLetter

104+ , Set.uppercaseLetter

101− , Set.titlecaseLetter

105+ , Set.titlecaseLetter

102− , Set.modifierLetter

106+ , Set.modifierLetter

103− , Set.otherLetter

107+ , Set.otherLetter

104− , Set.letterNumber ]

108+ , Set.letterNumber

109+ ]

105 remainderOK = firstLetterOK

110 remainderOK = firstLetterOK

111+ <> mconcat

106− <> [ Set.nonSpacingMark

112+ [ Set.nonSpacingMark

107− , Set.spacingCombiningMark

113+ , Set.spacingCombiningMark

108− , Set.decimalNumber

114+ , Set.decimalNumber

109− , Set.connectorPunctuation ]

115+ , Set.connectorPunctuation

110−toValidFunctionName [] = "_"

116+ ]

111

117

112−toJSHeader :: HeaderArg -> String

118+toJSHeader :: HeaderArg -> Text

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

119toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n)

114toJSHeader (ReplaceHeaderArg n p)

120toJSHeader (ReplaceHeaderArg n p)

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

121+ | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""

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

122+ | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv

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

123+ | pn `T.isInfixOf` p = "\"" <> (T.replace pn ("\" + " <> pv <> " + \"") p)

118 <> "\""

124 <> "\""

119 | otherwise = p

125 | otherwise = p

120 where

126 where

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

127 pv = toValidFunctionName ("header" <> n)

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

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

123− rp = replace pn "" p

129+ rp = T.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

130

129−jsSegments :: [Segment] -> String

131+jsSegments :: [Segment] -> Text

130jsSegments [] = ""

132jsSegments [] = ""

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

133+jsSegments [x] = "/" <> segmentToStr x False

132−jsSegments (x:xs) = "/" ++ segmentToStr x True ++ jsSegments xs

134+jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs

133

135

134−segmentToStr :: Segment -> Bool -> String

136+segmentToStr :: Segment -> Bool -> Text

135segmentToStr (Segment st ms) notTheEnd =

137segmentToStr (Segment st ms) notTheEnd =

136− segmentTypeToStr st ++ jsMParams ms ++ if notTheEnd then "" else "'"

138+ segmentTypeToStr st <> jsMParams ms <> if notTheEnd then "" else "'"

137

139

138−segmentTypeToStr :: SegmentType -> String

140+segmentTypeToStr :: SegmentType -> Text

139segmentTypeToStr (Static s) = s

141segmentTypeToStr (Static s) = s

140−segmentTypeToStr (Cap s) = "' + encodeURIComponent(" ++ s ++ ") + '"

142+segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> s <> ") + '"

141

143

142−jsGParams :: String -> [QueryArg] -> String

144+jsGParams :: Text -> [QueryArg] -> Text

143jsGParams _ [] = ""

145jsGParams _ [] = ""

144jsGParams _ [x] = paramToStr x False

146jsGParams _ [x] = paramToStr x False

145−jsGParams s (x:xs) = paramToStr x True ++ s ++ jsGParams s xs

147+jsGParams s (x:xs) = paramToStr x True <> s <> jsGParams s xs

146

148

147−jsParams :: [QueryArg] -> String

149+jsParams :: [QueryArg] -> Text

148jsParams = jsGParams "&"

150jsParams = jsGParams "&"

149

151

150−jsMParams :: [MatrixArg] -> String

152+jsMParams :: [MatrixArg] -> Text

151jsMParams [] = ""

153jsMParams [] = ""

152−jsMParams xs = ";" ++ jsGParams ";" xs

154+jsMParams xs = ";" <> jsGParams ";" xs

153

155

154−paramToStr :: QueryArg -> Bool -> String

156+paramToStr :: QueryArg -> Bool -> Text

155paramToStr qarg notTheEnd =

157paramToStr qarg notTheEnd =

156 case qarg ^. argType of

158 case qarg ^. argType of

157 Normal -> name

159 Normal -> name

158− ++ "=' + encodeURIComponent("

160+ <> "=' + encodeURIComponent("

159− ++ name

161+ <> name

160− ++ if notTheEnd then ") + '" else ")"

162+ <> if notTheEnd then ") + '" else ")"

161− Flag -> name ++ "="

163+ Flag -> name <> "="

162 List -> name

164 List -> name

163− ++ "[]=' + encodeURIComponent("

165+ <> "[]=' + encodeURIComponent("

164− ++ name

166+ <> name

165− ++ if notTheEnd then ") + '" else ")"

167+ <> if notTheEnd then ") + '" else ")"

166 where name = qarg ^. argName

168 where name = qarg ^. argName

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

@@ -1,8 +1,10 @@

1+{-#LANGUAGE OverloadedStrings #-}

1module Servant.JS.JQuery where

2module Servant.JS.JQuery where

3import Control.Lens

4import Control.Lens

4−import Data.List

5import Data.Monoid

6+import qualified Data.Text as T

7+import Data.Text (Text)

6import Servant.Foreign

8import Servant.Foreign

7import Servant.JS.Internal

9import Servant.JS.Internal

@@ -10,19 +12,19 @@ import Servant.JS.Internal

10-- to make the AJAX calls. Uses 'defCommonGeneratorOptions'

12-- to make the AJAX calls. Uses 'defCommonGeneratorOptions'

11-- for the generator options.

13-- for the generator options.

12jquery :: JavaScriptGenerator

14jquery :: JavaScriptGenerator

13−jquery = concatMap generateJQueryJS

15+jquery = mconcat . map generateJQueryJS

15-- | Generate javascript functions that use the /jQuery/ library

17-- | Generate javascript functions that use the /jQuery/ library

16-- to make the AJAX calls. Lets you specify your own 'CommonGeneratorOptions'.

18-- to make the AJAX calls. Lets you specify your own 'CommonGeneratorOptions'.

17jqueryWith :: CommonGeneratorOptions -> JavaScriptGenerator

19jqueryWith :: CommonGeneratorOptions -> JavaScriptGenerator

18−jqueryWith opts = concatMap (generateJQueryJSWith opts)

20+jqueryWith opts = mconcat . map (generateJQueryJSWith opts)

20-- | js codegen using JQuery using default options

22-- | js codegen using JQuery using default options

21−generateJQueryJS :: AjaxReq -> String

23+generateJQueryJS :: AjaxReq -> Text

22generateJQueryJS = generateJQueryJSWith defCommonGeneratorOptions

24generateJQueryJS = generateJQueryJSWith defCommonGeneratorOptions

24-- | js codegen using JQuery

26-- | js codegen using JQuery

25−generateJQueryJSWith :: CommonGeneratorOptions -> AjaxReq -> String

27+generateJQueryJSWith :: CommonGeneratorOptions -> AjaxReq -> Text

26generateJQueryJSWith opts req = "\n" <>

28generateJQueryJSWith opts req = "\n" <>

27 fname <> " = function(" <> argsStr <> ")\n"

29 fname <> " = function(" <> argsStr <> ")\n"

28 <> "{\n"

30 <> "{\n"

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

36 <> " });\n"

38 <> " });\n"

37 <> "}\n"

39 <> "}\n"

39− where argsStr = intercalate ", " args

41+ where argsStr = T.intercalate ", " args

40 args = captures

42 args = captures

41 ++ map (view argName) queryparams

43 ++ map (view argName) queryparams

42 ++ body

44 ++ body

@@ -67,14 +69,14 @@ generateJQueryJSWith opts req = "\n" <>

67 reqheaders =

69 reqheaders =

68 if null hs

70 if null hs

69 then ""

71 then ""

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

72+ else " , headers: { " <> headersStr <> " }\n"

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

74+ where headersStr = T.intercalate ", " $ map headerStr hs

73− headerStr header = "\"" ++

75+ headerStr header = "\"" <>

74− headerArgName header ++

76+ headerArgName header <>

75− "\": " ++ toJSHeader header

77+ "\": " <> toJSHeader header

77− namespace = if null (moduleName opts)

79+ namespace = if (moduleName opts) == ""

78 then "var "

80 then "var "

79 else (moduleName opts) <> "."

81 else (moduleName opts) <> "."

80 fname = namespace <> (functionNameBuilder opts $ req ^. funcName)

82 fname = namespace <> (functionNameBuilder opts $ req ^. funcName)

@@ -82,13 +84,13 @@ generateJQueryJSWith opts req = "\n" <>

82 method = req ^. reqMethod

84 method = req ^. reqMethod

83 url = if url' == "'" then "'/'" else url'

85 url = if url' == "'" then "'/'" else url'

84 url' = "'"

86 url' = "'"

85− ++ urlPrefix opts

87+ <> urlPrefix opts

86− ++ urlArgs

88+ <> urlArgs

87− ++ queryArgs

89+ <> queryArgs

89 urlArgs = jsSegments

91 urlArgs = jsSegments

90 $ req ^.. reqUrl.path.traverse

92 $ req ^.. reqUrl.path.traverse

92 queryArgs = if null queryparams

94 queryArgs = if null queryparams

93 then ""

95 then ""

94− else " + '?" ++ jsParams queryparams

96+ else " + '?" <> jsParams queryparams

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

@@ -1,7 +1,9 @@

1+{-#LANGUAGE OverloadedStrings #-}

1module Servant.JS.Vanilla where

2module Servant.JS.Vanilla where

3import Control.Lens

4import Control.Lens

4−import Data.List

5+import Data.Text (Text)

6+import qualified Data.Text as T

5import Data.Monoid

7import Data.Monoid

6import Servant.Foreign

8import Servant.Foreign

7import Servant.JS.Internal

9import Servant.JS.Internal

@@ -10,20 +12,20 @@ import Servant.JS.Internal

10-- to your API, using /XMLHttpRequest/. Uses 'defCommonGeneratorOptions'

12-- to your API, using /XMLHttpRequest/. Uses 'defCommonGeneratorOptions'

11-- for the 'CommonGeneratorOptions'.

13-- for the 'CommonGeneratorOptions'.

12vanillaJS :: JavaScriptGenerator

14vanillaJS :: JavaScriptGenerator

13−vanillaJS = concatMap generateVanillaJS

15+vanillaJS = mconcat . map generateVanillaJS

15-- | Generate vanilla javascript functions to make AJAX requests

17-- | Generate vanilla javascript functions to make AJAX requests

16-- to your API, using /XMLHttpRequest/. Lets you specify your

18-- to your API, using /XMLHttpRequest/. Lets you specify your

17-- own options.

19-- own options.

18vanillaJSWith :: CommonGeneratorOptions -> JavaScriptGenerator

20vanillaJSWith :: CommonGeneratorOptions -> JavaScriptGenerator

19−vanillaJSWith opts = concatMap (generateVanillaJSWith opts)

21+vanillaJSWith opts = mconcat . map (generateVanillaJSWith opts)

21-- | js codegen using XmlHttpRequest using default generation options

23-- | js codegen using XmlHttpRequest using default generation options

22−generateVanillaJS :: AjaxReq -> String

24+generateVanillaJS :: AjaxReq -> Text

23generateVanillaJS = generateVanillaJSWith defCommonGeneratorOptions

25generateVanillaJS = generateVanillaJSWith defCommonGeneratorOptions

25-- | js codegen using XmlHttpRequest

27-- | js codegen using XmlHttpRequest

26−generateVanillaJSWith :: CommonGeneratorOptions -> AjaxReq -> String

28+generateVanillaJSWith :: CommonGeneratorOptions -> AjaxReq -> Text

27generateVanillaJSWith opts req = "\n" <>

29generateVanillaJSWith opts req = "\n" <>

28 fname <> " = function(" <> argsStr <> ")\n"

30 fname <> " = function(" <> argsStr <> ")\n"

29 <> "{\n"

31 <> "{\n"

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

43 <> " xhr.send(" <> dataBody <> ");\n"

45 <> " xhr.send(" <> dataBody <> ");\n"

44 <> "}\n"

46 <> "}\n"

46− where argsStr = intercalate ", " args

48+ where argsStr = T.intercalate ", " args

47 args = captures

49 args = captures

48 ++ map (view argName) queryparams

50 ++ map (view argName) queryparams

49 ++ body

51 ++ body

@@ -74,14 +76,14 @@ generateVanillaJSWith opts req = "\n" <>

74 reqheaders =

76 reqheaders =

75 if null hs

77 if null hs

76 then ""

78 then ""

77− else headersStr ++ "\n"

79+ else headersStr <> "\n"

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

81+ where headersStr = T.intercalate "\n" $ map headerStr hs

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

82+ headerStr header = " xhr.setRequestHeader(\"" <>

81− headerArgName header ++

83+ headerArgName header <>

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

84+ "\", " <> toJSHeader header <> ");"

84− namespace = if null (moduleName opts)

86+ namespace = if moduleName opts == ""

85 then "var "

87 then "var "

86 else (moduleName opts) <> "."

88 else (moduleName opts) <> "."

87 fname = namespace <> (functionNameBuilder opts $ req ^. funcName)

89 fname = namespace <> (functionNameBuilder opts $ req ^. funcName)

@@ -89,13 +91,13 @@ generateVanillaJSWith opts req = "\n" <>

89 method = req ^. reqMethod

91 method = req ^. reqMethod

90 url = if url' == "'" then "'/'" else url'

92 url = if url' == "'" then "'/'" else url'

91 url' = "'"

93 url' = "'"

92− ++ urlPrefix opts

94+ <> urlPrefix opts

93− ++ urlArgs

95+ <> urlArgs

94− ++ queryArgs

96+ <> queryArgs

96 urlArgs = jsSegments

98 urlArgs = jsSegments

97 $ req ^.. reqUrl.path.traverse

99 $ req ^.. reqUrl.path.traverse

100

99 queryArgs = if null queryparams

101 queryArgs = if null queryparams

100 then ""

102 then ""

101− else " + '?" ++ jsParams queryparams

103+ else " + '?" <> jsParams queryparams

servant-js/test/Servant/JSSpec.hs+43−27

@@ -1,16 +1,25 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE QuasiQuotes #-}

4{-# LANGUAGE QuasiQuotes #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE TypeFamilies #-}

6{-# LANGUAGE TypeFamilies #-}

6{-# LANGUAGE TypeOperators #-}

7{-# LANGUAGE TypeOperators #-}

8+{-# LANGUAGE OverloadedStrings #-}

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

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

8module Servant.JSSpec where

10module Servant.JSSpec where

10import Data.Either (isRight)

12import Data.Either (isRight)

13+#if !MIN_VERSION_base(4,8,0)

14+import Data.Monoid ((<>),mconcat)

15+#else

16+import Data.Monoid ((<>))

17+#endif

11import Data.Proxy

18import Data.Proxy

19+import Data.Text (Text)

20+import qualified Data.Text as T

12−import Language.ECMAScript3.Parser (parseFromString)

21+import Language.ECMAScript3.Parser (program, parse)

13−import Test.Hspec

22+import Test.Hspec hiding (shouldContain, shouldNotContain)

15import Servant.JS

24import Servant.JS

16import Servant.JS.Internal

25import Servant.JS.Internal

@@ -20,22 +29,22 @@ import qualified Servant.JS.JQuery as JQ

20import qualified Servant.JS.Vanilla as JS

29import qualified Servant.JS.Vanilla as JS

21import Servant.JSSpec.CustomHeaders

30import Servant.JSSpec.CustomHeaders

23−type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] String :> Post '[JSON] Bool

32+type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] Text :> Post '[JSON] Bool

24 :<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool

33 :<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool

26type TopLevelRawAPI = "something" :> Get '[JSON] Int

35type TopLevelRawAPI = "something" :> Get '[JSON] Int

27 :<|> Raw

36 :<|> Raw

29−type HeaderHandlingAPI = "something" :> Header "Foo" String

38+type HeaderHandlingAPI = "something" :> Header "Foo" Text

30 :> Get '[JSON] Int

39 :> Get '[JSON] Int

32−type CustomAuthAPI = "something" :> Authorization "Basic" String

41+type CustomAuthAPI = "something" :> Authorization "Basic" Text

33 :> Get '[JSON] Int

42 :> Get '[JSON] Int

35−type CustomHeaderAPI = "something" :> MyLovelyHorse String

44+type CustomHeaderAPI = "something" :> MyLovelyHorse Text

36 :> Get '[JSON] Int

45 :> Get '[JSON] Int

38−type CustomHeaderAPI2 = "something" :> WhatsForDinner String

47+type CustomHeaderAPI2 = "something" :> WhatsForDinner Text

39 :> Get '[JSON] Int

48 :> Get '[JSON] Int

41headerHandlingProxy :: Proxy HeaderHandlingAPI

50headerHandlingProxy :: Proxy HeaderHandlingAPI

@@ -81,12 +90,18 @@ spec = describe "Servant.JQuery" $ do

81 axiosSpec

90 axiosSpec

82 --angularSpec AngularCustom

91 --angularSpec AngularCustom

93+shouldContain :: Text -> Text -> Expectation

94+a `shouldContain` b = shouldSatisfy a (T.isInfixOf b)

95+

96+shouldNotContain :: Text -> Text -> Expectation

97+a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b)

98+

84axiosSpec :: Spec

99axiosSpec :: Spec

85axiosSpec = describe specLabel $ do

100axiosSpec = describe specLabel $ do

86 it "should add withCredentials when needed" $ do

101 it "should add withCredentials when needed" $ do

87 let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI)

102 let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI)

88 output jsText

103 output jsText

89− jsText `shouldContain` ("withCredentials: true")

104+ jsText `shouldContain` "withCredentials: true"

90 it "should add xsrfCookieName when needed" $ do

105 it "should add xsrfCookieName when needed" $ do

91 let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI)

106 let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI)

92 output jsText

107 output jsText

@@ -101,79 +116,80 @@ axiosSpec = describe specLabel $ do

101 withCredOpts = AX.defAxiosOptions { AX.withCredentials = True }

116 withCredOpts = AX.defAxiosOptions { AX.withCredentials = True }

102 cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" }

117 cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" }

103 headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" }

118 headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" }

104− genJS :: AxiosOptions -> [AjaxReq] -> String

119+ genJS :: AxiosOptions -> [AjaxReq] -> Text

105− genJS opts req = concatMap (AX.generateAxiosJS opts) req

120+ genJS opts req = mconcat . map (AX.generateAxiosJS opts) $ req

106

121

107angularSpec :: TestNames -> Spec

122angularSpec :: TestNames -> Spec

108angularSpec test = describe specLabel $ do

123angularSpec test = describe specLabel $ do

109 it "should implement a service globally" $ do

124 it "should implement a service globally" $ do

110 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)

125 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)

111 output jsText

126 output jsText

112− jsText `shouldContain` (".service('" ++ testName ++ "'")

127+ jsText `shouldContain` (".service('" <> testName <> "'")

113

128

114 it "should depend on $http service globally" $ do

129 it "should depend on $http service globally" $ do

115 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)

130 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)

116 output jsText

131 output jsText

117− jsText `shouldContain` ("('" ++ testName ++ "', function($http) {")

132+ jsText `shouldContain` ("('" <> testName <> "', function($http) {")

118

133

119 it "should not depend on $http service in handlers" $ do

134 it "should not depend on $http service in handlers" $ do

120 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)

135 let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)

121 output jsText

136 output jsText

122 jsText `shouldNotContain` "getsomething($http, "

137 jsText `shouldNotContain` "getsomething($http, "

123 where

138 where

124− specLabel = "AngularJS(" ++ (show test) ++ ")"

139+ specLabel = "AngularJS(" <> (show test) <> ")"

125 output _ = return ()

140 output _ = return ()

126 testName = "MyService"

141 testName = "MyService"

127 ngOpts = NG.defAngularOptions { NG.serviceName = testName }

142 ngOpts = NG.defAngularOptions { NG.serviceName = testName }

128 genJS req = NG.angularService ngOpts req

143 genJS req = NG.angularService ngOpts req

129

144

130−generateJSSpec :: TestNames -> (AjaxReq -> String) -> Spec

145+generateJSSpec :: TestNames -> (AjaxReq -> Text) -> Spec

131generateJSSpec n gen = describe specLabel $ do

146generateJSSpec n gen = describe specLabel $ do

147+ let parseFromText = parse program ""

132 it "should generate valid javascript" $ do

148 it "should generate valid javascript" $ do

133− let s = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen)

149+ let s = jsForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen)

134− parseFromString s `shouldSatisfy` isRight

150+ parseFromText s `shouldSatisfy` isRight

135

151

136 it "should use non-empty function names" $ do

152 it "should use non-empty function names" $ do

137 let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI)

153 let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI)

138 output $ genJS (topLevel "GET")

154 output $ genJS (topLevel "GET")

139− parseFromString (genJS $ topLevel "GET") `shouldSatisfy` isRight

155+ parseFromText (genJS $ topLevel "GET") `shouldSatisfy` isRight

140

156

141 it "should handle simple HTTP headers" $ do

157 it "should handle simple HTTP headers" $ do

142 let jsText = genJS $ javascript headerHandlingProxy

158 let jsText = genJS $ javascript headerHandlingProxy

143 output jsText

159 output jsText

144− parseFromString jsText `shouldSatisfy` isRight

160+ parseFromText jsText `shouldSatisfy` isRight

145 jsText `shouldContain` "headerFoo"

161 jsText `shouldContain` "headerFoo"

146 jsText `shouldContain` (header n "Foo" $ "headerFoo")

162 jsText `shouldContain` (header n "Foo" $ "headerFoo")

147

163

148 it "should handle complex HTTP headers" $ do

164 it "should handle complex HTTP headers" $ do

149 let jsText = genJS $ javascript customAuthProxy

165 let jsText = genJS $ javascript customAuthProxy

150 output jsText

166 output jsText

151− parseFromString jsText `shouldSatisfy` isRight

167+ parseFromText jsText `shouldSatisfy` isRight

152 jsText `shouldContain` "headerAuthorization"

168 jsText `shouldContain` "headerAuthorization"

153 jsText `shouldContain` (header n "Authorization" $ "\"Basic \" + headerAuthorization")

169 jsText `shouldContain` (header n "Authorization" $ "\"Basic \" + headerAuthorization")

154

170

155 it "should handle complex, custom HTTP headers" $ do

171 it "should handle complex, custom HTTP headers" $ do

156 let jsText = genJS $ javascript customHeaderProxy

172 let jsText = genJS $ javascript customHeaderProxy

157 output jsText

173 output jsText

158− parseFromString jsText `shouldSatisfy` isRight

174+ parseFromText jsText `shouldSatisfy` isRight

159 jsText `shouldContain` "headerXMyLovelyHorse"

175 jsText `shouldContain` "headerXMyLovelyHorse"

160 jsText `shouldContain` (header n "X-MyLovelyHorse" $ "\"I am good friends with \" + headerXMyLovelyHorse")

176 jsText `shouldContain` (header n "X-MyLovelyHorse" $ "\"I am good friends with \" + headerXMyLovelyHorse")

161

177

162 it "should handle complex, custom HTTP headers (template replacement)" $ do

178 it "should handle complex, custom HTTP headers (template replacement)" $ do

163 let jsText = genJS $ javascript customHeaderProxy2

179 let jsText = genJS $ javascript customHeaderProxy2

164 output jsText

180 output jsText

165− parseFromString jsText `shouldSatisfy` isRight

181+ parseFromText jsText `shouldSatisfy` isRight

166 jsText `shouldContain` "headerXWhatsForDinner"

182 jsText `shouldContain` "headerXWhatsForDinner"

167 jsText `shouldContain` (header n "X-WhatsForDinner" $ "\"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\"")

183 jsText `shouldContain` (header n "X-WhatsForDinner" $ "\"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\"")

168

184

169 it "can generate the whole javascript code string at once with jsForAPI" $ do

185 it "can generate the whole javascript code string at once with jsForAPI" $ do

170− let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen)

186+ let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen)

171− parseFromString jsStr `shouldSatisfy` isRight

187+ parseFromText jsStr `shouldSatisfy` isRight

172 where

188 where

173− specLabel = "generateJS(" ++ (show n) ++ ")"

189+ specLabel = "generateJS(" <> (show n) <> ")"

174 output _ = return ()

190 output _ = return ()

175 genJS req = gen req

191 genJS req = gen req

176− header :: TestNames -> String -> String -> String

192+ header :: TestNames -> Text -> Text -> Text

177 header v headerName headerValue

193 header v headerName headerValue

178− | v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" ++ headerName ++ "\", " ++ headerValue ++ ");\n"

194+ | v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" <> headerName <> "\", " <> headerValue <> ");\n"

179− | otherwise = "headers: { \"" ++ headerName ++ "\": " ++ headerValue ++ " }\n"

195+ | otherwise = "headers: { \"" <> headerName <> "\": " <> headerValue <> " }\n"

servant-js/test/Servant/JSSpec/CustomHeaders.hs+3−1

@@ -5,12 +5,14 @@

5{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE TypeFamilies #-}

7{-# LANGUAGE TypeOperators #-}

8+{-# LANGUAGE OverloadedStrings #-}

9module Servant.JSSpec.CustomHeaders where

10module Servant.JSSpec.CustomHeaders where

11import Control.Lens

12import Control.Lens

12import Data.Monoid

13import Data.Monoid

13import Data.Proxy

14import Data.Proxy

15+import Data.Text (pack)

14import GHC.TypeLits

16import GHC.TypeLits

15import Servant.JS.Internal

17import Servant.JS.Internal

@@ -25,7 +27,7 @@ instance (KnownSymbol sym, HasForeign sublayout)

26 foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $

28 foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $

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

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

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

30+ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]

29 where

31 where

30 tokenType t = t <> " {Authorization}"

32 tokenType t = t <> " {Authorization}"