packages feed

servant-js (empty) → 0.5

raw patch · 16 files changed

+1468/−0 lines, 16 filesdep +aesondep +basedep +base-compatsetup-changed

Dependencies added: aeson, base, base-compat, charset, filepath, hspec, hspec-expectations, language-ecmascript, lens, servant, servant-foreign, servant-js, servant-server, stm, text, transformers, warp

Files

+ CHANGELOG.md view
@@ -0,0 +1,23 @@+0.5+----++* Extract javascript-obvlious types and helpers to *servant-foreign*+* Use `text` package instead of `String`+* Provide new targets for code generation along with the old jQuery one: vanilla Javascript and Angular.js+* Greatly simplify usage of this library by reducing down the API to just 2 functions: `jsForAPI` and `writeJSForAPI` + the choice of a code generator+* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators+* Remove matrix params.++0.4+---+* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body+* Extend `HeaderArg` to support more advanced HTTP header handling (https://github.com/haskell-servant/servant-jquery/pull/6)+* Support content-type aware combinators (but require that endpoints support JSON)+* Add support for Matrix params (https://github.com/haskell-servant/servant-jquery/pull/11)+* Add functions that directly generate the Javascript code from the API type without having to manually pattern match on the result.++0.2.2+-----++* Fix an issue where toplevel Raw endpoints would generate a JS function with no name (https://github.com/haskell-servant/servant-jquery/issues/2)+* Replace dots by _ in paths (https://github.com/haskell-servant/servant-jquery/issues/1)
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, Servant Contributors++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Zalora South East Asia Pte Ltd nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,99 @@+# servant-js++![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)++This library lets you derive automatically Javascript functions that let you query each endpoint of a *servant* webservice.++It contains a powerful system allowing you to generate functions for several frameworks (Angular, AXios, JQuery) as well as+vanilla (framework-free) javascript code.++## Example++Read more about the following example [here](https://github.com/haskell-servant/servant/tree/master/servant-js/examples#examples).++``` haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++import Control.Concurrent.STM+import Control.Monad.IO.Class+import Data.Aeson+import Data.Proxy+import GHC.Generics+import Network.Wai.Handler.Warp (run)+import Servant+import Servant.JS+import System.FilePath++-- * A simple Counter data type+newtype Counter = Counter { value :: Int }+  deriving (Generic, Show, Num)++instance ToJSON Counter++-- * Shared counter operations++-- Creating a counter that starts from 0+newCounter :: IO (TVar Counter)+newCounter = newTVarIO 0++-- Increasing the counter by 1+counterPlusOne :: MonadIO m => TVar Counter -> m Counter+counterPlusOne counter = liftIO . atomically $ do+  oldValue <- readTVar counter+  let newValue = oldValue + 1+  writeTVar counter newValue+  return newValue++currentValue :: MonadIO m => TVar Counter -> m Counter+currentValue counter = liftIO $ readTVarIO counter++-- * Our API type+type TestApi = "counter" :> Post '[JSON] Counter -- endpoint for increasing the counter+          :<|> "counter" :> Get  '[JSON] Counter -- endpoint to get the current value++type TestApi' = TestApi -- The API we want a JS handler for+           :<|> Raw     -- used for serving static files++-- this proxy only targets the proper endpoints of our API,+-- not the static file serving bit+testApi :: Proxy TestApi+testApi = Proxy++-- this proxy targets everything+testApi' :: Proxy TestApi'+testApi' = Proxy++-- * Server-side handler++-- where our static files reside+www :: FilePath+www = "examples/www"++-- defining handlers+server :: TVar Counter -> Server TestApi+server counter = counterPlusOne counter     -- (+1) on the TVar+            :<|> currentValue counter       -- read the TVar++server' :: TVar Counter -> Server TestApi'+server counter = server counter+            :<|> serveDirectory www         -- serve static files++runServer :: TVar Counter -- ^ shared variable for the counter+          -> Int          -- ^ port the server should listen on+          -> IO ()+runServer var port = run port (serve testApi' $ server' var)++main :: IO ()+main = do+  -- write the JS code to www/api.js at startup+  writeJSForAPI testApi jquery (www </> "api.js")++  -- setup a shared counter+  cnt <- newCounter++  -- listen to requests on port 8080+  runServer cnt 8080+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import           Distribution.Simple+main = defaultMain
+ examples/counter.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeOperators              #-}++import           Control.Concurrent.STM+import           Control.Monad.IO.Class+import           Data.Aeson+import           Data.Proxy+import           GHC.Generics+import           Network.Wai.Handler.Warp (run)+import           Servant+import           Servant.JS+import qualified Servant.JS               as SJS+import qualified Servant.JS.Angular       as NG+import           System.FilePath++-- * A simple Counter data type+newtype Counter = Counter { value :: Int }+  deriving (Generic, Show, Num)++instance ToJSON Counter++-- * Shared counter operations++-- Creating a counter that starts from 0+newCounter :: IO (TVar Counter)+newCounter = newTVarIO 0++-- Increasing the counter by 1+counterPlusOne :: MonadIO m => TVar Counter -> m Counter+counterPlusOne counter = liftIO . atomically $ do+  oldValue <- readTVar counter+  let newValue = oldValue + 1+  writeTVar counter newValue+  return newValue++currentValue :: MonadIO m => TVar Counter -> m Counter+currentValue counter = liftIO $ readTVarIO counter++-- * Our API type+type TestApi = "counter" :> Post '[JSON] Counter -- endpoint for increasing the counter+          :<|> "counter" :> Get '[JSON] Counter -- endpoint to get the current value++type TestApi' = TestApi+           :<|> Raw -- used for serving static files++-- this proxy only targets the proper endpoints of our API,+-- not the static file serving bit+testApi :: Proxy TestApi+testApi = Proxy++-- this proxy targets everything+testApi' :: Proxy TestApi'+testApi' = Proxy++-- * Server-side handler++-- where our static files reside+www :: FilePath+www = "examples/www"++-- defining handlers of our endpoints+server :: TVar Counter -> Server TestApi+server counter = counterPlusOne counter     -- (+1) on the TVar+            :<|> currentValue counter       -- read the TVar++-- the whole server, including static file serving+server' :: TVar Counter -> Server TestApi'+server' counter = server counter+             :<|> serveDirectory www -- serve static files++runServer :: TVar Counter -- ^ shared variable for the counter+          -> Int          -- ^ port the server should listen on+          -> IO ()+runServer var port = run port (serve testApi' $ server' var)++writeServiceJS :: FilePath -> IO ()+writeServiceJS fp =+  writeJSForAPI testApi+                (angularServiceWith (NG.defAngularOptions { NG.serviceName = "counterSvc" })+                                    (defCommonGeneratorOptions { SJS.moduleName = "counterApp" })+                )+                fp++main :: IO ()+main = do+  -- write the JS code to www/api.js at startup+  writeJSForAPI testApi jquery (www </> "jquery" </> "api.js")++  writeJSForAPI testApi vanillaJS (www </> "vanilla" </> "api.js")++  writeJSForAPI testApi (angular defAngularOptions) (www </> "angular" </> "api.js")++  writeJSForAPI testApi axios (www </> "axios" </> "api.js")++  writeServiceJS (www </> "angular" </> "api.service.js")++  -- setup a shared counter+  cnt <- newCounter++  -- listen to requests on port 8080+  runServer cnt 8080
+ include/overlapping-compat.h view
@@ -0,0 +1,8 @@+#if __GLASGOW_HASKELL__ >= 710+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}+#define OVERLAPPING_  {-# OVERLAPPING #-}+#else+{-# LANGUAGE OverlappingInstances #-}+#define OVERLAPPABLE_+#define OVERLAPPING_+#endif
+ servant-js.cabal view
@@ -0,0 +1,95 @@+name:                servant-js+version:             0.5+synopsis:            Automatically derive javascript functions to query servant webservices.+description:+  Automatically derive javascript functions to query servant webservices.+  .+  Supports deriving functions using vanilla javascript AJAX requests, Angulari, Axios or JQuery.+  .+  You can find an example <https://github.com/haskell-servant/servant/blob/master/servant-js/examples/counter.hs here>+  which serves the generated javascript to a webpage that allows you to trigger+  webservice calls.+  .+  <https://github.com/haskell-servant/servant/blob/master/servant-js/CHANGELOG.md CHANGELOG>+license:             BSD3+license-file:        LICENSE+author:              Servant Contributors+maintainer:          haskell-servant-maintainers@googlegroups.com+copyright:           2015-2016 Servant Contributors+category:            Web+build-type:          Simple+cabal-version:       >=1.10+homepage:            http://haskell-servant.github.io/+Bug-reports:         http://github.com/haskell-servant/servant/issues+extra-source-files:+  include/*.h+  CHANGELOG.md+  README.md+source-repository head+  type: git+  location: http://github.com/haskell-servant/servant.git++flag example+  description: Build the example too+  manual: True+  default: False++library+  exposed-modules:     Servant.JS+                       Servant.JS.Angular+                       Servant.JS.Axios+                       Servant.JS.Internal+                       Servant.JS.JQuery+                       Servant.JS.Vanilla+  build-depends:       base            >= 4.5 && <5+                     , base-compat     >= 0.9+                     , charset         >= 0.3+                     , lens            >= 4+                     , servant-foreign == 0.5.*+                     , text            >= 1.2  && < 1.3++  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall+  include-dirs: include++executable counter+  main-is: counter.hs+  ghc-options: -O2 -Wall+  hs-source-dirs: examples++  if flag(example)+    buildable: True+  else+    buildable: False++  build-depends:    base             >= 4.7 && < 5+                  , aeson            >= 0.7  && < 0.12+                  , filepath         >= 1+                  , lens             >= 4+                  , servant          == 0.5.*+                  , servant-server   == 0.5.*+                  , servant-js+                  , stm+                  , transformers+                  , warp+  default-language: Haskell2010++test-suite spec+  type:              exitcode-stdio-1.0+  hs-source-dirs:    test+  ghc-options:       -Wall+  main-is:           Spec.hs+  other-modules:+      Servant.JSSpec+      Servant.JSSpec.CustomHeaders+  build-depends:     base+                   , base-compat+                   , hspec >= 2.1.8+                   , hspec-expectations+                   , language-ecmascript >= 0.16+                   , lens+                   , servant+                   , servant-js+                   , text+  default-language:  Haskell2010
+ src/Servant/JS.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Servant.JS+-- License     :  BSD3+-- Maintainer  :  Alp Mestanogullari <alpmestan@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Generating Javascript code to query your APIs using vanilla Javascript,+-- Angular.js or JQuery.+--+-- Using this package is very simple. Say you have this API type around:+--+-- > type API = "users" :> Get '[JSON] [Users]+-- >       :<|> "messages" :> Get '[JSON] [Message]+--+-- All you need to do to generate the Javascript code is to write a 'Proxy'+-- for this API type:+--+-- > api :: Proxy API+-- > api = Proxy+--+-- And pick one of the generators:+--+-- - 'vanillaJS' and 'vanillaJSWith' generate functions that use+--   /XMLHttpRequest/ to query your endpoints. The former just calls+--   the latter with default code-generation options.+-- - 'jquery' and 'jqueryWith' follow the same pattern except that they+--   generate functions that use /jQuery/'s AJAX functions.+-- - 'angular' and 'angularWith' do the same but use /Angular.js/'s $http+--   service. In addition, we provide 'angularService' and 'angularServiceWith'+--   which produce functions under an Angular service that your controlers+--   can depend on to query the API.+--+-- Let's keep it simple and produce vanilla Javascript code with the default options.+--+-- @+-- jsCode :: Text+-- jsCode = 'jsForAPI' api 'vanillaJS'+-- @+--+-- That's it! If you want to write that code to a file:+--+-- @+-- writeJSCode :: IO ()+-- writeJSCode = 'writeJSForAPI' api 'vanillaJS' "./my_api.js"+-- @+--+-- If you want to customize the rendering options, take a look+-- at 'CommonGeneratorOptions' which are generic options common to all the+-- generators. the /xxxWith/ variants all take 'CommonGeneratorOptions' whereas+-- the /xxx/ versions use 'defCommonGeneratorOptions'. Once you have some custom+--+-- > myOptions :: 'CommonGeneratorOptions'+--+-- All you need to do to use it is to use 'vanillaJSWith' and pass it @myOptions@.+--+-- @+-- jsCodeWithMyOptions :: Text+-- jsCodeWithMyOptions = 'jsForAPI' api ('vanillaJSWith' myOptions)+-- @+--+-- Follow the same pattern for any other generator.+--+-- /Note/: The Angular generators take an additional type of options,+-- namely 'AngularOptions', to let you tweak aspects of the code generation+-- that are specific to /Angular.js/.+module Servant.JS+  ( -- * Generating javascript code from an API type+    jsForAPI+  , writeJSForAPI+  , JavaScriptGenerator++  , -- * Options common to all generators+    CommonGeneratorOptions(..)+  , defCommonGeneratorOptions++  , -- * Function renamers+    concatCase+  , snakeCase+  , camelCase++  , -- * Vanilla Javascript code generation+    vanillaJS+  , vanillaJSWith++  , -- * JQuery code generation+    jquery+  , jqueryWith++  , -- * Angular.js code generation+    angular+  , angularWith+  , angularService+  , angularServiceWith+  , AngularOptions(..)+  , defAngularOptions++  , -- * Axios code generation+    axios+  , axiosWith+  , AxiosOptions(..)+  , defAxiosOptions++  , -- * Misc.+    listFromAPI+  , javascript+  , NoTypes+  , 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+import           Servant.JS.JQuery+import           Servant.JS.Vanilla+import           Servant.Foreign (GenerateList(..), listFromAPI, NoTypes)++-- | Generate the data necessary to generate javascript code+--   for all the endpoints of an API, as ':<|>'-separated values+--   of type 'AjaxReq'.+javascript :: HasForeign NoTypes () layout => Proxy layout -> Foreign () layout+javascript p = foreignFor (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p defReq++-- | Directly generate all the javascript functions for your API+--   from a 'Proxy' for your API type. You can then write it to+--   a file or integrate it in a page, for example.+jsForAPI :: (HasForeign NoTypes () api, GenerateList () (Foreign () api))+         => Proxy api -- ^ proxy for your API type+         -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)+         -> Text                -- ^ a text that you can embed in your pages or write to a file+jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p)++-- | Directly generate all the javascript functions for your API+--   from a 'Proxy' for your API type using the given generator+--   and write the resulting code to a file at the given path.+writeJSForAPI :: (HasForeign NoTypes () api, GenerateList () (Foreign () api))+              => Proxy api -- ^ proxy for your API type+              -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)+              -> FilePath -- ^ path to the file you want to write the resulting javascript code into+              -> IO ()+writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen)+
+ src/Servant/JS/Angular.hs view
@@ -0,0 +1,149 @@+{-#LANGUAGE OverloadedStrings #-}+module Servant.JS.Angular where++import           Control.Lens+import           Data.Maybe (isJust)+import           Data.Monoid+import qualified Data.Text as T+import           Data.Text (Text)+import           Data.Text.Encoding (decodeUtf8)+import           Servant.Foreign+import           Servant.JS.Internal++-- | Options specific to the angular code generator+data AngularOptions = AngularOptions+  { serviceName :: Text                         -- ^ When generating code with wrapInService,+                                                  --   name of the service to generate+  , 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'.+defAngularOptions :: AngularOptions+defAngularOptions = AngularOptions+  { serviceName = ""+  , prologue = \svc m -> m <> "service('" <> svc <> "', function($http) {\n"+                           <> "  return ({"+  , epilogue = "});\n});\n"+    }++-- | Instead of simply generating top level functions, generates a service instance+-- on which your controllers can depend to access your API.+-- This variant uses default 'AngularOptions'.+angularService :: AngularOptions -> JavaScriptGenerator+angularService ngOpts = angularServiceWith ngOpts defCommonGeneratorOptions++-- | Instead of simply generating top level functions, generates a service instance+-- on which your controllers can depend to access your API+angularServiceWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator+angularServiceWith ngOpts opts reqs =+    prologue ngOpts svc mName+    <> T.intercalate "," (map generator reqs) <>+    epilogue ngOpts+    where+        generator req = generateAngularJSWith ngOpts opts req+        svc = serviceName ngOpts+        mName = if moduleName opts == ""+                   then "app."+                   else moduleName opts <> "."++-- | Generate regular javacript functions that use+--   the $http service, using default values for 'CommonGeneratorOptions'.+angular :: AngularOptions -> JavaScriptGenerator+angular ngopts = angularWith ngopts defCommonGeneratorOptions++-- | Generate regular javascript functions that use the $http service.+angularWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator+angularWith ngopts opts = T.intercalate "\n\n" . map (generateAngularJSWith ngopts opts)++-- | js codegen using $http service from Angular using default options+generateAngularJS :: AngularOptions -> AjaxReq -> Text+generateAngularJS ngOpts = generateAngularJSWith ngOpts defCommonGeneratorOptions++-- | js codegen using $http service from Angular+generateAngularJSWith ::  AngularOptions -> CommonGeneratorOptions -> AjaxReq -> Text+generateAngularJSWith ngOptions opts req = "\n" <>+    fname <> fsep <> " function(" <> argsStr <> ")\n"+ <> "{\n"+ <> "  return $http(\n"+ <> "    { url: " <> url <> "\n"+ <> dataBody+ <> reqheaders+ <> "    , method: '" <> decodeUtf8 method <> "'\n"+ <> "    });\n"+ <> "}\n"++  where argsStr = T.intercalate ", " args+        args = http+            ++ captures+            ++ map (view $ queryArgName . argPath) queryparams+            ++ body+            ++ map ( toValidFunctionName+                   . (<>) "header"+                   . view (headerArg . argPath)+                   ) hs++        -- 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 T.length (serviceName ngOptions) of+                  0 -> ["$http"]+                  _ -> []++        captures = map (view argPath . captureArg)+                 . filter isCapture+                 $ req ^. reqUrl . path++        hs = req ^. reqHeaders++        queryparams = req ^.. reqUrl.queryStr.traverse++        body = if isJust (req ^. reqBody)+                 then [requestBody opts]+                 else []++        dataBody =+          if isJust (req ^. reqBody)+            then "    , data: JSON.stringify(body)\n" <>+                 "    , contentType: 'application/json'\n"+            else ""++        reqheaders =+          if null hs+            then ""+            else "    , headers: { " <> headersStr <> " }\n"++          where+            headersStr = T.intercalate ", " $ map headerStr hs+            headerStr header = "\"" <>+              header ^. headerArg . argPath <>+              "\": " <> toJSHeader header++        namespace =+            if hasService+               then ""+               else if hasNoModule+                    then "var "+                    else (moduleName opts) <> "."+            where+                hasNoModule = moduleName opts == ""++        hasService = serviceName ngOptions /= ""++        fsep = if hasService then ":" else " ="++        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)++        method = req ^. reqMethod+        url = if url' == "'" then "'/'" else url'+        url' = "'"+           <> urlPrefix opts+           <> urlArgs+           <> queryArgs++        urlArgs = jsSegments+                $ req ^.. reqUrl.path.traverse++        queryArgs = if null queryparams+                      then ""+                      else " + '?" <> jsParams queryparams
+ src/Servant/JS/Axios.hs view
@@ -0,0 +1,137 @@+{-#LANGUAGE OverloadedStrings #-}+module Servant.JS.Axios where++import           Control.Lens+import           Data.Maybe (isJust)+import           Data.Monoid+import           Data.Text (Text)+import           Data.Text.Encoding (decodeUtf8)+import qualified Data.Text as T+import           Servant.Foreign+import           Servant.JS.Internal++-- | Axios 'configuration' type+-- Let you customize the generation using Axios capabilities+data AxiosOptions = AxiosOptions+  { -- | indicates whether or not cross-site Access-Control requests+    -- should be made using credentials+    withCredentials :: !Bool+    -- | the name of the cookie to use as a value for xsrf token+  , xsrfCookieName  :: !(Maybe Text)+    -- | the name of the header to use as a value for xsrf token+  , xsrfHeaderName  :: !(Maybe Text)+  }++-- | Default instance of the AxiosOptions+-- Defines the settings as they are in the Axios documentation+-- by default+defAxiosOptions :: AxiosOptions+defAxiosOptions = AxiosOptions+  { withCredentials = False+  , xsrfCookieName = Nothing+  , xsrfHeaderName = Nothing+  }++-- | Generate regular javacript functions that use+--   the axios library, using default values for 'CommonGeneratorOptions'.+axios :: AxiosOptions -> JavaScriptGenerator+axios aopts = axiosWith aopts defCommonGeneratorOptions++-- | Generate regular javascript functions that use the axios library.+axiosWith :: AxiosOptions -> CommonGeneratorOptions -> JavaScriptGenerator+axiosWith aopts opts = T.intercalate "\n\n" . map (generateAxiosJSWith aopts opts)++-- | js codegen using axios library using default options+generateAxiosJS :: AxiosOptions -> AjaxReq -> Text+generateAxiosJS aopts = generateAxiosJSWith aopts defCommonGeneratorOptions++-- | js codegen using axios library+generateAxiosJSWith :: AxiosOptions -> CommonGeneratorOptions -> AjaxReq -> Text+generateAxiosJSWith aopts opts req = "\n" <>+    fname <> " = function(" <> argsStr <> ")\n"+ <> "{\n"+ <> "  return axios({ url: " <> url <> "\n"+ <> "    , method: '" <> method <> "'\n"+ <> dataBody+ <> reqheaders+ <> withCreds+ <> xsrfCookie+ <> xsrfHeader+ <> "    });\n"+ <> "}\n"++  where argsStr = T.intercalate ", " args+        args = captures+            ++ map (view $ queryArgName . argPath) queryparams+            ++ body+            ++ map ( toValidFunctionName+                   . (<>) "header"+                   . view (headerArg . argPath)+                   ) hs++        captures = map (view argPath . captureArg)+                 . filter isCapture+                 $ req ^. reqUrl.path++        hs = req ^. reqHeaders++        queryparams = req ^.. reqUrl.queryStr.traverse++        body = if isJust (req ^. reqBody)+                 then [requestBody opts]+                 else []++        dataBody =+          if isJust (req ^. reqBody)+            then "    , data: body\n" <>+                 "    , responseType: 'json'\n"+            else ""++        withCreds =+          if withCredentials aopts+            then "    , withCredentials: true\n"+            else ""++        xsrfCookie =+          case xsrfCookieName aopts of+            Just name -> "    , xsrfCookieName: '" <> name <> "'\n"+            Nothing   -> ""++        xsrfHeader =+          case xsrfHeaderName aopts of+            Just name -> "    , xsrfHeaderName: '" <> name <> "'\n"+            Nothing   -> ""++        reqheaders =+          if null hs+            then ""+            else "    , headers: { " <> headersStr <> " }\n"++          where+            headersStr = T.intercalate ", " $ map headerStr hs+            headerStr header = "\"" <>+              header ^. headerArg . argPath <>+              "\": " <> toJSHeader header++        namespace =+               if hasNoModule+                  then "var "+                  else (moduleName opts) <> "."+               where+                  hasNoModule = moduleName opts == ""++        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)++        method = T.toLower . decodeUtf8 $ req ^. reqMethod+        url = if url' == "'" then "'/'" else url'+        url' = "'"+           <> urlPrefix opts+           <> urlArgs+           <> queryArgs++        urlArgs = jsSegments+                $ req ^.. reqUrl.path.traverse++        queryArgs = if null queryparams+                      then ""+                      else " + '?" <> jsParams queryparams
+ src/Servant/JS/Internal.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++module Servant.JS.Internal+  ( JavaScriptGenerator+  , CommonGeneratorOptions(..)+  , defCommonGeneratorOptions+  , AjaxReq+  , jsSegments+  , segmentToStr+  , segmentTypeToStr+  , jsParams+  , jsGParams+  , paramToStr+  , toValidFunctionName+  , toJSHeader+  -- re-exports+  , (:<|>)(..)+  , (:>)+  , defReq+  , reqHeaders+  , HasForeign(..)+  , HasForeignType(..)+  , GenerateList(..)+  , NoTypes+  , HeaderArg+  , ArgType(..)+  , HeaderArg(..)+  , QueryArg(..)+  , Req(..)+  , Segment(..)+  , SegmentType(..)+  , Url(..)+  , Path+  , Arg(..)+  , FunctionName(..)+  , PathSegment(..)+  , concatCase+  , snakeCase+  , camelCase+  , ReqBody+  , JSON+  , FormUrlEncoded+  , Post+  , Get+  , Raw+  , Header+  ) where++import           Control.Lens hiding (List)+import qualified Data.CharSet as Set+import qualified Data.CharSet.Unicode.Category as Set+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 Text. Several+-- generators are available in this package.+type JavaScriptGenerator = [Req ()] -> Text++-- | This structure is used by specific implementations to let you+-- customize the output+data CommonGeneratorOptions = CommonGeneratorOptions+  {+    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.+--+-- @+-- > defCommonGeneratorOptions = CommonGeneratorOptions+-- >   { functionNameBuilder = camelCase+-- >   , requestBody = "body"+-- >   , successCallback = "onSuccess"+-- >   , errorCallback = "onError"+-- >   , moduleName = ""+-- >   , urlPrefix = ""+-- >   }+-- @+defCommonGeneratorOptions :: CommonGeneratorOptions+defCommonGeneratorOptions = CommonGeneratorOptions+  {+    functionNameBuilder = camelCase+  , requestBody = "body"+  , successCallback = "onSuccess"+  , errorCallback = "onError"+  , moduleName = ""+  , urlPrefix = ""+  }++-- | Attempts to reduce the function name provided to that allowed by @'Foreign'@.+--+-- https://mathiasbynens.be/notes/javascript-identifiers+-- Couldn't work out how to handle zero-width characters.+--+-- @TODO: specify better default function name, or throw error?+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 || Set.member c firstLetterOK+    remainder c = prefixOK c || Set.member c remainderOK+    prefixOK c = c `elem` ['$','_']+    firstLetterOK = mconcat+                      [ Set.lowercaseLetter+                      , Set.uppercaseLetter+                      , Set.titlecaseLetter+                      , Set.modifierLetter+                      , Set.otherLetter+                      , Set.letterNumber+                      ]+    remainderOK   = firstLetterOK+               <> mconcat+                    [ Set.nonSpacingMark+                    , Set.spacingCombiningMark+                    , Set.decimalNumber+                    , Set.connectorPunctuation+                    ]++toJSHeader :: HeaderArg f -> Text+toJSHeader (HeaderArg n)+  = toValidFunctionName ("header" <> n ^. argName . _PathSegment)+toJSHeader (ReplaceHeaderArg n 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 ^. argName . _PathSegment)+    pn = "{" <> n ^. argName . _PathSegment <> "}"+    rp = T.replace pn "" p++jsSegments :: [Segment f] -> Text+jsSegments []  = ""+jsSegments [x] = "/" <> segmentToStr x False+jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs++segmentToStr :: Segment f -> Bool -> Text+segmentToStr (Segment st) notTheEnd =+  segmentTypeToStr st <> if notTheEnd then "" else "'"++segmentTypeToStr :: SegmentType f -> Text+segmentTypeToStr (Static s) = s ^. _PathSegment+segmentTypeToStr (Cap s)    =+  "' + encodeURIComponent(" <> s ^. argName . _PathSegment <> ") + '"++jsGParams :: Text -> [QueryArg f] -> Text+jsGParams _ []     = ""+jsGParams _ [x]    = paramToStr x False+jsGParams s (x:xs) = paramToStr x True <> s <> jsGParams s xs++jsParams :: [QueryArg f] -> Text+jsParams = jsGParams "&"++paramToStr :: QueryArg f -> Bool -> Text+paramToStr qarg notTheEnd =+  case qarg ^. queryArgType of+    Normal -> name+           <> "=' + encodeURIComponent("+           <> name+           <> if notTheEnd then ") + '" else ")"+    Flag   -> name <> "="+    List   -> name+           <> "[]=' + encodeURIComponent("+           <> name+           <> if notTheEnd then ") + '" else ")"+  where name = qarg ^. queryArgName . argName . _PathSegment
+ src/Servant/JS/JQuery.hs view
@@ -0,0 +1,103 @@+{-#LANGUAGE OverloadedStrings #-}+module Servant.JS.JQuery where++import           Control.Lens+import           Data.Maybe (isJust)+import           Data.Monoid+import qualified Data.Text as T+import           Data.Text (Text)+import           Data.Text.Encoding (decodeUtf8)+import           Servant.Foreign+import           Servant.JS.Internal+++-- | Generate javascript functions that use the /jQuery/ library+--   to make the AJAX calls. Uses 'defCommonGeneratorOptions'+--   for the generator options.+jquery :: JavaScriptGenerator+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 = mconcat . map (generateJQueryJSWith opts)++-- | js codegen using JQuery using default options+generateJQueryJS :: AjaxReq -> Text+generateJQueryJS = generateJQueryJSWith defCommonGeneratorOptions++-- | js codegen using JQuery+generateJQueryJSWith :: CommonGeneratorOptions -> AjaxReq -> Text+generateJQueryJSWith opts req = "\n" <>+    fname <> " = function(" <> argsStr <> ")\n"+ <> "{\n"+ <> "  $.ajax(\n"+ <> "    { url: " <> url <> "\n"+ <> "    , success: " <> onSuccess <> "\n"+ <> dataBody+ <> reqheaders+ <> "    , error: " <> onError <> "\n"+ <> "    , type: '" <> decodeUtf8 method <> "'\n"+ <> "    });\n"+ <> "}\n"++  where argsStr = T.intercalate ", " args+        args = captures+            ++ map (view $ queryArgName . argPath) queryparams+            ++ body+            ++ map (toValidFunctionName+                   . (<>) "header"+                   . view (headerArg . argPath)+                   ) hs+            ++ [onSuccess, onError]++        captures = map (view argPath . captureArg)+                 . filter isCapture+                 $ req ^. reqUrl.path++        hs = req ^. reqHeaders++        queryparams = req ^.. reqUrl.queryStr.traverse++        body = if isJust (req ^. reqBody)+                 then [requestBody opts]+                 else []++        onSuccess = successCallback opts+        onError = errorCallback opts++        dataBody =+          if isJust $ req ^. reqBody+            then "    , data: JSON.stringify(body)\n" <>+                 "    , contentType: 'application/json'\n"+            else ""++        reqheaders =+          if null hs+            then ""+            else "    , headers: { " <> headersStr <> " }\n"++          where+            headersStr = T.intercalate ", " $ map headerStr hs+            headerStr header = "\"" <>+              header ^. headerArg . argPath <>+              "\": " <> toJSHeader header++        namespace = if (moduleName opts) == ""+                       then "var "+                       else (moduleName opts) <> "."+        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)++        method = req ^. reqMethod+        url = if url' == "'" then "'/'" else url'+        url' = "'"+           <> urlPrefix opts+           <> urlArgs+           <> queryArgs++        urlArgs = jsSegments+                $ req ^.. reqUrl.path.traverse++        queryArgs = if null queryparams+                      then ""+                      else " + '?" <> jsParams queryparams
+ src/Servant/JS/Vanilla.hs view
@@ -0,0 +1,114 @@+{-#LANGUAGE OverloadedStrings #-}+module Servant.JS.Vanilla where++import           Control.Lens+import           Data.Maybe (isJust)+import           Data.Text (Text)+import           Data.Text.Encoding (decodeUtf8)+import qualified Data.Text as T+import           Data.Monoid+import           Servant.Foreign+import           Servant.JS.Internal++-- | Generate vanilla javascript functions to make AJAX requests+--   to your API, using /XMLHttpRequest/. Uses 'defCommonGeneratorOptions'+--   for the 'CommonGeneratorOptions'.+vanillaJS :: JavaScriptGenerator+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 = mconcat . map (generateVanillaJSWith opts)++-- | js codegen using XmlHttpRequest using default generation options+generateVanillaJS :: AjaxReq -> Text+generateVanillaJS = generateVanillaJSWith defCommonGeneratorOptions++-- | js codegen using XmlHttpRequest+generateVanillaJSWith :: CommonGeneratorOptions -> AjaxReq -> Text+generateVanillaJSWith opts req = "\n" <>+    fname <> " = function(" <> argsStr <> ")\n"+ <> "{\n"+ <> "  var xhr = new XMLHttpRequest();\n"+ <> "  xhr.open('" <> decodeUtf8 method <> "', " <> url <> ", true);\n"+ <>    reqheaders+ <> "  xhr.setRequestHeader(\"Accept\",\"application/json\");\n"+ <> (if isJust (req ^. reqBody) then "  xhr.setRequestHeader(\"Content-Type\",\"application/json\");\n" else "")+ <> "  xhr.onreadystatechange = function (e) {\n"+ <> "    if (xhr.readyState == 4) {\n"+ <> "      if (xhr.status == 204 || xhr.status == 205) {\n"+ <> "        onSuccess();\n"+ <> "      } else if (xhr.status >= 200 && xhr.status < 300) {\n"+ <> "        var value = JSON.parse(xhr.responseText);\n"+ <> "        onSuccess(value);\n"+ <> "      } else {\n"+ <> "        var value = JSON.parse(xhr.responseText);\n"+ <> "        onError(value);\n"+ <> "      }\n"+ <> "    }\n"+ <> "  }\n"+ <> "  xhr.send(" <> dataBody <> ");\n"+ <> "}\n"++  where argsStr = T.intercalate ", " args+        args = captures+            ++ map (view $ queryArgName . argPath) queryparams+            ++ body+            ++ map ( toValidFunctionName+                   . (<>) "header"+                   . view (headerArg . argPath)+                   ) hs+            ++ [onSuccess, onError]++        captures = map (view argPath . captureArg)+                 . filter isCapture+                 $ req ^. reqUrl.path++        hs = req ^. reqHeaders++        queryparams = req ^.. reqUrl.queryStr.traverse++        body = if isJust(req ^. reqBody)+                 then [requestBody opts]+                 else []++        onSuccess = successCallback opts+        onError = errorCallback opts++        dataBody =+          if isJust (req ^. reqBody)+            then "JSON.stringify(body)\n"+            else "null"+++        reqheaders =+          if null hs+            then ""+            else headersStr <> "\n"++          where+            headersStr = T.intercalate "\n" $ map headerStr hs+            headerStr header = "  xhr.setRequestHeader(\"" <>+              header ^. headerArg . argPath <>+              "\", " <> toJSHeader header <> ");"++        namespace = if moduleName opts == ""+                       then "var "+                       else (moduleName opts) <> "."+        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)++        method = req ^. reqMethod+        url = if url' == "'" then "'/'" else url'+        url' = "'"+           <> urlPrefix opts+           <> urlArgs+           <> queryArgs++        urlArgs = jsSegments+                $ req ^.. reqUrl.path.traverse++        queryArgs = if null queryparams+                      then ""+                      else " + '?" <> jsParams queryparams
+ test/Servant/JSSpec.hs view
@@ -0,0 +1,204 @@+{-# 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)+import           Data.Monoid                  ()+import           Data.Monoid.Compat           ((<>))+import           Data.Proxy+import           Data.Text                    (Text)+import qualified Data.Text                    as T+import           Language.ECMAScript3.Parser  (program, parse)+import           Prelude                      ()+import           Prelude.Compat+import           Test.Hspec  hiding (shouldContain, shouldNotContain)++import           Servant.API.Internal.Test.ComprehensiveAPI+import           Servant.JS+import           Servant.JS.Internal+import qualified Servant.JS.Angular           as NG+import qualified Servant.JS.Axios             as AX+import qualified Servant.JS.JQuery            as JQ+import qualified Servant.JS.Vanilla           as JS+import           Servant.JSSpec.CustomHeaders++-- * comprehensive api++-- This declaration simply checks that all instances are in place.+_ = jsForAPI comprehensiveAPI vanillaJS :: Text++-- * specs++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" Text+                                     :> Get '[JSON] Int++type CustomAuthAPI = "something" :> Authorization "Basic" Text+                                 :> Get '[JSON] Int++type CustomHeaderAPI = "something" :> MyLovelyHorse Text+                                   :> Get '[JSON] Int++type CustomHeaderAPI2 = "something" :> WhatsForDinner Text+                                    :> Get '[JSON] Int++headerHandlingProxy :: Proxy HeaderHandlingAPI+headerHandlingProxy = Proxy++customAuthProxy :: Proxy CustomAuthAPI+customAuthProxy = Proxy++customHeaderProxy :: Proxy CustomHeaderAPI+customHeaderProxy = Proxy++customHeaderProxy2 :: Proxy CustomHeaderAPI2+customHeaderProxy2 = Proxy++data TestNames = Vanilla+               | VanillaCustom+               | JQuery+               | JQueryCustom+               | Angular+               | AngularCustom+               | Axios+               | AxiosCustom+                 deriving (Show, Eq)++customOptions :: CommonGeneratorOptions+customOptions = defCommonGeneratorOptions+  { successCallback = "okCallback"+  , errorCallback = "errorCallback"+  }++spec :: Spec+spec = describe "Servant.JQuery" $ do+    generateJSSpec Vanilla       JS.generateVanillaJS+    generateJSSpec VanillaCustom (JS.generateVanillaJSWith customOptions)+    generateJSSpec JQuery        JQ.generateJQueryJS+    generateJSSpec JQueryCustom  (JQ.generateJQueryJSWith customOptions)+    generateJSSpec Angular       (NG.generateAngularJS NG.defAngularOptions)+    generateJSSpec AngularCustom (NG.generateAngularJSWith NG.defAngularOptions customOptions)+    generateJSSpec Axios        (AX.generateAxiosJS AX.defAxiosOptions)+    generateJSSpec AxiosCustom  (AX.generateAxiosJSWith (AX.defAxiosOptions { AX.withCredentials = True }) customOptions)++    angularSpec    Angular+    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+    let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) (Proxy :: Proxy TestAPI)+    it "should add withCredentials when needed" $ do+        let jsText = genJS withCredOpts $ reqList+        output jsText+        jsText `shouldContain` "withCredentials: true"+    it "should add xsrfCookieName when needed" $ do+        let jsText = genJS cookieOpts $ reqList+        output jsText+        jsText `shouldContain` ("xsrfCookieName: 'MyXSRFcookie'")+    it "should add withCredentials when needed" $ do+        let jsText = genJS headerOpts $ reqList+        output jsText+        jsText `shouldContain` ("xsrfHeaderName: 'MyXSRFheader'")+    where+        specLabel = "Axios"+        output _ = return ()+        withCredOpts = AX.defAxiosOptions { AX.withCredentials = True }+        cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" }+        headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" }+        genJS :: AxiosOptions -> [AjaxReq] -> Text+        genJS opts req = mconcat . map (AX.generateAxiosJS opts) $ req++angularSpec :: TestNames -> Spec+angularSpec test = describe specLabel $ do+    let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) (Proxy :: Proxy TestAPI)+    it "should implement a service globally" $ do+        let jsText = genJS reqList+        output jsText+        jsText `shouldContain` (".service('" <> testName <> "'")++    it "should depend on $http service globally" $ do+        let jsText = genJS reqList+        output jsText+        jsText `shouldContain` ("('" <> testName <> "', function($http) {")++    it "should not depend on $http service in handlers" $ do+        let jsText = genJS reqList+        output jsText+        jsText `shouldNotContain` "getsomething($http, "+    where+        specLabel = "AngularJS(" <> (show test) <> ")"+        output _ = return ()+        testName = "MyService"+        ngOpts = NG.defAngularOptions { NG.serviceName = testName }+        genJS req = NG.angularService ngOpts req++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) (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")+        parseFromText (genJS $ topLevel "GET") `shouldSatisfy` isRight++    it "should handle simple HTTP headers" $ do+        let jsText = genJS $ javascript headerHandlingProxy+        output jsText+        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+        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+        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+        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) (mconcat . map gen)+        parseFromText jsStr `shouldSatisfy` isRight+    where+        specLabel = "generateJS(" <> (show n) <> ")"+        output _ = return ()+        genJS req = gen req+        header :: TestNames -> Text -> Text -> Text+        header v headerName headerValue+            | v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" <> headerName <> "\", " <> headerValue <> ");\n"+            | otherwise = "headers: { \"" <> headerName <> "\": " <> headerValue <> " }\n"
+ test/Servant/JSSpec/CustomHeaders.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE KindSignatures      #-}+{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE MultiParamTypeClasses #-}++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++-- | This is a hypothetical combinator that fetches an Authorization header.+-- The symbol in the header denotes what kind of authentication we are+-- using -- Basic, Digest, whatever.+data Authorization (sym :: Symbol) a++instance (KnownSymbol sym, HasForeign lang () sublayout)+    => HasForeign lang () (Authorization sym a :> sublayout) where+    type Foreign () (Authorization sym a :> sublayout) = Foreign () sublayout++    foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $+        req & reqHeaders <>~+          [ ReplaceHeaderArg (Arg "Authorization" ())+          $ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]+      where+        tokenType t = t <> " {Authorization}"++-- | This is a combinator that fetches an X-MyLovelyHorse header.+data MyLovelyHorse a++instance (HasForeign lang () sublayout)+    => HasForeign lang () (MyLovelyHorse a :> sublayout) where+    type Foreign () (MyLovelyHorse a :> sublayout) = Foreign () sublayout++    foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $+        req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" ()) tpl ]+      where+        tpl = "I am good friends with {X-MyLovelyHorse}"++-- | This is a combinator that fetches an X-WhatsForDinner header.+data WhatsForDinner a++instance (HasForeign lang () sublayout)+    => HasForeign lang () (WhatsForDinner a :> sublayout) where+    type Foreign () (WhatsForDinner a :> sublayout) = Foreign () sublayout++    foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $+        req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" ()) tpl ]+      where+        tpl = "I would like {X-WhatsForDinner} with a cherry on top."
+ test/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+