diff --git a/servant-client/CHANGELOG.md b/servant-client/CHANGELOG.md index 29398d95..db300550 100644 --- a/servant-client/CHANGELOG.md +++ b/servant-client/CHANGELOG.md @@ -1,6 +1,7 @@ HEAD ---- +* Use the `text` package instead of `String`. * Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators * Added support for `path` on `BaseUrl`. * `client` now takes an explicit `Manager` argument. diff --git a/servant-examples/tutorial/T9.hs b/servant-examples/tutorial/T9.hs index 365f6e54..75dd0630 100644 --- a/servant-examples/tutorial/T9.hs +++ b/servant-examples/tutorial/T9.hs @@ -16,6 +16,7 @@ import Servant.JS import System.Random import qualified Data.Text as T +import qualified Data.Text.IO as TIO import qualified Language.Javascript.JQuery as JQ data Point = Point @@ -91,14 +92,14 @@ server' :: Server API' server' = server :<|> serveDirectory "tutorial/t9" -apiJS :: String +apiJS :: Text apiJS = jsForAPI api jquery writeJSFiles :: IO () writeJSFiles = do - writeFile "tutorial/t9/api.js" apiJS - jq <- readFile =<< JQ.file - writeFile "tutorial/t9/jq.js" jq + TIO.writeFile "tutorial/t9/api.js" apiJS + jq <- TIO.readFile =<< JQ.file + TIO.writeFile "tutorial/t9/jq.js" jq app :: Application app = serve api' server' diff --git a/servant-foreign/CHANGELOG.md b/servant-foreign/CHANGELOG.md index 9dd05965..5d242065 100644 --- a/servant-foreign/CHANGELOG.md +++ b/servant-foreign/CHANGELOG.md @@ -1,4 +1,4 @@ -0.5 +HEAD ----- - +* Use the `text` package instead of `String`. * Extract javascript-oblivious types and helpers to *servant-foreign* diff --git a/servant-foreign/servant-foreign.cabal b/servant-foreign/servant-foreign.cabal index 90ebe8bb..293d75fc 100644 --- a/servant-foreign/servant-foreign.cabal +++ b/servant-foreign/servant-foreign.cabal @@ -29,6 +29,7 @@ library build-depends: base == 4.* , lens == 4.* , servant == 0.5.* + , text >= 1.2 && < 1.3 hs-source-dirs: src default-language: Haskell2010 - ghc-options: -Wall \ No newline at end of file + ghc-options: -Wall diff --git a/servant-foreign/src/Servant/Foreign.hs b/servant-foreign/src/Servant/Foreign.hs index 6cd72b84..d5ea0e29 100644 --- a/servant-foreign/src/Servant/Foreign.hs +++ b/servant-foreign/src/Servant/Foreign.hs @@ -12,6 +12,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE OverloadedStrings #-} -- | Generalizes all the data needed to make code generation work with -- arbitrary programming languages. @@ -46,43 +47,39 @@ module Servant.Foreign , module Servant.API ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif import Control.Lens (makeLenses, (%~), (&), (.~), (<>~), _last) -import Data.Char (toLower, toUpper) -import Data.List +import Data.Monoid ((<>)) +import Data.Text import Data.Proxy import GHC.Exts (Constraint) import GHC.TypeLits import Servant.API +import Prelude hiding (concat) -- | Function name builder that simply concat each part together -concatCase :: FunctionName -> String +concatCase :: FunctionName -> Text concatCase = concat -- | Function name builder using the snake_case convention. -- each part is separated by a single underscore character. -snakeCase :: FunctionName -> String +snakeCase :: FunctionName -> Text snakeCase = intercalate "_" -- | Function name builder using the CamelCase convention. -- each part begins with an upper case character. -camelCase :: FunctionName -> String +camelCase :: FunctionName -> Text camelCase [] = "" camelCase (p:ps) = concat $ p : camelCase' ps where camelCase' [] = [] - camelCase' (r:rs) = capitalize r : camelCase' rs - capitalize [] = [] - capitalize (x:xs) = toUpper x : xs + camelCase' (r:rs) = toUpper r : camelCase' rs -type Arg = String +type Arg = Text data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] } 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" deriving (Eq, Show) @@ -100,11 +97,11 @@ data QueryArg = QueryArg } deriving (Eq, Show) data HeaderArg = HeaderArg - { headerArgName :: String + { headerArgName :: Text } | ReplaceHeaderArg - { headerArgName :: String - , headerPattern :: String + { headerArgName :: Text + , headerPattern :: Text } deriving (Eq, Show) @@ -118,8 +115,8 @@ data Url = Url defUrl :: Url defUrl = Url [] [] -type FunctionName = [String] -type Method = String +type FunctionName = [Text] +type Method = Text data Req = Req { _reqUrl :: Url @@ -175,7 +172,7 @@ instance (KnownSymbol sym, HasForeign sublayout) req & reqUrl.path <>~ [Segment (Cap 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 type Foreign (Delete list a) = Req @@ -198,7 +195,7 @@ instance (KnownSymbol sym, HasForeign sublayout) foreignFor Proxy req = foreignFor subP (req & reqHeaders <>~ [HeaderArg hname]) - where hname = symbolVal (Proxy :: Proxy sym) + where hname = pack . symbolVal $ (Proxy :: Proxy sym) subP = Proxy :: Proxy sublayout instance Elem JSON list => HasForeign (Post list a) where @@ -223,7 +220,7 @@ instance (KnownSymbol sym, HasForeign sublayout) foreignFor (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg str Normal] - where str = symbolVal (Proxy :: Proxy sym) + where str = pack . symbolVal $ (Proxy :: Proxy sym) instance (KnownSymbol sym, HasForeign sublayout) => HasForeign (QueryParams sym a :> sublayout) where @@ -233,7 +230,7 @@ instance (KnownSymbol sym, HasForeign sublayout) foreignFor (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg str List] - where str = symbolVal (Proxy :: Proxy sym) + where str = pack . symbolVal $ (Proxy :: Proxy sym) instance (KnownSymbol sym, HasForeign sublayout) => HasForeign (QueryFlag sym :> sublayout) where @@ -243,7 +240,7 @@ instance (KnownSymbol sym, HasForeign sublayout) foreignFor (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg str Flag] - where str = symbolVal (Proxy :: Proxy sym) + where str = pack . symbolVal $ (Proxy :: Proxy sym) instance (KnownSymbol sym, HasForeign sublayout) => HasForeign (MatrixParam sym a :> sublayout) where @@ -253,8 +250,8 @@ instance (KnownSymbol sym, HasForeign sublayout) foreignFor (Proxy :: Proxy sublayout) $ req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal] - where str = symbolVal (Proxy :: Proxy sym) - strArg = str ++ "Value" + where str = pack . symbolVal $ (Proxy :: Proxy sym) + strArg = str <> "Value" instance (KnownSymbol sym, HasForeign sublayout) => HasForeign (MatrixParams sym a :> sublayout) where @@ -264,7 +261,7 @@ instance (KnownSymbol sym, HasForeign sublayout) foreignFor (Proxy :: Proxy sublayout) $ 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) => HasForeign (MatrixFlag sym :> sublayout) where @@ -274,13 +271,13 @@ instance (KnownSymbol sym, HasForeign sublayout) foreignFor (Proxy :: Proxy sublayout) $ 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 type Foreign Raw = Method -> Req foreignFor Proxy req method = - req & funcName %~ ((toLower <$> method) :) + req & funcName %~ ((toLower method) :) & reqMethod .~ method 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) []] & 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 type Foreign (RemoteHost :> sublayout) = Foreign sublayout diff --git a/servant-js/src/Servant/JS.hs b/servant-js/src/Servant/JS.hs index d15d811e..708847f3 100644 --- a/servant-js/src/Servant/JS.hs +++ b/servant-js/src/Servant/JS.hs @@ -39,7 +39,7 @@ -- Let's keep it simple and produce vanilla Javascript code with the default options. -- -- @ --- jsCode :: String +-- jsCode :: Text -- jsCode = 'jsForAPI' api 'vanillaJS' -- @ -- @@ -60,7 +60,7 @@ -- 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) -- @ -- @@ -112,7 +112,10 @@ module Servant.JS , GenerateList(..) ) where +import Prelude hiding (writeFile) import Data.Proxy +import Data.Text +import Data.Text.IO (writeFile) import Servant.JS.Angular import Servant.JS.Axios import Servant.JS.Internal @@ -131,7 +134,7 @@ javascript p = foreignFor p defReq jsForAPI :: (HasForeign api, GenerateList (Foreign api)) => Proxy api -- ^ proxy for your API type -> 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) -- | Directly generate all the javascript functions for your API diff --git a/servant-js/src/Servant/JS/Angular.hs b/servant-js/src/Servant/JS/Angular.hs index 3dff4551..da520cb7 100644 --- a/servant-js/src/Servant/JS/Angular.hs +++ b/servant-js/src/Servant/JS/Angular.hs @@ -1,17 +1,19 @@ +{-#LANGUAGE OverloadedStrings #-} module Servant.JS.Angular where import Control.Lens -import Data.List import Data.Monoid +import qualified Data.Text as T +import Data.Text (Text) import Servant.Foreign import Servant.JS.Internal -- | Options specific to the angular code generator data AngularOptions = AngularOptions - { serviceName :: String -- ^ When generating code with wrapInService, + { serviceName :: Text -- ^ When generating code with wrapInService, -- name of the service to generate - , prologue :: String -> String -> String -- ^ beginning of the service definition - , epilogue :: String -- ^ end of the service definition + , prologue :: Text -> Text -> Text -- ^ beginning of the service definition + , epilogue :: Text -- ^ end of the service definition } -- | Default options for the Angular codegen. Used by 'wrapInService'. @@ -34,12 +36,12 @@ angularService ngOpts = angularServiceWith ngOpts defCommonGeneratorOptions angularServiceWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator angularServiceWith ngOpts opts reqs = prologue ngOpts svc mName - <> intercalate "," (map generator reqs) <> + <> T.intercalate "," (map generator reqs) <> epilogue ngOpts where generator req = generateAngularJSWith ngOpts opts req svc = serviceName ngOpts - mName = if null (moduleName opts) + mName = if moduleName opts == "" then "app." else moduleName opts <> "." @@ -50,14 +52,14 @@ angular ngopts = angularWith ngopts defCommonGeneratorOptions -- | Generate regular javascript functions that use the $http service. 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 -generateAngularJS :: AngularOptions -> AjaxReq -> String +generateAngularJS :: AngularOptions -> AjaxReq -> Text generateAngularJS ngOpts = generateAngularJSWith ngOpts defCommonGeneratorOptions -- | js codegen using $http service from Angular -generateAngularJSWith :: AngularOptions -> CommonGeneratorOptions -> AjaxReq -> String +generateAngularJSWith :: AngularOptions -> CommonGeneratorOptions -> AjaxReq -> Text generateAngularJSWith ngOptions opts req = "\n" <> fname <> fsep <> " function(" <> argsStr <> ")\n" <> "{\n" @@ -69,7 +71,7 @@ generateAngularJSWith ngOptions opts req = "\n" <> <> " });\n" <> "}\n" - where argsStr = intercalate ", " args + where argsStr = T.intercalate ", " args args = http ++ captures ++ 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 -- the $http service, if we generate a service, the functions will -- inherit this dependency from the service - http = case length (serviceName ngOptions) of + http = case T.length (serviceName ngOptions) of 0 -> ["$http"] _ -> [] @@ -104,12 +106,12 @@ generateAngularJSWith ngOptions opts req = "\n" <> reqheaders = if null hs then "" - else " , headers: { " ++ headersStr ++ " }\n" + else " , headers: { " <> headersStr <> " }\n" - where headersStr = intercalate ", " $ map headerStr hs - headerStr header = "\"" ++ - headerArgName header ++ - "\": " ++ toJSHeader header + where headersStr = T.intercalate ", " $ map headerStr hs + headerStr header = "\"" <> + headerArgName header <> + "\": " <> toJSHeader header namespace = if hasService @@ -118,9 +120,9 @@ generateAngularJSWith ngOptions opts req = "\n" <> then "var " else (moduleName opts) <> "." where - hasNoModule = null (moduleName opts) + hasNoModule = moduleName opts == "" - hasService = not $ null (serviceName ngOptions) + hasService = serviceName ngOptions /= "" fsep = if hasService then ":" else " =" @@ -129,13 +131,13 @@ generateAngularJSWith ngOptions opts req = "\n" <> method = req ^. reqMethod url = if url' == "'" then "'/'" else url' url' = "'" - ++ urlPrefix opts - ++ urlArgs - ++ queryArgs + <> urlPrefix opts + <> urlArgs + <> queryArgs urlArgs = jsSegments $ req ^.. reqUrl.path.traverse queryArgs = if null queryparams then "" - else " + '?" ++ jsParams queryparams + else " + '?" <> jsParams queryparams diff --git a/servant-js/src/Servant/JS/Axios.hs b/servant-js/src/Servant/JS/Axios.hs index 64f1920b..8a118769 100644 --- a/servant-js/src/Servant/JS/Axios.hs +++ b/servant-js/src/Servant/JS/Axios.hs @@ -1,9 +1,10 @@ +{-#LANGUAGE OverloadedStrings #-} module Servant.JS.Axios where import Control.Lens -import Data.Char (toLower) -import Data.List import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as T import Servant.Foreign import Servant.JS.Internal @@ -14,9 +15,9 @@ data AxiosOptions = AxiosOptions -- should be made using credentials withCredentials :: !Bool -- | 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 - , xsrfHeaderName :: !(Maybe String) + , xsrfHeaderName :: !(Maybe Text) } -- | Default instance of the AxiosOptions @@ -36,14 +37,14 @@ axios aopts = axiosWith aopts defCommonGeneratorOptions -- | Generate regular javascript functions that use the axios library. 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 -generateAxiosJS :: AxiosOptions -> AjaxReq -> String +generateAxiosJS :: AxiosOptions -> AjaxReq -> Text generateAxiosJS aopts = generateAxiosJSWith aopts defCommonGeneratorOptions -- | js codegen using axios library -generateAxiosJSWith :: AxiosOptions -> CommonGeneratorOptions -> AjaxReq -> String +generateAxiosJSWith :: AxiosOptions -> CommonGeneratorOptions -> AjaxReq -> Text generateAxiosJSWith aopts opts req = "\n" <> fname <> " = function(" <> argsStr <> ")\n" <> "{\n" @@ -57,7 +58,7 @@ generateAxiosJSWith aopts opts req = "\n" <> <> " });\n" <> "}\n" - where argsStr = intercalate ", " args + where argsStr = T.intercalate ", " args args = captures ++ map (view argName) queryparams ++ body @@ -101,30 +102,30 @@ generateAxiosJSWith aopts opts req = "\n" <> then "" else " , headers: { " <> headersStr <> " }\n" - where headersStr = intercalate ", " $ map headerStr hs - headerStr header = "\"" ++ - headerArgName header ++ - "\": " ++ toJSHeader header + where headersStr = T.intercalate ", " $ map headerStr hs + headerStr header = "\"" <> + headerArgName header <> + "\": " <> toJSHeader header namespace = if hasNoModule then "var " else (moduleName opts) <> "." where - hasNoModule = null (moduleName opts) + hasNoModule = moduleName opts == "" fname = namespace <> (functionNameBuilder opts $ req ^. funcName) - method = map toLower $ req ^. reqMethod + method = T.toLower $ req ^. reqMethod url = if url' == "'" then "'/'" else url' url' = "'" - ++ urlPrefix opts - ++ urlArgs - ++ queryArgs + <> urlPrefix opts + <> urlArgs + <> queryArgs urlArgs = jsSegments $ req ^.. reqUrl.path.traverse queryArgs = if null queryparams then "" - else " + '?" ++ jsParams queryparams + else " + '?" <> jsParams queryparams diff --git a/servant-js/src/Servant/JS/Internal.hs b/servant-js/src/Servant/JS/Internal.hs index a7af966b..c53124f7 100644 --- a/servant-js/src/Servant/JS/Internal.hs +++ b/servant-js/src/Servant/JS/Internal.hs @@ -1,3 +1,4 @@ +{-#LANGUAGE OverloadedStrings #-} module Servant.JS.Internal ( JavaScriptGenerator , CommonGeneratorOptions(..) @@ -34,28 +35,28 @@ module Servant.JS.Internal import Control.Lens ((^.)) import qualified Data.CharSet as Set import qualified Data.CharSet.Unicode.Category as Set -import Data.List import Data.Monoid import qualified Data.Text as T +import Data.Text (Text) import Servant.Foreign type AjaxReq = Req -- 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. -type JavaScriptGenerator = [Req] -> String +type JavaScriptGenerator = [Req] -> Text -- | This structure is used by specific implementations to let you -- customize the output data CommonGeneratorOptions = CommonGeneratorOptions { - functionNameBuilder :: FunctionName -> String -- ^ function generating function names - , requestBody :: String -- ^ 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 - , errorCallback :: String -- ^ 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) - , urlPrefix :: String -- ^ a prefix we should add to the Url in the codegen + functionNameBuilder :: FunctionName -> Text -- ^ function generating function names + , requestBody :: Text -- ^ name used when a user want to send the request body (to let you redefine it) + , successCallback :: Text -- ^ name of the callback parameter when the request was successful + , errorCallback :: Text -- ^ name of the callback parameter when the request reported an error + , moduleName :: Text -- ^ namespace on which we define the foreign function (empty mean local var) + , urlPrefix :: Text -- ^ a prefix we should add to the Url in the codegen } -- | Default options. @@ -87,80 +88,81 @@ defCommonGeneratorOptions = CommonGeneratorOptions -- Couldn't work out how to handle zero-width characters. -- -- @TODO: specify better default function name, or throw error? -toValidFunctionName :: String -> String -toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs +toValidFunctionName :: Text -> Text +toValidFunctionName t = + case T.uncons t of + Just (x,xs) -> + setFirstChar x `T.cons` T.filter remainder xs + Nothing -> "_" where setFirstChar c = if firstChar c then c else '_' - firstChar c = prefixOK c || any (Set.member c) firstLetterOK - remainder c = prefixOK c || any (Set.member c) remainderOK - -- Valid prefixes + firstChar c = prefixOK c || Set.member c firstLetterOK + remainder c = prefixOK c || Set.member c remainderOK prefixOK c = c `elem` ['$','_'] - -- Unicode character sets - firstLetterOK = [ Set.lowercaseLetter - , Set.uppercaseLetter - , Set.titlecaseLetter - , Set.modifierLetter - , Set.otherLetter - , Set.letterNumber ] + firstLetterOK = mconcat + [ Set.lowercaseLetter + , Set.uppercaseLetter + , Set.titlecaseLetter + , Set.modifierLetter + , Set.otherLetter + , Set.letterNumber + ] remainderOK = firstLetterOK - <> [ Set.nonSpacingMark - , Set.spacingCombiningMark - , Set.decimalNumber - , Set.connectorPunctuation ] -toValidFunctionName [] = "_" + <> mconcat + [ Set.nonSpacingMark + , Set.spacingCombiningMark + , Set.decimalNumber + , Set.connectorPunctuation + ] -toJSHeader :: HeaderArg -> String +toJSHeader :: HeaderArg -> Text toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n) toJSHeader (ReplaceHeaderArg n p) - | pn `isPrefixOf` p = pv <> " + \"" <> rp <> "\"" - | pn `isSuffixOf` p = "\"" <> rp <> "\" + " <> pv - | pn `isInfixOf` p = "\"" <> (replace pn ("\" + " <> pv <> " + \"") p) + | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\"" + | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv + | pn `T.isInfixOf` p = "\"" <> (T.replace pn ("\" + " <> pv <> " + \"") p) <> "\"" | otherwise = p where pv = toValidFunctionName ("header" <> n) pn = "{" <> n <> "}" - rp = replace pn "" p - -- Use replace method from Data.Text - replace old new = T.unpack - . T.replace (T.pack old) (T.pack new) - . T.pack + rp = T.replace pn "" p -jsSegments :: [Segment] -> String +jsSegments :: [Segment] -> Text jsSegments [] = "" -jsSegments [x] = "/" ++ segmentToStr x False -jsSegments (x:xs) = "/" ++ segmentToStr x True ++ jsSegments xs +jsSegments [x] = "/" <> segmentToStr x False +jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs -segmentToStr :: Segment -> Bool -> String +segmentToStr :: Segment -> Bool -> Text 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 (Cap s) = "' + encodeURIComponent(" ++ s ++ ") + '" +segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> s <> ") + '" -jsGParams :: String -> [QueryArg] -> String +jsGParams :: Text -> [QueryArg] -> Text jsGParams _ [] = "" 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 "&" -jsMParams :: [MatrixArg] -> String +jsMParams :: [MatrixArg] -> Text jsMParams [] = "" -jsMParams xs = ";" ++ jsGParams ";" xs +jsMParams xs = ";" <> jsGParams ";" xs -paramToStr :: QueryArg -> Bool -> String +paramToStr :: QueryArg -> Bool -> Text paramToStr qarg notTheEnd = case qarg ^. argType of Normal -> name - ++ "=' + encodeURIComponent(" - ++ name - ++ if notTheEnd then ") + '" else ")" - Flag -> name ++ "=" + <> "=' + encodeURIComponent(" + <> name + <> if notTheEnd then ") + '" else ")" + Flag -> name <> "=" List -> name - ++ "[]=' + encodeURIComponent(" - ++ name - ++ if notTheEnd then ") + '" else ")" + <> "[]=' + encodeURIComponent(" + <> name + <> if notTheEnd then ") + '" else ")" where name = qarg ^. argName diff --git a/servant-js/src/Servant/JS/JQuery.hs b/servant-js/src/Servant/JS/JQuery.hs index 5a0d458c..e3a6ee29 100644 --- a/servant-js/src/Servant/JS/JQuery.hs +++ b/servant-js/src/Servant/JS/JQuery.hs @@ -1,8 +1,10 @@ +{-#LANGUAGE OverloadedStrings #-} module Servant.JS.JQuery where import Control.Lens -import Data.List import Data.Monoid +import qualified Data.Text as T +import Data.Text (Text) import Servant.Foreign import Servant.JS.Internal @@ -10,19 +12,19 @@ import Servant.JS.Internal -- to make the AJAX calls. Uses 'defCommonGeneratorOptions' -- for the generator options. jquery :: JavaScriptGenerator -jquery = concatMap generateJQueryJS +jquery = mconcat . map generateJQueryJS -- | Generate javascript functions that use the /jQuery/ library -- to make the AJAX calls. Lets you specify your own 'CommonGeneratorOptions'. jqueryWith :: CommonGeneratorOptions -> JavaScriptGenerator -jqueryWith opts = concatMap (generateJQueryJSWith opts) +jqueryWith opts = mconcat . map (generateJQueryJSWith opts) -- | js codegen using JQuery using default options -generateJQueryJS :: AjaxReq -> String +generateJQueryJS :: AjaxReq -> Text generateJQueryJS = generateJQueryJSWith defCommonGeneratorOptions -- | js codegen using JQuery -generateJQueryJSWith :: CommonGeneratorOptions -> AjaxReq -> String +generateJQueryJSWith :: CommonGeneratorOptions -> AjaxReq -> Text generateJQueryJSWith opts req = "\n" <> fname <> " = function(" <> argsStr <> ")\n" <> "{\n" @@ -36,7 +38,7 @@ generateJQueryJSWith opts req = "\n" <> <> " });\n" <> "}\n" - where argsStr = intercalate ", " args + where argsStr = T.intercalate ", " args args = captures ++ map (view argName) queryparams ++ body @@ -67,14 +69,14 @@ generateJQueryJSWith opts req = "\n" <> reqheaders = if null hs then "" - else " , headers: { " ++ headersStr ++ " }\n" + else " , headers: { " <> headersStr <> " }\n" - where headersStr = intercalate ", " $ map headerStr hs - headerStr header = "\"" ++ - headerArgName header ++ - "\": " ++ toJSHeader header + where headersStr = T.intercalate ", " $ map headerStr hs + headerStr header = "\"" <> + headerArgName header <> + "\": " <> toJSHeader header - namespace = if null (moduleName opts) + namespace = if (moduleName opts) == "" then "var " else (moduleName opts) <> "." fname = namespace <> (functionNameBuilder opts $ req ^. funcName) @@ -82,13 +84,13 @@ generateJQueryJSWith opts req = "\n" <> method = req ^. reqMethod url = if url' == "'" then "'/'" else url' url' = "'" - ++ urlPrefix opts - ++ urlArgs - ++ queryArgs + <> urlPrefix opts + <> urlArgs + <> queryArgs urlArgs = jsSegments $ req ^.. reqUrl.path.traverse queryArgs = if null queryparams then "" - else " + '?" ++ jsParams queryparams + else " + '?" <> jsParams queryparams diff --git a/servant-js/src/Servant/JS/Vanilla.hs b/servant-js/src/Servant/JS/Vanilla.hs index fabbcaee..7a6d6da5 100644 --- a/servant-js/src/Servant/JS/Vanilla.hs +++ b/servant-js/src/Servant/JS/Vanilla.hs @@ -1,7 +1,9 @@ +{-#LANGUAGE OverloadedStrings #-} module Servant.JS.Vanilla where import Control.Lens -import Data.List +import Data.Text (Text) +import qualified Data.Text as T import Data.Monoid import Servant.Foreign import Servant.JS.Internal @@ -10,20 +12,20 @@ import Servant.JS.Internal -- to your API, using /XMLHttpRequest/. Uses 'defCommonGeneratorOptions' -- for the 'CommonGeneratorOptions'. vanillaJS :: JavaScriptGenerator -vanillaJS = concatMap generateVanillaJS +vanillaJS = mconcat . map generateVanillaJS -- | Generate vanilla javascript functions to make AJAX requests -- to your API, using /XMLHttpRequest/. Lets you specify your -- own options. vanillaJSWith :: CommonGeneratorOptions -> JavaScriptGenerator -vanillaJSWith opts = concatMap (generateVanillaJSWith opts) +vanillaJSWith opts = mconcat . map (generateVanillaJSWith opts) -- | js codegen using XmlHttpRequest using default generation options -generateVanillaJS :: AjaxReq -> String +generateVanillaJS :: AjaxReq -> Text generateVanillaJS = generateVanillaJSWith defCommonGeneratorOptions -- | js codegen using XmlHttpRequest -generateVanillaJSWith :: CommonGeneratorOptions -> AjaxReq -> String +generateVanillaJSWith :: CommonGeneratorOptions -> AjaxReq -> Text generateVanillaJSWith opts req = "\n" <> fname <> " = function(" <> argsStr <> ")\n" <> "{\n" @@ -43,7 +45,7 @@ generateVanillaJSWith opts req = "\n" <> <> " xhr.send(" <> dataBody <> ");\n" <> "}\n" - where argsStr = intercalate ", " args + where argsStr = T.intercalate ", " args args = captures ++ map (view argName) queryparams ++ body @@ -74,14 +76,14 @@ generateVanillaJSWith opts req = "\n" <> reqheaders = if null hs then "" - else headersStr ++ "\n" + else headersStr <> "\n" - where headersStr = intercalate "\n" $ map headerStr hs - headerStr header = " xhr.setRequestHeader(\"" ++ - headerArgName header ++ - "\", " ++ toJSHeader header ++ ");" + where headersStr = T.intercalate "\n" $ map headerStr hs + headerStr header = " xhr.setRequestHeader(\"" <> + headerArgName header <> + "\", " <> toJSHeader header <> ");" - namespace = if null (moduleName opts) + namespace = if moduleName opts == "" then "var " else (moduleName opts) <> "." fname = namespace <> (functionNameBuilder opts $ req ^. funcName) @@ -89,13 +91,13 @@ generateVanillaJSWith opts req = "\n" <> method = req ^. reqMethod url = if url' == "'" then "'/'" else url' url' = "'" - ++ urlPrefix opts - ++ urlArgs - ++ queryArgs + <> urlPrefix opts + <> urlArgs + <> queryArgs urlArgs = jsSegments $ req ^.. reqUrl.path.traverse queryArgs = if null queryparams then "" - else " + '?" ++ jsParams queryparams + else " + '?" <> jsParams queryparams diff --git a/servant-js/test/Servant/JSSpec.hs b/servant-js/test/Servant/JSSpec.hs index 46662ea5..5e692e59 100644 --- a/servant-js/test/Servant/JSSpec.hs +++ b/servant-js/test/Servant/JSSpec.hs @@ -1,16 +1,25 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Servant.JSSpec where import Data.Either (isRight) +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid ((<>),mconcat) +#else +import Data.Monoid ((<>)) +#endif import Data.Proxy -import Language.ECMAScript3.Parser (parseFromString) -import Test.Hspec +import Data.Text (Text) +import qualified Data.Text as T +import Language.ECMAScript3.Parser (program, parse) +import Test.Hspec hiding (shouldContain, shouldNotContain) import Servant.JS import Servant.JS.Internal @@ -20,22 +29,22 @@ import qualified Servant.JS.JQuery as JQ import qualified Servant.JS.Vanilla as JS 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 type TopLevelRawAPI = "something" :> Get '[JSON] Int :<|> Raw -type HeaderHandlingAPI = "something" :> Header "Foo" String +type HeaderHandlingAPI = "something" :> Header "Foo" Text :> Get '[JSON] Int -type CustomAuthAPI = "something" :> Authorization "Basic" String +type CustomAuthAPI = "something" :> Authorization "Basic" Text :> Get '[JSON] Int -type CustomHeaderAPI = "something" :> MyLovelyHorse String +type CustomHeaderAPI = "something" :> MyLovelyHorse Text :> Get '[JSON] Int -type CustomHeaderAPI2 = "something" :> WhatsForDinner String +type CustomHeaderAPI2 = "something" :> WhatsForDinner Text :> Get '[JSON] Int headerHandlingProxy :: Proxy HeaderHandlingAPI @@ -81,12 +90,18 @@ spec = describe "Servant.JQuery" $ do axiosSpec --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 = describe specLabel $ do it "should add withCredentials when needed" $ do let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI) output jsText - jsText `shouldContain` ("withCredentials: true") + jsText `shouldContain` "withCredentials: true" it "should add xsrfCookieName when needed" $ do let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI) output jsText @@ -101,79 +116,80 @@ axiosSpec = describe specLabel $ do withCredOpts = AX.defAxiosOptions { AX.withCredentials = True } cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" } headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" } - genJS :: AxiosOptions -> [AjaxReq] -> String - genJS opts req = concatMap (AX.generateAxiosJS opts) req + genJS :: AxiosOptions -> [AjaxReq] -> Text + genJS opts req = mconcat . map (AX.generateAxiosJS opts) $ req angularSpec :: TestNames -> Spec angularSpec test = describe specLabel $ do it "should implement a service globally" $ do let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) output jsText - jsText `shouldContain` (".service('" ++ testName ++ "'") + jsText `shouldContain` (".service('" <> testName <> "'") it "should depend on $http service globally" $ do let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) output jsText - jsText `shouldContain` ("('" ++ testName ++ "', function($http) {") + jsText `shouldContain` ("('" <> testName <> "', function($http) {") it "should not depend on $http service in handlers" $ do let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) output jsText jsText `shouldNotContain` "getsomething($http, " where - specLabel = "AngularJS(" ++ (show test) ++ ")" + specLabel = "AngularJS(" <> (show test) <> ")" output _ = return () testName = "MyService" ngOpts = NG.defAngularOptions { NG.serviceName = testName } genJS req = NG.angularService ngOpts req -generateJSSpec :: TestNames -> (AjaxReq -> String) -> Spec +generateJSSpec :: TestNames -> (AjaxReq -> Text) -> Spec generateJSSpec n gen = describe specLabel $ do + let parseFromText = parse program "" it "should generate valid javascript" $ do - let s = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen) - parseFromString s `shouldSatisfy` isRight + let s = jsForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen) + parseFromText s `shouldSatisfy` isRight it "should use non-empty function names" $ do let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI) output $ genJS (topLevel "GET") - parseFromString (genJS $ topLevel "GET") `shouldSatisfy` isRight + parseFromText (genJS $ topLevel "GET") `shouldSatisfy` isRight it "should handle simple HTTP headers" $ do let jsText = genJS $ javascript headerHandlingProxy output jsText - parseFromString jsText `shouldSatisfy` isRight + parseFromText jsText `shouldSatisfy` isRight jsText `shouldContain` "headerFoo" jsText `shouldContain` (header n "Foo" $ "headerFoo") it "should handle complex HTTP headers" $ do let jsText = genJS $ javascript customAuthProxy output jsText - parseFromString jsText `shouldSatisfy` isRight + parseFromText jsText `shouldSatisfy` isRight jsText `shouldContain` "headerAuthorization" jsText `shouldContain` (header n "Authorization" $ "\"Basic \" + headerAuthorization") it "should handle complex, custom HTTP headers" $ do let jsText = genJS $ javascript customHeaderProxy output jsText - parseFromString jsText `shouldSatisfy` isRight + parseFromText jsText `shouldSatisfy` isRight jsText `shouldContain` "headerXMyLovelyHorse" jsText `shouldContain` (header n "X-MyLovelyHorse" $ "\"I am good friends with \" + headerXMyLovelyHorse") it "should handle complex, custom HTTP headers (template replacement)" $ do let jsText = genJS $ javascript customHeaderProxy2 output jsText - parseFromString jsText `shouldSatisfy` isRight + parseFromText jsText `shouldSatisfy` isRight jsText `shouldContain` "headerXWhatsForDinner" 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 - let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen) - parseFromString jsStr `shouldSatisfy` isRight + let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen) + parseFromText jsStr `shouldSatisfy` isRight where - specLabel = "generateJS(" ++ (show n) ++ ")" + specLabel = "generateJS(" <> (show n) <> ")" output _ = return () genJS req = gen req - header :: TestNames -> String -> String -> String + header :: TestNames -> Text -> Text -> Text header v headerName headerValue - | v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" ++ headerName ++ "\", " ++ headerValue ++ ");\n" - | otherwise = "headers: { \"" ++ headerName ++ "\": " ++ headerValue ++ " }\n" + | v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" <> headerName <> "\", " <> headerValue <> ");\n" + | otherwise = "headers: { \"" <> headerName <> "\": " <> headerValue <> " }\n" diff --git a/servant-js/test/Servant/JSSpec/CustomHeaders.hs b/servant-js/test/Servant/JSSpec/CustomHeaders.hs index 810760c7..fd72672e 100644 --- a/servant-js/test/Servant/JSSpec/CustomHeaders.hs +++ b/servant-js/test/Servant/JSSpec/CustomHeaders.hs @@ -5,12 +5,14 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} module Servant.JSSpec.CustomHeaders where import Control.Lens import Data.Monoid import Data.Proxy +import Data.Text (pack) import GHC.TypeLits import Servant.JS.Internal @@ -25,7 +27,7 @@ instance (KnownSymbol sym, HasForeign sublayout) foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $ - tokenType (symbolVal (Proxy :: Proxy sym)) ] + tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ] where tokenType t = t <> " {Authorization}"