eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Merge pull request #243 from arianvp/foreign-text

Browse source 
Change servant-js and servant-foreign to use text
This commit is contained in:
Julian Arni 2015-10-08 13:59:14 +01:00
commit 05623f54d4
13 changed files with 224 additions and 194 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-client/CHANGELOG.md
View file

@ -1,6 +1,7 @@
HEAD HEAD
---- ----
* Use the `text` package instead of `String`.
* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators * Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
* Added support for `path` on `BaseUrl`. * Added support for `path` on `BaseUrl`.
* `client` now takes an explicit `Manager` argument. * `client` now takes an explicit `Manager` argument.

9
servant-examples/tutorial/T9.hs
View file

@ -16,6 +16,7 @@ import Servant.JS
import System.Random import System.Random
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Language.Javascript.JQuery as JQ import qualified Language.Javascript.JQuery as JQ
data Point = Point data Point = Point
@ -91,14 +92,14 @@ server' :: Server API'
server' = server server' = server
:<|> serveDirectory "tutorial/t9" :<|> serveDirectory "tutorial/t9"
apiJS :: String apiJS :: Text
apiJS = jsForAPI api jquery apiJS = jsForAPI api jquery
writeJSFiles :: IO () writeJSFiles :: IO ()
writeJSFiles = do writeJSFiles = do
writeFile "tutorial/t9/api.js" apiJS TIO.writeFile "tutorial/t9/api.js" apiJS
jq <- readFile =<< JQ.file jq <- TIO.readFile =<< JQ.file
writeFile "tutorial/t9/jq.js" jq TIO.writeFile "tutorial/t9/jq.js" jq
app :: Application app :: Application
app = serve api' server' app = serve api' server'

4
servant-foreign/CHANGELOG.md
View file

@ -1,4 +1,4 @@
0.5 HEAD
----- -----
* Use the `text` package instead of `String`.
* Extract javascript-oblivious types and helpers to *servant-foreign* * Extract javascript-oblivious types and helpers to *servant-foreign*

3
servant-foreign/servant-foreign.cabal
View file

@ -29,6 +29,7 @@ library
build-depends: base == 4.* build-depends: base == 4.*
, lens == 4.* , lens == 4.*
, servant == 0.5.* , servant == 0.5.*
, text >= 1.2 && < 1.3
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall

55
servant-foreign/src/Servant/Foreign.hs
View file

@ -12,6 +12,7 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Generalizes all the data needed to make code generation work with -- | Generalizes all the data needed to make code generation work with
-- arbitrary programming languages. -- arbitrary programming languages.
@ -46,43 +47,39 @@ module Servant.Foreign
, module Servant.API , module Servant.API
) where ) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Lens (makeLenses, (%~), (&), (.~), import Control.Lens (makeLenses, (%~), (&), (.~),
(<>~), _last) (<>~), _last)
import Data.Char (toLower, toUpper) import Data.Monoid ((<>))
import Data.List import Data.Text
import Data.Proxy import Data.Proxy
import GHC.Exts (Constraint) import GHC.Exts (Constraint)
import GHC.TypeLits import GHC.TypeLits
import Servant.API import Servant.API
import Prelude hiding (concat)
-- | Function name builder that simply concat each part together -- | Function name builder that simply concat each part together
concatCase :: FunctionName -> String concatCase :: FunctionName -> Text
concatCase = concat concatCase = concat
-- | Function name builder using the snake_case convention. -- | Function name builder using the snake_case convention.
-- each part is separated by a single underscore character. -- each part is separated by a single underscore character.
snakeCase :: FunctionName -> String snakeCase :: FunctionName -> Text
snakeCase = intercalate "_" snakeCase = intercalate "_"
-- | Function name builder using the CamelCase convention. -- | Function name builder using the CamelCase convention.
-- each part begins with an upper case character. -- each part begins with an upper case character.
camelCase :: FunctionName -> String camelCase :: FunctionName -> Text
camelCase [] = "" camelCase [] = ""
camelCase (p:ps) = concat $ p : camelCase' ps camelCase (p:ps) = concat $ p : camelCase' ps
where camelCase' [] = [] where camelCase' [] = []
camelCase' (r:rs) = capitalize r : camelCase' rs camelCase' (r:rs) = toUpper r : camelCase' rs
capitalize [] = []
capitalize (x:xs) = toUpper x : xs
type Arg = String type Arg = Text
data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] } data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] }
deriving (Eq, Show) deriving (Eq, Show)
data SegmentType = Static String -- ^ a static path segment. like "/foo" data SegmentType = Static Text -- ^ a static path segment. like "/foo"
| Cap Arg -- ^ a capture. like "/:userid" | Cap Arg -- ^ a capture. like "/:userid"
deriving (Eq, Show) deriving (Eq, Show)
@ -100,11 +97,11 @@ data QueryArg = QueryArg
} deriving (Eq, Show) } deriving (Eq, Show)
data HeaderArg = HeaderArg data HeaderArg = HeaderArg
{ headerArgName :: String { headerArgName :: Text
} }
| ReplaceHeaderArg | ReplaceHeaderArg
{ headerArgName :: String { headerArgName :: Text
, headerPattern :: String , headerPattern :: Text
} deriving (Eq, Show) } deriving (Eq, Show)
@ -118,8 +115,8 @@ data Url = Url
defUrl :: Url defUrl :: Url
defUrl = Url [] [] defUrl = Url [] []
type FunctionName = [String] type FunctionName = [Text]
type Method = String type Method = Text
data Req = Req data Req = Req
{ _reqUrl :: Url { _reqUrl :: Url
@ -175,7 +172,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
req & reqUrl.path <>~ [Segment (Cap str) []] req & reqUrl.path <>~ [Segment (Cap str) []]
& funcName %~ (++ ["by", str]) & funcName %~ (++ ["by", str])
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance Elem JSON list => HasForeign (Delete list a) where instance Elem JSON list => HasForeign (Delete list a) where
type Foreign (Delete list a) = Req type Foreign (Delete list a) = Req
@ -198,7 +195,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor Proxy req = foreignFor Proxy req =
foreignFor subP (req & reqHeaders <>~ [HeaderArg hname]) foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])
where hname = symbolVal (Proxy :: Proxy sym) where hname = pack . symbolVal $ (Proxy :: Proxy sym)
subP = Proxy :: Proxy sublayout subP = Proxy :: Proxy sublayout
instance Elem JSON list => HasForeign (Post list a) where instance Elem JSON list => HasForeign (Post list a) where
@ -223,7 +220,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.queryStr <>~ [QueryArg str Normal] req & reqUrl.queryStr <>~ [QueryArg str Normal]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance (KnownSymbol sym, HasForeign sublayout) instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (QueryParams sym a :> sublayout) where => HasForeign (QueryParams sym a :> sublayout) where
@ -233,7 +230,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.queryStr <>~ [QueryArg str List] req & reqUrl.queryStr <>~ [QueryArg str List]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance (KnownSymbol sym, HasForeign sublayout) instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (QueryFlag sym :> sublayout) where => HasForeign (QueryFlag sym :> sublayout) where
@ -243,7 +240,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.queryStr <>~ [QueryArg str Flag] req & reqUrl.queryStr <>~ [QueryArg str Flag]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance (KnownSymbol sym, HasForeign sublayout) instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (MatrixParam sym a :> sublayout) where => HasForeign (MatrixParam sym a :> sublayout) where
@ -253,8 +250,8 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal] req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
strArg = str ++ "Value" strArg = str <> "Value"
instance (KnownSymbol sym, HasForeign sublayout) instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (MatrixParams sym a :> sublayout) where => HasForeign (MatrixParams sym a :> sublayout) where
@ -264,7 +261,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.path._last.matrix <>~ [QueryArg str List] req & reqUrl.path._last.matrix <>~ [QueryArg str List]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance (KnownSymbol sym, HasForeign sublayout) instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (MatrixFlag sym :> sublayout) where => HasForeign (MatrixFlag sym :> sublayout) where
@ -274,13 +271,13 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.path._last.matrix <>~ [QueryArg str Flag] req & reqUrl.path._last.matrix <>~ [QueryArg str Flag]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance HasForeign Raw where instance HasForeign Raw where
type Foreign Raw = Method -> Req type Foreign Raw = Method -> Req
foreignFor Proxy req method = foreignFor Proxy req method =
req & funcName %~ ((toLower <$> method) :) req & funcName %~ ((toLower method) :)
& reqMethod .~ method & reqMethod .~ method
instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where
@ -299,7 +296,7 @@ instance (KnownSymbol path, HasForeign sublayout)
req & reqUrl.path <>~ [Segment (Static str) []] req & reqUrl.path <>~ [Segment (Static str) []]
& funcName %~ (++ [str]) & funcName %~ (++ [str])
where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path) where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)
instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where
type Foreign (RemoteHost :> sublayout) = Foreign sublayout type Foreign (RemoteHost :> sublayout) = Foreign sublayout

