168 lines
5.2 KiB
Haskell
168 lines
5.2 KiB
Haskell
{-#LANGUAGE OverloadedStrings #-}
|
|
module Servant.JS.Internal
|
|
( JavaScriptGenerator
|
|
, CommonGeneratorOptions(..)
|
|
, defCommonGeneratorOptions
|
|
, AjaxReq
|
|
, jsSegments
|
|
, segmentToStr
|
|
, segmentTypeToStr
|
|
, jsParams
|
|
, jsGParams
|
|
, jsMParams
|
|
, paramToStr
|
|
, toValidFunctionName
|
|
, toJSHeader
|
|
-- re-exports
|
|
, (:<|>)(..)
|
|
, (:>)
|
|
, defReq
|
|
, reqHeaders
|
|
, HasForeign(..)
|
|
, HeaderArg(..)
|
|
, concatCase
|
|
, snakeCase
|
|
, camelCase
|
|
, ReqBody
|
|
, JSON
|
|
, FormUrlEncoded
|
|
, Post
|
|
, Get
|
|
, Raw
|
|
, Header
|
|
) where
|
|
|
|
import Control.Lens ((^.))
|
|
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 -> Text
|
|
toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n)
|
|
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)
|
|
pn = "{" <> n <> "}"
|
|
rp = T.replace pn "" p
|
|
|
|
jsSegments :: [Segment] -> Text
|
|
jsSegments [] = ""
|
|
jsSegments [x] = "/" <> segmentToStr x False
|
|
jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs
|
|
|
|
segmentToStr :: Segment -> Bool -> Text
|
|
segmentToStr (Segment st ms) notTheEnd =
|
|
segmentTypeToStr st <> jsMParams ms <> if notTheEnd then "" else "'"
|
|
|
|
segmentTypeToStr :: SegmentType -> Text
|
|
segmentTypeToStr (Static s) = s
|
|
segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> s <> ") + '"
|
|
|
|
jsGParams :: Text -> [QueryArg] -> Text
|
|
jsGParams _ [] = ""
|
|
jsGParams _ [x] = paramToStr x False
|
|
jsGParams s (x:xs) = paramToStr x True <> s <> jsGParams s xs
|
|
|
|
jsParams :: [QueryArg] -> Text
|
|
jsParams = jsGParams "&"
|
|
|
|
jsMParams :: [MatrixArg] -> Text
|
|
jsMParams [] = ""
|
|
jsMParams xs = ";" <> jsGParams ";" xs
|
|
|
|
paramToStr :: QueryArg -> Bool -> Text
|
|
paramToStr qarg notTheEnd =
|
|
case qarg ^. argType of
|
|
Normal -> name
|
|
<> "=' + encodeURIComponent("
|
|
<> name
|
|
<> if notTheEnd then ") + '" else ")"
|
|
Flag -> name <> "="
|
|
List -> name
|
|
<> "[]=' + encodeURIComponent("
|
|
<> name
|
|
<> if notTheEnd then ") + '" else ")"
|
|
where name = qarg ^. argName
|