Provide URL Prefix as JS function argument

[quantifiedtran]

I'm writing a server which isn't necessarily accessed from a browser front end or on the same domain as the server itself. Because of this, it would be necessary to provide the address of the server as an additional argument to the generated javascript functions as so:

var getX = function( onSuccess
                   , onError
                   , serverAddress) // The additional server address argument
{
  // ...
  xhr.open('GET'
          , serverAddress + '/x' // Preappend the server address to the route
          , true);
  // ...
}

But I've not found an option to do so that's not generating and modifying the API by hand constantly.

[phadej]

shouldn't be hard to do! servant-client asks for BaseUrl too.

[quantifiedtran]

I've found a workaround for now, for an app myApp:

-- Set a module name & a hacky way to refer to a variable in the generated code 
myAppJSAPIOptions = defCommonGeneratorOptions { 
      moduleName = "myAppModule" 
    , urlPrefix = "\' + address + \'" 
}

using this, generate the text of the API, then append the following to the beginning of the generated text:

export function myAppAPI(address) {
  let myAppModule = {};

and append the following to the end of the text:

  return myAppModule;
}

An example using the project I'm working on: https://github.com/quantifiedtran/blue-wire-backend/blob/3bfc4706959e33983143fb911b7fda3e272f70bd/src/BlueWire/APIGen.hs

and the code it generates: https://github.com/quantifiedtran/blue-wire-backend/blob/3bfc4706959e33983143fb911b7fda3e272f70bd/api/js/blue-wire-api.js

[phlummox]

... alternatively, servant-js exposes enough of its internals that it's pretty straightforward to write a "tweaked" version of generateVanillaJSWith with different behaviour.

I wrote the following against servant 0.15 and servant 0.15 and servant-js 0.9.4, but I think it probably still works for newer versions. (There may be a few unnecessary imports or extensions - I basically just copied and pasted from my source code.) It also addresses #43 - if response bodies are parseable as JSON, then they'll be parsed, else the plain response body is passed on.

Seems to work so far - I'll let you know if I encounter any problems.

SomeModule.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}

{- | Tweaked versions of vanilla JS functions  -}

module SomeModule
  where

import Control.Monad
import Control.Lens

import  Data.Maybe
import  Data.Proxy
import qualified  Data.Text as T
import  Data.Text ( Text )
import  Data.Text.Encoding

import Servant.Foreign     (
                              (:>)
                            , argPath, captureArg, headerArg, isCapture
                            , path, queryArgName, queryStr, reqBody
                            , reqBodyContentType
                            , ReqBodyContentType(ReqBodyJSON)
                            , reqFuncName, reqMethod, reqUrl
                            )
import Servant.JS           (
                              errorCallback
                            , functionNameBuilder
                            , jsForAPI
                            , JavaScriptGenerator
                            , moduleName
                            , requestBody
                            , successCallback
                            , urlPrefix
                            , writeJSForAPI
                            )
import Servant.JS.Internal (
                              AjaxReq
                            , CommonGeneratorOptions
                            , defCommonGeneratorOptions
                            , jsParams
                            , jsSegments
                            , reqHeaders
                            , toJSHeader
                            , toValidFunctionName
                            )

-- | Custom code generation - a tweaked variant of 'generateVanillaJSWith'.
--
-- The generated functions
--
-- * don't assume API responses are always JSON
-- * take a URL prefix as their first parameter.
generateVanillaJSWith' :: CommonGeneratorOptions -> AjaxReq -> Text
generateVanillaJSWith' opts req = "\n" <>
     fname <> " = function(" <> argsStr <> ") {\n"
  <> "  var xhr = new XMLHttpRequest();\n"
-- the JS function now prefixes a "urlPrefix" argument (supplied at JS runtime) to the URL: 
  <> "  xhr.open('" <> decodeUtf8 method <> "', urlPrefix + " <> url <> ", true);\n"
  <>    reqheaders
  <> "  xhr.setRequestHeader('Accept', 'application/json');\n"
  <> (if isJust (req ^. reqBody) && (req ^. reqBodyContentType == ReqBodyJSON)  then "  xhr.setRequestHeader('Content-Type', 'application/json');\n" else "")
  <> "  xhr.onreadystatechange = function () {\n"
  <> "    var res = null;\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"
-- we amend the response-parsing behaviour:
  <> "        try { res = JSON.parse(xhr.responseText); } catch (e) { " <> onSuccess <> "(xhr.responseText); }\n"
  <> "        if (res) " <> onSuccess <> "(res);\n"
  <> "      } else {\n"
  <> "        try { res = JSON.parse(xhr.responseText); } catch (e) { " <> onError <> "(xhr.responseText); }\n"
  <> "        if (res) " <> onError <> "(res);\n"
  <> "      }\n"
  <> "    }\n"
  <> "  };\n"
  <> "  xhr.send(" <> dataBody <> ");\n"
  <> "};\n"

  where
        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 if req ^. reqBodyContentType == ReqBodyJSON then "JSON.stringify(body)" else "body"
            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 <> toValidFunctionName (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

        argsStr = T.intercalate ", " args
        args =
            -- the first argument to the function - before any captures etc. - is "urlPrefix".
            -- might be more convenient to make it the last argument, though, and allow it
            -- to be null
               ["urlPrefix"]
            ++ captures
            ++ map (view $ queryArgName . argPath) queryparams
            ++ body
            ++ map ( toValidFunctionName
                   . (<>) "header"
                   . view (headerArg . argPath)
                   ) hs
            ++ [onSuccess, onError]

vanillaJs' :: JavaScriptGenerator
vanillaJs' = vanillaJSWith' defCommonGeneratorOptions

vanillaJSWith' :: CommonGeneratorOptions -> JavaScriptGenerator
vanillaJSWith' opts = mconcat . map (generateVanillaJSWith' opts)