9
servant-js/src/Servant/JS.hs
View file

@ -39,7 +39,7 @@
-- Let's keep it simple and produce vanilla Javascript code with the default options. -- Let's keep it simple and produce vanilla Javascript code with the default options.
-- --
-- @ -- @
-- jsCode :: String -- jsCode :: Text
-- jsCode = 'jsForAPI' api 'vanillaJS' -- jsCode = 'jsForAPI' api 'vanillaJS'
-- @ -- @
-- --
@ -60,7 +60,7 @@
-- All you need to do to use it is to use 'vanillaJSWith' and pass it @myOptions@. -- All you need to do to use it is to use 'vanillaJSWith' and pass it @myOptions@.
-- --
-- @ -- @
-- jsCodeWithMyOptions :: String -- jsCodeWithMyOptions :: Text
-- jsCodeWithMyOptions = 'jsForAPI' api ('vanillaJSWith' myOptions) -- jsCodeWithMyOptions = 'jsForAPI' api ('vanillaJSWith' myOptions)
-- @ -- @
-- --
@ -112,7 +112,10 @@ module Servant.JS
, GenerateList(..) , GenerateList(..)
) where ) where
import Prelude hiding (writeFile)
import Data.Proxy import Data.Proxy
import Data.Text
import Data.Text.IO (writeFile)
import Servant.JS.Angular import Servant.JS.Angular
import Servant.JS.Axios import Servant.JS.Axios
import Servant.JS.Internal import Servant.JS.Internal
@ -131,7 +134,7 @@ javascript p = foreignFor p defReq
jsForAPI :: (HasForeign api, GenerateList (Foreign api)) jsForAPI :: (HasForeign api, GenerateList (Foreign api))
=> Proxy api -- ^ proxy for your API type => Proxy api -- ^ proxy for your API type
-> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others) -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
-> String -- ^ a string that you can embed in your pages or write to a file -> Text -- ^ a text that you can embed in your pages or write to a file
jsForAPI p gen = gen (listFromAPI p) jsForAPI p gen = gen (listFromAPI p)
-- | Directly generate all the javascript functions for your API -- | Directly generate all the javascript functions for your API

46
servant-js/src/Servant/JS/Angular.hs
View file

@ -1,17 +1,19 @@
{-#LANGUAGE OverloadedStrings #-}
module Servant.JS.Angular where module Servant.JS.Angular where
import Control.Lens import Control.Lens
import Data.List
import Data.Monoid import Data.Monoid
import qualified Data.Text as T
import Data.Text (Text)
import Servant.Foreign import Servant.Foreign
import Servant.JS.Internal import Servant.JS.Internal
-- | Options specific to the angular code generator -- | Options specific to the angular code generator
data AngularOptions = AngularOptions data AngularOptions = AngularOptions
{ serviceName :: String -- ^ When generating code with wrapInService, { serviceName :: Text -- ^ When generating code with wrapInService,
-- name of the service to generate -- name of the service to generate
, prologue :: String -> String -> String -- ^ beginning of the service definition , prologue :: Text -> Text -> Text -- ^ beginning of the service definition
, epilogue :: String -- ^ end of the service definition , epilogue :: Text -- ^ end of the service definition
} }
-- | Default options for the Angular codegen. Used by 'wrapInService'. -- | Default options for the Angular codegen. Used by 'wrapInService'.
@ -34,12 +36,12 @@ angularService ngOpts = angularServiceWith ngOpts defCommonGeneratorOptions
angularServiceWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator angularServiceWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator
angularServiceWith ngOpts opts reqs = angularServiceWith ngOpts opts reqs =
prologue ngOpts svc mName prologue ngOpts svc mName
<> intercalate "," (map generator reqs) <> <> T.intercalate "," (map generator reqs) <>
epilogue ngOpts epilogue ngOpts
where where
generator req = generateAngularJSWith ngOpts opts req generator req = generateAngularJSWith ngOpts opts req
svc = serviceName ngOpts svc = serviceName ngOpts
mName = if null (moduleName opts) mName = if moduleName opts == ""
then "app." then "app."
else moduleName opts <> "." else moduleName opts <> "."
@ -50,14 +52,14 @@ angular ngopts = angularWith ngopts defCommonGeneratorOptions
-- | Generate regular javascript functions that use the $http service. -- | Generate regular javascript functions that use the $http service.
angularWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator angularWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator
angularWith ngopts opts = intercalate "\n\n" . map (generateAngularJSWith ngopts opts) angularWith ngopts opts = T.intercalate "\n\n" . map (generateAngularJSWith ngopts opts)
-- | js codegen using $http service from Angular using default options -- | js codegen using $http service from Angular using default options
generateAngularJS :: AngularOptions -> AjaxReq -> String generateAngularJS :: AngularOptions -> AjaxReq -> Text
generateAngularJS ngOpts = generateAngularJSWith ngOpts defCommonGeneratorOptions generateAngularJS ngOpts = generateAngularJSWith ngOpts defCommonGeneratorOptions
-- | js codegen using $http service from Angular -- | js codegen using $http service from Angular
generateAngularJSWith :: AngularOptions -> CommonGeneratorOptions -> AjaxReq -> String generateAngularJSWith :: AngularOptions -> CommonGeneratorOptions -> AjaxReq -> Text
generateAngularJSWith ngOptions opts req = "\n" <> generateAngularJSWith ngOptions opts req = "\n" <>
fname <> fsep <> " function(" <> argsStr <> ")\n" fname <> fsep <> " function(" <> argsStr <> ")\n"
<> "{\n" <> "{\n"
@ -69,7 +71,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
<> " });\n" <> " });\n"
<> "}\n" <> "}\n"
where argsStr = intercalate ", " args where argsStr = T.intercalate ", " args
args = http args = http
++ captures ++ captures
++ map (view argName) queryparams ++ map (view argName) queryparams
@ -79,7 +81,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
-- If we want to generate Top Level Function, they must depend on -- If we want to generate Top Level Function, they must depend on
-- the $http service, if we generate a service, the functions will -- the $http service, if we generate a service, the functions will
-- inherit this dependency from the service -- inherit this dependency from the service
http = case length (serviceName ngOptions) of http = case T.length (serviceName ngOptions) of
0 -> ["$http"] 0 -> ["$http"]
_ -> [] _ -> []
@ -104,12 +106,12 @@ generateAngularJSWith ngOptions opts req = "\n" <>
reqheaders = reqheaders =
if null hs if null hs
then "" then ""
else " , headers: { " ++ headersStr ++ " }\n" else " , headers: { " <> headersStr <> " }\n"
where headersStr = intercalate ", " $ map headerStr hs where headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" ++ headerStr header = "\"" <>
headerArgName header ++ headerArgName header <>
"\": " ++ toJSHeader header "\": " <> toJSHeader header
namespace = namespace =
if hasService if hasService
@ -118,9 +120,9 @@ generateAngularJSWith ngOptions opts req = "\n" <>
then "var " then "var "
else (moduleName opts) <> "." else (moduleName opts) <> "."
where where
hasNoModule = null (moduleName opts) hasNoModule = moduleName opts == ""
hasService = not $ null (serviceName ngOptions) hasService = serviceName ngOptions /= ""
fsep = if hasService then ":" else " =" fsep = if hasService then ":" else " ="
@ -129,13 +131,13 @@ generateAngularJSWith ngOptions opts req = "\n" <>
method = req ^. reqMethod method = req ^. reqMethod
url = if url' == "'" then "'/'" else url' url = if url' == "'" then "'/'" else url'
url' = "'" url' = "'"
++ urlPrefix opts <> urlPrefix opts
++ urlArgs <> urlArgs
++ queryArgs <> queryArgs
urlArgs = jsSegments urlArgs = jsSegments
$ req ^.. reqUrl.path.traverse $ req ^.. reqUrl.path.traverse
queryArgs = if null queryparams queryArgs = if null queryparams
then "" then ""
else " + '?" ++ jsParams queryparams else " + '?" <> jsParams queryparams

37
servant-js/src/Servant/JS/Axios.hs
View file

@ -1,9 +1,10 @@
{-#LANGUAGE OverloadedStrings #-}
module Servant.JS.Axios where module Servant.JS.Axios where
import Control.Lens import Control.Lens
import Data.Char (toLower)
import Data.List
import Data.Monoid import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import Servant.Foreign import Servant.Foreign
import Servant.JS.Internal import Servant.JS.Internal
@ -14,9 +15,9 @@ data AxiosOptions = AxiosOptions
-- should be made using credentials -- should be made using credentials
withCredentials :: !Bool withCredentials :: !Bool
-- | the name of the cookie to use as a value for xsrf token -- | the name of the cookie to use as a value for xsrf token
, xsrfCookieName :: !(Maybe String) , xsrfCookieName :: !(Maybe Text)
-- | the name of the header to use as a value for xsrf token -- | the name of the header to use as a value for xsrf token
, xsrfHeaderName :: !(Maybe String) , xsrfHeaderName :: !(Maybe Text)
} }
-- | Default instance of the AxiosOptions -- | Default instance of the AxiosOptions
@ -36,14 +37,14 @@ axios aopts = axiosWith aopts defCommonGeneratorOptions
-- | Generate regular javascript functions that use the axios library. -- | Generate regular javascript functions that use the axios library.
axiosWith :: AxiosOptions -> CommonGeneratorOptions -> JavaScriptGenerator axiosWith :: AxiosOptions -> CommonGeneratorOptions -> JavaScriptGenerator
axiosWith aopts opts = intercalate "\n\n" . map (generateAxiosJSWith aopts opts) axiosWith aopts opts = T.intercalate "\n\n" . map (generateAxiosJSWith aopts opts)
-- | js codegen using axios library using default options -- | js codegen using axios library using default options
generateAxiosJS :: AxiosOptions -> AjaxReq -> String generateAxiosJS :: AxiosOptions -> AjaxReq -> Text
generateAxiosJS aopts = generateAxiosJSWith aopts defCommonGeneratorOptions generateAxiosJS aopts = generateAxiosJSWith aopts defCommonGeneratorOptions
-- | js codegen using axios library -- | js codegen using axios library
generateAxiosJSWith :: AxiosOptions -> CommonGeneratorOptions -> AjaxReq -> String generateAxiosJSWith :: AxiosOptions -> CommonGeneratorOptions -> AjaxReq -> Text
generateAxiosJSWith aopts opts req = "\n" <> generateAxiosJSWith aopts opts req = "\n" <>
fname <> " = function(" <> argsStr <> ")\n" fname <> " = function(" <> argsStr <> ")\n"
<> "{\n" <> "{\n"
@ -57,7 +58,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
<> " });\n" <> " });\n"
<> "}\n" <> "}\n"
where argsStr = intercalate ", " args where argsStr = T.intercalate ", " args
args = captures args = captures
++ map (view argName) queryparams ++ map (view argName) queryparams
++ body ++ body
@ -101,30 +102,30 @@ generateAxiosJSWith aopts opts req = "\n" <>
then "" then ""
else " , headers: { " <> headersStr <> " }\n" else " , headers: { " <> headersStr <> " }\n"
where headersStr = intercalate ", " $ map headerStr hs where headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" ++ headerStr header = "\"" <>
headerArgName header ++ headerArgName header <>
"\": " ++ toJSHeader header "\": " <> toJSHeader header
namespace = namespace =
if hasNoModule if hasNoModule
then "var " then "var "
else (moduleName opts) <> "." else (moduleName opts) <> "."
where where
hasNoModule = null (moduleName opts) hasNoModule = moduleName opts == ""
fname = namespace <> (functionNameBuilder opts $ req ^. funcName) fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
method = map toLower $ req ^. reqMethod method = T.toLower $ req ^. reqMethod
url = if url' == "'" then "'/'" else url' url = if url' == "'" then "'/'" else url'
url' = "'" url' = "'"
++ urlPrefix opts <> urlPrefix opts
++ urlArgs <> urlArgs
++ queryArgs <> queryArgs
urlArgs = jsSegments urlArgs = jsSegments
$ req ^.. reqUrl.path.traverse $ req ^.. reqUrl.path.traverse
queryArgs = if null queryparams queryArgs = if null queryparams
then "" then ""
else " + '?" ++ jsParams queryparams else " + '?" <> jsParams queryparams

112
servant-js/src/Servant/JS/Internal.hs
View file

@ -1,3 +1,4 @@
{-#LANGUAGE OverloadedStrings #-}
module Servant.JS.Internal module Servant.JS.Internal
( JavaScriptGenerator ( JavaScriptGenerator
, CommonGeneratorOptions(..) , CommonGeneratorOptions(..)
@ -34,28 +35,28 @@ module Servant.JS.Internal
import Control.Lens ((^.)) import Control.Lens ((^.))
import qualified Data.CharSet as Set import qualified Data.CharSet as Set
import qualified Data.CharSet.Unicode.Category as Set import qualified Data.CharSet.Unicode.Category as Set
import Data.List
import Data.Monoid import Data.Monoid
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text (Text)
import Servant.Foreign import Servant.Foreign
type AjaxReq = Req type AjaxReq = Req
-- A 'JavascriptGenerator' just takes the data found in the API type -- A 'JavascriptGenerator' just takes the data found in the API type
-- for each endpoint and generates Javascript code in a String. Several -- for each endpoint and generates Javascript code in a Text. Several
-- generators are available in this package. -- generators are available in this package.
type JavaScriptGenerator = [Req] -> String type JavaScriptGenerator = [Req] -> Text
-- | This structure is used by specific implementations to let you -- | This structure is used by specific implementations to let you
-- customize the output -- customize the output
data CommonGeneratorOptions = CommonGeneratorOptions data CommonGeneratorOptions = CommonGeneratorOptions
{ {
functionNameBuilder :: FunctionName -> String -- ^ function generating function names functionNameBuilder :: FunctionName -> Text -- ^ function generating function names
, requestBody :: String -- ^ name used when a user want to send the request body (to let you redefine it) , requestBody :: Text -- ^ name used when a user want to send the request body (to let you redefine it)
, successCallback :: String -- ^ name of the callback parameter when the request was successful , successCallback :: Text -- ^ name of the callback parameter when the request was successful
, errorCallback :: String -- ^ name of the callback parameter when the request reported an error , errorCallback :: Text -- ^ name of the callback parameter when the request reported an error
, moduleName :: String -- ^ namespace on which we define the foreign function (empty mean local var) , moduleName :: Text -- ^ namespace on which we define the foreign function (empty mean local var)
, urlPrefix :: String -- ^ a prefix we should add to the Url in the codegen , urlPrefix :: Text -- ^ a prefix we should add to the Url in the codegen
} }
-- | Default options. -- | Default options.
@ -87,80 +88,81 @@ defCommonGeneratorOptions = CommonGeneratorOptions
-- Couldn't work out how to handle zero-width characters. -- Couldn't work out how to handle zero-width characters.
-- --
-- @TODO: specify better default function name, or throw error? -- @TODO: specify better default function name, or throw error?
toValidFunctionName :: String -> String toValidFunctionName :: Text -> Text
toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs toValidFunctionName t =
case T.uncons t of
Just (x,xs) ->
setFirstChar x `T.cons` T.filter remainder xs
Nothing -> "_"
where where
setFirstChar c = if firstChar c then c else '_' setFirstChar c = if firstChar c then c else '_'
firstChar c = prefixOK c || any (Set.member c) firstLetterOK firstChar c = prefixOK c || Set.member c firstLetterOK
remainder c = prefixOK c || any (Set.member c) remainderOK remainder c = prefixOK c || Set.member c remainderOK
-- Valid prefixes
prefixOK c = c `elem` ['$','_'] prefixOK c = c `elem` ['$','_']
-- Unicode character sets firstLetterOK = mconcat
firstLetterOK = [ Set.lowercaseLetter [ Set.lowercaseLetter
, Set.uppercaseLetter , Set.uppercaseLetter
, Set.titlecaseLetter , Set.titlecaseLetter
, Set.modifierLetter , Set.modifierLetter
, Set.otherLetter , Set.otherLetter
, Set.letterNumber ] , Set.letterNumber
]
remainderOK = firstLetterOK remainderOK = firstLetterOK
<> [ Set.nonSpacingMark <> mconcat
, Set.spacingCombiningMark [ Set.nonSpacingMark
, Set.decimalNumber , Set.spacingCombiningMark
, Set.connectorPunctuation ] , Set.decimalNumber
toValidFunctionName [] = "_" , Set.connectorPunctuation
]
toJSHeader :: HeaderArg -> String toJSHeader :: HeaderArg -> Text
toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n) toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n)
toJSHeader (ReplaceHeaderArg n p) toJSHeader (ReplaceHeaderArg n p)
| pn `isPrefixOf` p = pv <> " + \"" <> rp <> "\"" | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
| pn `isSuffixOf` p = "\"" <> rp <> "\" + " <> pv | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
| pn `isInfixOf` p = "\"" <> (replace pn ("\" + " <> pv <> " + \"") p) | pn `T.isInfixOf` p = "\"" <> (T.replace pn ("\" + " <> pv <> " + \"") p)
<> "\"" <> "\""
| otherwise = p | otherwise = p
where where
pv = toValidFunctionName ("header" <> n) pv = toValidFunctionName ("header" <> n)
pn = "{" <> n <> "}" pn = "{" <> n <> "}"
rp = replace pn "" p rp = T.replace pn "" p
-- Use replace method from Data.Text
replace old new = T.unpack
. T.replace (T.pack old) (T.pack new)
. T.pack
jsSegments :: [Segment] -> String jsSegments :: [Segment] -> Text
jsSegments [] = "" jsSegments [] = ""
jsSegments [x] = "/" ++ segmentToStr x False jsSegments [x] = "/" <> segmentToStr x False
jsSegments (x:xs) = "/" ++ segmentToStr x True ++ jsSegments xs jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs
segmentToStr :: Segment -> Bool -> String segmentToStr :: Segment -> Bool -> Text
segmentToStr (Segment st ms) notTheEnd = segmentToStr (Segment st ms) notTheEnd =
segmentTypeToStr st ++ jsMParams ms ++ if notTheEnd then "" else "'" segmentTypeToStr st <> jsMParams ms <> if notTheEnd then "" else "'"
segmentTypeToStr :: SegmentType -> String segmentTypeToStr :: SegmentType -> Text
segmentTypeToStr (Static s) = s segmentTypeToStr (Static s) = s
segmentTypeToStr (Cap s) = "' + encodeURIComponent(" ++ s ++ ") + '" segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> s <> ") + '"
jsGParams :: String -> [QueryArg] -> String jsGParams :: Text -> [QueryArg] -> Text
jsGParams _ [] = "" jsGParams _ [] = ""
jsGParams _ [x] = paramToStr x False jsGParams _ [x] = paramToStr x False
jsGParams s (x:xs) = paramToStr x True ++ s ++ jsGParams s xs jsGParams s (x:xs) = paramToStr x True <> s <> jsGParams s xs
jsParams :: [QueryArg] -> String jsParams :: [QueryArg] -> Text
jsParams = jsGParams "&" jsParams = jsGParams "&"
jsMParams :: [MatrixArg] -> String jsMParams :: [MatrixArg] -> Text
jsMParams [] = "" jsMParams [] = ""
jsMParams xs = ";" ++ jsGParams ";" xs jsMParams xs = ";" <> jsGParams ";" xs
paramToStr :: QueryArg -> Bool -> String paramToStr :: QueryArg -> Bool -> Text
paramToStr qarg notTheEnd = paramToStr qarg notTheEnd =
case qarg ^. argType of case qarg ^. argType of
Normal -> name Normal -> name
++ "=' + encodeURIComponent(" <> "=' + encodeURIComponent("
++ name <> name
++ if notTheEnd then ") + '" else ")" <> if notTheEnd then ") + '" else ")"
Flag -> name ++ "=" Flag -> name <> "="
List -> name List -> name
++ "[]=' + encodeURIComponent(" <> "[]=' + encodeURIComponent("
++ name <> name
++ if notTheEnd then ") + '" else ")" <> if notTheEnd then ") + '" else ")"
where name = qarg ^. argName where name = qarg ^. argName

34
servant-js/src/Servant/JS/JQuery.hs
View file

@ -1,8 +1,10 @@
{-#LANGUAGE OverloadedStrings #-}
module Servant.JS.JQuery where module Servant.JS.JQuery where
import Control.Lens import Control.Lens
import Data.List
import Data.Monoid import Data.Monoid
import qualified Data.Text as T
import Data.Text (Text)
import Servant.Foreign import Servant.Foreign
import Servant.JS.Internal import Servant.JS.Internal
@ -10,19 +12,19 @@ import Servant.JS.Internal
-- to make the AJAX calls. Uses 'defCommonGeneratorOptions' -- to make the AJAX calls. Uses 'defCommonGeneratorOptions'
-- for the generator options. -- for the generator options.
jquery :: JavaScriptGenerator jquery :: JavaScriptGenerator
jquery = concatMap generateJQueryJS jquery = mconcat . map generateJQueryJS
-- | Generate javascript functions that use the /jQuery/ library -- | Generate javascript functions that use the /jQuery/ library
-- to make the AJAX calls. Lets you specify your own 'CommonGeneratorOptions'. -- to make the AJAX calls. Lets you specify your own 'CommonGeneratorOptions'.
jqueryWith :: CommonGeneratorOptions -> JavaScriptGenerator jqueryWith :: CommonGeneratorOptions -> JavaScriptGenerator
jqueryWith opts = concatMap (generateJQueryJSWith opts) jqueryWith opts = mconcat . map (generateJQueryJSWith opts)
-- | js codegen using JQuery using default options -- | js codegen using JQuery using default options
generateJQueryJS :: AjaxReq -> String generateJQueryJS :: AjaxReq -> Text
generateJQueryJS = generateJQueryJSWith defCommonGeneratorOptions generateJQueryJS = generateJQueryJSWith defCommonGeneratorOptions
-- | js codegen using JQuery -- | js codegen using JQuery
generateJQueryJSWith :: CommonGeneratorOptions -> AjaxReq -> String generateJQueryJSWith :: CommonGeneratorOptions -> AjaxReq -> Text
generateJQueryJSWith opts req = "\n" <> generateJQueryJSWith opts req = "\n" <>
fname <> " = function(" <> argsStr <> ")\n" fname <> " = function(" <> argsStr <> ")\n"
<> "{\n" <> "{\n"
@ -36,7 +38,7 @@ generateJQueryJSWith opts req = "\n" <>
<> " });\n" <> " });\n"
<> "}\n" <> "}\n"
where argsStr = intercalate ", " args where argsStr = T.intercalate ", " args
args = captures args = captures
++ map (view argName) queryparams ++ map (view argName) queryparams
++ body ++ body
@ -67,14 +69,14 @@ generateJQueryJSWith opts req = "\n" <>
reqheaders = reqheaders =
if null hs if null hs
then "" then ""
else " , headers: { " ++ headersStr ++ " }\n" else " , headers: { " <> headersStr <> " }\n"
where headersStr = intercalate ", " $ map headerStr hs where headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" ++ headerStr header = "\"" <>
headerArgName header ++ headerArgName header <>
"\": " ++ toJSHeader header "\": " <> toJSHeader header
namespace = if null (moduleName opts) namespace = if (moduleName opts) == ""
then "var " then "var "
else (moduleName opts) <> "." else (moduleName opts) <> "."
fname = namespace <> (functionNameBuilder opts $ req ^. funcName) fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
@ -82,13 +84,13 @@ generateJQueryJSWith opts req = "\n" <>
method = req ^. reqMethod method = req ^. reqMethod
url = if url' == "'" then "'/'" else url' url = if url' == "'" then "'/'" else url'
url' = "'" url' = "'"
++ urlPrefix opts <> urlPrefix opts
++ urlArgs <> urlArgs
++ queryArgs <> queryArgs
urlArgs = jsSegments urlArgs = jsSegments
$ req ^.. reqUrl.path.traverse $ req ^.. reqUrl.path.traverse
queryArgs = if null queryparams queryArgs = if null queryparams
then "" then ""
else " + '?" ++ jsParams queryparams else " + '?" <> jsParams queryparams

34
servant-js/src/Servant/JS/Vanilla.hs
View file

@ -1,7 +1,9 @@
{-#LANGUAGE OverloadedStrings #-}
module Servant.JS.Vanilla where module Servant.JS.Vanilla where
import Control.Lens import Control.Lens
import Data.List import Data.Text (Text)
import qualified Data.Text as T
import Data.Monoid import Data.Monoid
import Servant.Foreign import Servant.Foreign
import Servant.JS.Internal import Servant.JS.Internal
@ -10,20 +12,20 @@ import Servant.JS.Internal
-- to your API, using /XMLHttpRequest/. Uses 'defCommonGeneratorOptions' -- to your API, using /XMLHttpRequest/. Uses 'defCommonGeneratorOptions'
-- for the 'CommonGeneratorOptions'. -- for the 'CommonGeneratorOptions'.
vanillaJS :: JavaScriptGenerator vanillaJS :: JavaScriptGenerator
vanillaJS = concatMap generateVanillaJS vanillaJS = mconcat . map generateVanillaJS
-- | Generate vanilla javascript functions to make AJAX requests -- | Generate vanilla javascript functions to make AJAX requests
-- to your API, using /XMLHttpRequest/. Lets you specify your -- to your API, using /XMLHttpRequest/. Lets you specify your
-- own options. -- own options.
vanillaJSWith :: CommonGeneratorOptions -> JavaScriptGenerator vanillaJSWith :: CommonGeneratorOptions -> JavaScriptGenerator
vanillaJSWith opts = concatMap (generateVanillaJSWith opts) vanillaJSWith opts = mconcat . map (generateVanillaJSWith opts)
-- | js codegen using XmlHttpRequest using default generation options -- | js codegen using XmlHttpRequest using default generation options
generateVanillaJS :: AjaxReq -> String generateVanillaJS :: AjaxReq -> Text
generateVanillaJS = generateVanillaJSWith defCommonGeneratorOptions generateVanillaJS = generateVanillaJSWith defCommonGeneratorOptions
-- | js codegen using XmlHttpRequest -- | js codegen using XmlHttpRequest
generateVanillaJSWith :: CommonGeneratorOptions -> AjaxReq -> String generateVanillaJSWith :: CommonGeneratorOptions -> AjaxReq -> Text
generateVanillaJSWith opts req = "\n" <> generateVanillaJSWith opts req = "\n" <>
fname <> " = function(" <> argsStr <> ")\n" fname <> " = function(" <> argsStr <> ")\n"
<> "{\n" <> "{\n"
@ -43,7 +45,7 @@ generateVanillaJSWith opts req = "\n" <>
<> " xhr.send(" <> dataBody <> ");\n" <> " xhr.send(" <> dataBody <> ");\n"
<> "}\n" <> "}\n"
where argsStr = intercalate ", " args where argsStr = T.intercalate ", " args
args = captures args = captures
++ map (view argName) queryparams ++ map (view argName) queryparams
++ body ++ body
@ -74,14 +76,14 @@ generateVanillaJSWith opts req = "\n" <>
reqheaders = reqheaders =
if null hs if null hs
then "" then ""
else headersStr ++ "\n" else headersStr <> "\n"
where headersStr = intercalate "\n" $ map headerStr hs where headersStr = T.intercalate "\n" $ map headerStr hs
headerStr header = " xhr.setRequestHeader(\"" ++ headerStr header = " xhr.setRequestHeader(\"" <>
headerArgName header ++ headerArgName header <>
"\", " ++ toJSHeader header ++ ");" "\", " <> toJSHeader header <> ");"
namespace = if null (moduleName opts) namespace = if moduleName opts == ""
then "var " then "var "
else (moduleName opts) <> "." else (moduleName opts) <> "."
fname = namespace <> (functionNameBuilder opts $ req ^. funcName) fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
@ -89,13 +91,13 @@ generateVanillaJSWith opts req = "\n" <>
method = req ^. reqMethod method = req ^. reqMethod
url = if url' == "'" then "'/'" else url' url = if url' == "'" then "'/'" else url'
url' = "'" url' = "'"
++ urlPrefix opts <> urlPrefix opts
++ urlArgs <> urlArgs
++ queryArgs <> queryArgs
urlArgs = jsSegments urlArgs = jsSegments
$ req ^.. reqUrl.path.traverse $ req ^.. reqUrl.path.traverse
queryArgs = if null queryparams queryArgs = if null queryparams
then "" then ""
else " + '?" ++ jsParams queryparams else " + '?" <> jsParams queryparams

70
servant-js/test/Servant/JSSpec.hs
View file

@ -1,16 +1,25 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.JSSpec where module Servant.JSSpec where
import Data.Either (isRight) import Data.Either (isRight)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid ((<>),mconcat)
#else
import Data.Monoid ((<>))
#endif
import Data.Proxy import Data.Proxy
import Language.ECMAScript3.Parser (parseFromString) import Data.Text (Text)
import Test.Hspec import qualified Data.Text as T
import Language.ECMAScript3.Parser (program, parse)
import Test.Hspec hiding (shouldContain, shouldNotContain)
import Servant.JS import Servant.JS
import Servant.JS.Internal import Servant.JS.Internal
@ -20,22 +29,22 @@ import qualified Servant.JS.JQuery as JQ
import qualified Servant.JS.Vanilla as JS import qualified Servant.JS.Vanilla as JS
import Servant.JSSpec.CustomHeaders import Servant.JSSpec.CustomHeaders
type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] String :> Post '[JSON] Bool type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] Text :> Post '[JSON] Bool
:<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool :<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool
type TopLevelRawAPI = "something" :> Get '[JSON] Int type TopLevelRawAPI = "something" :> Get '[JSON] Int
:<|> Raw :<|> Raw
type HeaderHandlingAPI = "something" :> Header "Foo" String type HeaderHandlingAPI = "something" :> Header "Foo" Text
:> Get '[JSON] Int :> Get '[JSON] Int
type CustomAuthAPI = "something" :> Authorization "Basic" String type CustomAuthAPI = "something" :> Authorization "Basic" Text
:> Get '[JSON] Int :> Get '[JSON] Int
type CustomHeaderAPI = "something" :> MyLovelyHorse String type CustomHeaderAPI = "something" :> MyLovelyHorse Text
:> Get '[JSON] Int :> Get '[JSON] Int
type CustomHeaderAPI2 = "something" :> WhatsForDinner String type CustomHeaderAPI2 = "something" :> WhatsForDinner Text
:> Get '[JSON] Int :> Get '[JSON] Int
headerHandlingProxy :: Proxy HeaderHandlingAPI headerHandlingProxy :: Proxy HeaderHandlingAPI
@ -81,12 +90,18 @@ spec = describe "Servant.JQuery" $ do
axiosSpec axiosSpec
--angularSpec AngularCustom --angularSpec AngularCustom
shouldContain :: Text -> Text -> Expectation
a `shouldContain` b = shouldSatisfy a (T.isInfixOf b)
shouldNotContain :: Text -> Text -> Expectation
a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b)
axiosSpec :: Spec axiosSpec :: Spec
axiosSpec = describe specLabel $ do axiosSpec = describe specLabel $ do
it "should add withCredentials when needed" $ do it "should add withCredentials when needed" $ do
let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
jsText `shouldContain` ("withCredentials: true") jsText `shouldContain` "withCredentials: true"
it "should add xsrfCookieName when needed" $ do it "should add xsrfCookieName when needed" $ do
let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
@ -101,79 +116,80 @@ axiosSpec = describe specLabel $ do
withCredOpts = AX.defAxiosOptions { AX.withCredentials = True } withCredOpts = AX.defAxiosOptions { AX.withCredentials = True }
cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" } cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" }
headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" } headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" }
genJS :: AxiosOptions -> [AjaxReq] -> String genJS :: AxiosOptions -> [AjaxReq] -> Text
genJS opts req = concatMap (AX.generateAxiosJS opts) req genJS opts req = mconcat . map (AX.generateAxiosJS opts) $ req
angularSpec :: TestNames -> Spec angularSpec :: TestNames -> Spec
angularSpec test = describe specLabel $ do angularSpec test = describe specLabel $ do
it "should implement a service globally" $ do it "should implement a service globally" $ do
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
jsText `shouldContain` (".service('" ++ testName ++ "'") jsText `shouldContain` (".service('" <> testName <> "'")
it "should depend on $http service globally" $ do it "should depend on $http service globally" $ do
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
jsText `shouldContain` ("('" ++ testName ++ "', function($http) {") jsText `shouldContain` ("('" <> testName <> "', function($http) {")
it "should not depend on $http service in handlers" $ do it "should not depend on $http service in handlers" $ do
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
jsText `shouldNotContain` "getsomething($http, " jsText `shouldNotContain` "getsomething($http, "
where where
specLabel = "AngularJS(" ++ (show test) ++ ")" specLabel = "AngularJS(" <> (show test) <> ")"
output _ = return () output _ = return ()
testName = "MyService" testName = "MyService"
ngOpts = NG.defAngularOptions { NG.serviceName = testName } ngOpts = NG.defAngularOptions { NG.serviceName = testName }
genJS req = NG.angularService ngOpts req genJS req = NG.angularService ngOpts req
generateJSSpec :: TestNames -> (AjaxReq -> String) -> Spec generateJSSpec :: TestNames -> (AjaxReq -> Text) -> Spec
generateJSSpec n gen = describe specLabel $ do generateJSSpec n gen = describe specLabel $ do
let parseFromText = parse program ""
it "should generate valid javascript" $ do it "should generate valid javascript" $ do
let s = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen) let s = jsForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen)
parseFromString s `shouldSatisfy` isRight parseFromText s `shouldSatisfy` isRight
it "should use non-empty function names" $ do it "should use non-empty function names" $ do
let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI) let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI)
output $ genJS (topLevel "GET") output $ genJS (topLevel "GET")
parseFromString (genJS $ topLevel "GET") `shouldSatisfy` isRight parseFromText (genJS $ topLevel "GET") `shouldSatisfy` isRight
it "should handle simple HTTP headers" $ do it "should handle simple HTTP headers" $ do
let jsText = genJS $ javascript headerHandlingProxy let jsText = genJS $ javascript headerHandlingProxy
output jsText output jsText
parseFromString jsText `shouldSatisfy` isRight parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerFoo" jsText `shouldContain` "headerFoo"
jsText `shouldContain` (header n "Foo" $ "headerFoo") jsText `shouldContain` (header n "Foo" $ "headerFoo")
it "should handle complex HTTP headers" $ do it "should handle complex HTTP headers" $ do
let jsText = genJS $ javascript customAuthProxy let jsText = genJS $ javascript customAuthProxy
output jsText output jsText
parseFromString jsText `shouldSatisfy` isRight parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerAuthorization" jsText `shouldContain` "headerAuthorization"
jsText `shouldContain` (header n "Authorization" $ "\"Basic \" + headerAuthorization") jsText `shouldContain` (header n "Authorization" $ "\"Basic \" + headerAuthorization")
it "should handle complex, custom HTTP headers" $ do it "should handle complex, custom HTTP headers" $ do
let jsText = genJS $ javascript customHeaderProxy let jsText = genJS $ javascript customHeaderProxy
output jsText output jsText
parseFromString jsText `shouldSatisfy` isRight parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerXMyLovelyHorse" jsText `shouldContain` "headerXMyLovelyHorse"
jsText `shouldContain` (header n "X-MyLovelyHorse" $ "\"I am good friends with \" + headerXMyLovelyHorse") jsText `shouldContain` (header n "X-MyLovelyHorse" $ "\"I am good friends with \" + headerXMyLovelyHorse")
it "should handle complex, custom HTTP headers (template replacement)" $ do it "should handle complex, custom HTTP headers (template replacement)" $ do
let jsText = genJS $ javascript customHeaderProxy2 let jsText = genJS $ javascript customHeaderProxy2
output jsText output jsText
parseFromString jsText `shouldSatisfy` isRight parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerXWhatsForDinner" jsText `shouldContain` "headerXWhatsForDinner"
jsText `shouldContain` (header n "X-WhatsForDinner" $ "\"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\"") jsText `shouldContain` (header n "X-WhatsForDinner" $ "\"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\"")
it "can generate the whole javascript code string at once with jsForAPI" $ do it "can generate the whole javascript code string at once with jsForAPI" $ do
let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen) let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen)
parseFromString jsStr `shouldSatisfy` isRight parseFromText jsStr `shouldSatisfy` isRight
where where
specLabel = "generateJS(" ++ (show n) ++ ")" specLabel = "generateJS(" <> (show n) <> ")"
output _ = return () output _ = return ()
genJS req = gen req genJS req = gen req
header :: TestNames -> String -> String -> String header :: TestNames -> Text -> Text -> Text
header v headerName headerValue header v headerName headerValue
| v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" ++ headerName ++ "\", " ++ headerValue ++ ");\n" | v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" <> headerName <> "\", " <> headerValue <> ");\n"
| otherwise = "headers: { \"" ++ headerName ++ "\": " ++ headerValue ++ " }\n" | otherwise = "headers: { \"" <> headerName <> "\": " <> headerValue <> " }\n"

4
servant-js/test/Servant/JSSpec/CustomHeaders.hs
View file

@ -5,12 +5,14 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
module Servant.JSSpec.CustomHeaders where module Servant.JSSpec.CustomHeaders where
import Control.Lens import Control.Lens
import Data.Monoid import Data.Monoid
import Data.Proxy import Data.Proxy
import Data.Text (pack)
import GHC.TypeLits import GHC.TypeLits
import Servant.JS.Internal import Servant.JS.Internal
@ -25,7 +27,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $ req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $
tokenType (symbolVal (Proxy :: Proxy sym)) ] tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
where where
tokenType t = t <> " {Authorization}" tokenType t = t <> " {Authorization}"