Extract common code-generation stuff to servant-foreign
This commit is contained in:
Denis Redozubov
parent
9f13684afa
commit
ce3e4f7193
|
|
@ -0,0 +1,4 @@
|
|||
0.1
|
||||
-----
|
||||
|
||||
* Extract javascript-oblivious types and helpers to *servant-foreign*
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
Copyright (c) 2014, Zalora South East Asia Pte Ltd
|
||||
|
||||
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.
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
# servant-foreign
|
||||
|
||||
|
||||
|
||||
Types and helpers for generating clients for *servant* servers in arbitrary programming languages.
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
name: servant-foreign
|
||||
version: 0.1.0.0
|
||||
synopsis: Abstract all necessary info for client code-generation in arbitrary programming language.
|
||||
description: Consolidates such projects as servant-js and lackey.
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Denis Redozubov
|
||||
maintainer: denis.redozubov@gmail.com
|
||||
copyright: 2015 Denis Redozubov, Alp Mestanogullari
|
||||
category: Web
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
extra-source-files:
|
||||
CHANGELOG.md
|
||||
README.md
|
||||
source-repository head
|
||||
type: git
|
||||
location: http://github.com/haskell-servant/servant.git
|
||||
|
||||
library
|
||||
exposed-modules: Servant.Foreign
|
||||
build-depends: base >=4.8 && <5
|
||||
, charset
|
||||
, lens >= 4
|
||||
, servant >= 0.5
|
||||
, text
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
|
@ -0,0 +1,409 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
-- | Generalizes all the data needed to make code generation work with
|
||||
-- arbitrary programming languages.
|
||||
module Servant.Foreign
|
||||
( HasForeign(..)
|
||||
, Segment(..)
|
||||
, SegmentType(..)
|
||||
, MatrixArg
|
||||
, FunctionName
|
||||
, QueryArg(..)
|
||||
, HeaderArg(..)
|
||||
, ArgType(..)
|
||||
, Req
|
||||
, CommonGeneratorOptions(..)
|
||||
, defCommonGeneratorOptions
|
||||
, toValidFunctionName
|
||||
, captureArg
|
||||
, defReq
|
||||
, concatCase
|
||||
, snakeCase
|
||||
, camelCase
|
||||
-- lenses
|
||||
, argType
|
||||
, argName
|
||||
, isCapture
|
||||
, funcName
|
||||
, path
|
||||
, reqUrl
|
||||
, reqBody
|
||||
, reqHeaders
|
||||
, reqMethod
|
||||
, segment
|
||||
, queryStr
|
||||
-- re-exports
|
||||
, module Servant.API
|
||||
) where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative
|
||||
#endif
|
||||
import Control.Lens hiding (List)
|
||||
import Data.Char (toLower, toUpper)
|
||||
import qualified Data.CharSet as Set
|
||||
import qualified Data.CharSet.Unicode.Category as Set
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Data.Proxy
|
||||
import qualified Data.Text as T
|
||||
import GHC.Exts (Constraint)
|
||||
import GHC.TypeLits
|
||||
import Servant.API
|
||||
|
||||
-- | 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
|
||||
}
|
||||
|
||||
-- | 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 = ""
|
||||
}
|
||||
|
||||
-- | Function name builder that simply concat each part together
|
||||
concatCase :: FunctionName -> String
|
||||
concatCase = concat
|
||||
|
||||
-- | Function name builder using the snake_case convention.
|
||||
-- each part is separated by a single underscore character.
|
||||
snakeCase :: FunctionName -> String
|
||||
snakeCase = intercalate "_"
|
||||
|
||||
-- | Function name builder using the CamelCase convention.
|
||||
-- each part begins with an upper case character.
|
||||
camelCase :: FunctionName -> String
|
||||
camelCase [] = ""
|
||||
camelCase (p:ps) = concat $ p : camelCase' ps
|
||||
where camelCase' [] = []
|
||||
camelCase' (r:rs) = capitalize r : camelCase' rs
|
||||
capitalize [] = []
|
||||
capitalize (x:xs) = toUpper x : xs
|
||||
|
||||
type Arg = String
|
||||
|
||||
data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] }
|
||||
deriving (Eq, Show)
|
||||
|
||||
data SegmentType = Static String -- ^ a static path segment. like "/foo"
|
||||
| Cap Arg -- ^ a capture. like "/:userid"
|
||||
deriving (Eq, Show)
|
||||
|
||||
type Path = [Segment]
|
||||
|
||||
data ArgType =
|
||||
Normal
|
||||
| Flag
|
||||
| List
|
||||
deriving (Eq, Show)
|
||||
|
||||
data QueryArg = QueryArg
|
||||
{ _argName :: Arg
|
||||
, _argType :: ArgType
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data HeaderArg = HeaderArg
|
||||
{ headerArgName :: String
|
||||
}
|
||||
| ReplaceHeaderArg
|
||||
{ headerArgName :: String
|
||||
, headerPattern :: String
|
||||
} deriving (Eq)
|
||||
|
||||
|
||||
-- |
|
||||
instance Show HeaderArg where
|
||||
show (HeaderArg n) = toValidFunctionName ("header" <> n)
|
||||
show (ReplaceHeaderArg n p)
|
||||
| pn `isPrefixOf` p = pv <> " + \"" <> rp <> "\""
|
||||
| pn `isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
|
||||
| pn `isInfixOf` p = "\"" <> (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
|
||||
|
||||
-- | Attempts to reduce the function name provided to that allowed by @'Foreign'@.
|
||||
--
|
||||
-- Here we are making an assumption that js identifiers are common enough.
|
||||
-- https://mathiasbynens.be/notes/javascript-identifiers
|
||||
-- Couldn't work out how to handle zero-width characters.
|
||||
-- TODO: compare it with other generated languages(such as ruby via lackey)
|
||||
-- and generalize.
|
||||
--
|
||||
-- @TODO: specify better default function name, or throw error?
|
||||
toValidFunctionName :: String -> String
|
||||
toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs
|
||||
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
|
||||
prefixOK c = c `elem` ['$','_']
|
||||
-- Unicode character sets
|
||||
firstLetterOK = [ Set.lowercaseLetter
|
||||
, Set.uppercaseLetter
|
||||
, Set.titlecaseLetter
|
||||
, Set.modifierLetter
|
||||
, Set.otherLetter
|
||||
, Set.letterNumber ]
|
||||
remainderOK = firstLetterOK <> [ Set.nonSpacingMark
|
||||
, Set.spacingCombiningMark
|
||||
, Set.decimalNumber
|
||||
, Set.connectorPunctuation ]
|
||||
toValidFunctionName [] = "_"
|
||||
|
||||
type MatrixArg = QueryArg
|
||||
|
||||
data Url = Url
|
||||
{ _path :: Path
|
||||
, _queryStr :: [QueryArg]
|
||||
} deriving (Eq, Show)
|
||||
|
||||
defUrl :: Url
|
||||
defUrl = Url [] []
|
||||
|
||||
type FunctionName = [String]
|
||||
type Method = String
|
||||
|
||||
data Req = Req
|
||||
{ _reqUrl :: Url
|
||||
, _reqMethod :: Method
|
||||
, _reqHeaders :: [HeaderArg]
|
||||
, _reqBody :: Bool
|
||||
, _funcName :: FunctionName
|
||||
} deriving (Eq, Show)
|
||||
|
||||
makeLenses ''QueryArg
|
||||
makeLenses ''Segment
|
||||
makeLenses ''Url
|
||||
makeLenses ''Req
|
||||
|
||||
isCapture :: Segment -> Bool
|
||||
isCapture (Segment (Cap _) _) = True
|
||||
isCapture _ = False
|
||||
|
||||
captureArg :: Segment -> Arg
|
||||
captureArg (Segment (Cap s) _) = s
|
||||
captureArg _ = error "captureArg called on non capture"
|
||||
|
||||
defReq :: Req
|
||||
defReq = Req defUrl "GET" [] False []
|
||||
|
||||
type family Elem (a :: *) (ls::[*]) :: Constraint where
|
||||
Elem a '[] = 'False ~ 'True
|
||||
Elem a (a ': list) = ()
|
||||
Elem a (b ': list) = Elem a list
|
||||
|
||||
class HasForeign (layout :: *) where
|
||||
type Foreign layout :: *
|
||||
foreignFor :: Proxy layout -> Req -> Foreign layout
|
||||
|
||||
instance (HasForeign a, HasForeign b)
|
||||
=> HasForeign (a :<|> b) where
|
||||
type Foreign (a :<|> b) = Foreign a :<|> Foreign b
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy a) req
|
||||
:<|> foreignFor (Proxy :: Proxy b) req
|
||||
|
||||
instance (KnownSymbol sym, HasForeign sublayout)
|
||||
=> HasForeign (Capture sym a :> sublayout) where
|
||||
type Foreign (Capture sym a :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.path <>~ [Segment (Cap str) []]
|
||||
& funcName %~ (++ ["by", str])
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance Elem JSON list => HasForeign (Delete list a) where
|
||||
type Foreign (Delete list a) = Req
|
||||
|
||||
foreignFor Proxy req =
|
||||
req & funcName %~ ("delete" :)
|
||||
& reqMethod .~ "DELETE"
|
||||
|
||||
instance Elem JSON list => HasForeign (Get list a) where
|
||||
type Foreign (Get list a) = Req
|
||||
|
||||
foreignFor Proxy req =
|
||||
req & funcName %~ ("get" :)
|
||||
& reqMethod .~ "GET"
|
||||
|
||||
instance (KnownSymbol sym, HasForeign sublayout)
|
||||
=> HasForeign (Header sym a :> sublayout) where
|
||||
type Foreign (Header sym a :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])
|
||||
|
||||
where hname = symbolVal (Proxy :: Proxy sym)
|
||||
subP = Proxy :: Proxy sublayout
|
||||
|
||||
instance Elem JSON list => HasForeign (Post list a) where
|
||||
type Foreign (Post list a) = Req
|
||||
|
||||
foreignFor Proxy req =
|
||||
req & funcName %~ ("post" :)
|
||||
& reqMethod .~ "POST"
|
||||
|
||||
instance Elem JSON list => HasForeign (Put list a) where
|
||||
type Foreign (Put list a) = Req
|
||||
|
||||
foreignFor Proxy req =
|
||||
req & funcName %~ ("put" :)
|
||||
& reqMethod .~ "PUT"
|
||||
|
||||
instance (KnownSymbol sym, HasForeign sublayout)
|
||||
=> HasForeign (QueryParam sym a :> sublayout) where
|
||||
type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.queryStr <>~ [QueryArg str Normal]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance (KnownSymbol sym, HasForeign sublayout)
|
||||
=> HasForeign (QueryParams sym a :> sublayout) where
|
||||
type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.queryStr <>~ [QueryArg str List]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance (KnownSymbol sym, HasForeign sublayout)
|
||||
=> HasForeign (QueryFlag sym :> sublayout) where
|
||||
type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.queryStr <>~ [QueryArg str Flag]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance (KnownSymbol sym, HasForeign sublayout)
|
||||
=> HasForeign (MatrixParam sym a :> sublayout) where
|
||||
type Foreign (MatrixParam sym a :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
strArg = str ++ "Value"
|
||||
|
||||
instance (KnownSymbol sym, HasForeign sublayout)
|
||||
=> HasForeign (MatrixParams sym a :> sublayout) where
|
||||
type Foreign (MatrixParams sym a :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.path._last.matrix <>~ [QueryArg str List]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance (KnownSymbol sym, HasForeign sublayout)
|
||||
=> HasForeign (MatrixFlag sym :> sublayout) where
|
||||
type Foreign (MatrixFlag sym :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.path._last.matrix <>~ [QueryArg str Flag]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance HasForeign Raw where
|
||||
type Foreign Raw = Method -> Req
|
||||
|
||||
foreignFor Proxy req method =
|
||||
req & funcName %~ ((toLower <$> method) :)
|
||||
& reqMethod .~ method
|
||||
|
||||
instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where
|
||||
type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqBody .~ True
|
||||
|
||||
instance (KnownSymbol path, HasForeign sublayout)
|
||||
=> HasForeign (path :> sublayout) where
|
||||
type Foreign (path :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.path <>~ [Segment (Static str) []]
|
||||
& funcName %~ (++ [str])
|
||||
|
||||
where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path)
|
||||
|
||||
instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where
|
||||
type Foreign (RemoteHost :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) req
|
||||
|
||||
instance HasForeign sublayout => HasForeign (IsSecure :> sublayout) where
|
||||
type Foreign (IsSecure :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) req
|
||||
|
||||
instance HasForeign sublayout => HasForeign (Vault :> sublayout) where
|
||||
type Foreign (Vault :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) req
|
||||
|
||||
instance HasForeign sublayout => HasForeign (HttpVersion :> sublayout) where
|
||||
type Foreign (HttpVersion :> sublayout) = Foreign sublayout
|
||||
|
||||
foreignFor Proxy req =
|
||||
foreignFor (Proxy :: Proxy sublayout) req
|
||||
|
|
@ -37,14 +37,12 @@ library
|
|||
exposed-modules: Servant.JS
|
||||
Servant.JS.Angular
|
||||
Servant.JS.Axios
|
||||
Servant.JS.Internal
|
||||
Servant.JS.JQuery
|
||||
Servant.JS.Vanilla
|
||||
Servant.JS.Internal
|
||||
build-depends: base >=4.5 && <5
|
||||
, charset
|
||||
, lens >= 4
|
||||
, servant == 0.5.*
|
||||
, text
|
||||
, servant-foreign
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
|
@ -59,16 +57,16 @@ executable counter
|
|||
else
|
||||
buildable: False
|
||||
|
||||
build-depends:
|
||||
aeson
|
||||
, base
|
||||
, filepath
|
||||
, servant == 0.5.*
|
||||
, servant-server == 0.5.*
|
||||
, servant-js == 0.5.*
|
||||
, stm
|
||||
, transformers
|
||||
, warp
|
||||
build-depends: aeson
|
||||
, base
|
||||
, filepath
|
||||
, lens >= 4
|
||||
, servant
|
||||
, servant-server
|
||||
, servant-js
|
||||
, stm
|
||||
, transformers
|
||||
, warp
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite spec
|
||||
|
|
@ -76,12 +74,12 @@ test-suite spec
|
|||
hs-source-dirs: test
|
||||
ghc-options: -Wall
|
||||
main-is: Spec.hs
|
||||
build-depends:
|
||||
base == 4.*
|
||||
, lens
|
||||
, servant-js
|
||||
, servant
|
||||
, hspec >= 2.1.8
|
||||
, hspec-expectations
|
||||
, language-ecmascript >= 0.16
|
||||
default-language: Haskell2010
|
||||
build-depends: base == 4.*
|
||||
, hspec >= 2.1.8
|
||||
, hspec-expectations
|
||||
, language-ecmascript >= 0.16
|
||||
, lens
|
||||
, lens >= 4
|
||||
, servant
|
||||
, servant-js
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
|
|
@ -76,7 +76,7 @@ module Servant.JS
|
|||
, JavaScriptGenerator
|
||||
|
||||
, -- * Options common to all generators
|
||||
CommonGeneratorOptions(..)
|
||||
CommonGeneratorOptions
|
||||
, defCommonGeneratorOptions
|
||||
|
||||
, -- * Function renamers
|
||||
|
|
@ -109,13 +109,10 @@ module Servant.JS
|
|||
, -- * Misc.
|
||||
listFromAPI
|
||||
, javascript
|
||||
, HasJS(..)
|
||||
, GenerateList(..)
|
||||
, AjaxReq
|
||||
) where
|
||||
|
||||
import Data.Proxy
|
||||
import Servant.API
|
||||
import Servant.JS.Angular
|
||||
import Servant.JS.Axios
|
||||
import Servant.JS.Internal
|
||||
|
|
@ -125,13 +122,13 @@ import Servant.JS.Vanilla
|
|||
-- | Generate the data necessary to generate javascript code
|
||||
-- for all the endpoints of an API, as ':<|>'-separated values
|
||||
-- of type 'AjaxReq'.
|
||||
javascript :: HasJS layout => Proxy layout -> JS layout
|
||||
javascript p = javascriptFor p defReq
|
||||
javascript :: HasForeign layout => Proxy layout -> Foreign layout
|
||||
javascript p = foreignFor 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 :: (HasJS api, GenerateList (JS api))
|
||||
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
|
||||
|
|
@ -140,7 +137,7 @@ jsForAPI p gen = gen (listFromAPI 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 :: (HasJS api, GenerateList (JS api))
|
||||
writeJSForAPI :: (HasForeign 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
|
||||
|
|
@ -161,5 +158,6 @@ instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> res
|
|||
|
||||
-- | Generate the necessary data for JS codegen as a list, each 'AjaxReq'
|
||||
-- describing one endpoint from your API type.
|
||||
listFromAPI :: (HasJS api, GenerateList (JS api)) => Proxy api -> [AjaxReq]
|
||||
listFromAPI :: (HasForeign api, GenerateList (Foreign api)) => Proxy api -> [AjaxReq]
|
||||
listFromAPI p = generateList (javascript p)
|
||||
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@ module Servant.JS.Angular where
|
|||
import Control.Lens
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Servant.Foreign
|
||||
import Servant.JS.Internal
|
||||
|
||||
-- | Options specific to the angular code generator
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ import Control.Lens
|
|||
import Data.Char (toLower)
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Servant.Foreign
|
||||
import Servant.JS.Internal
|
||||
|
||||
-- | Axios 'configuration' type
|
||||
|
|
|
|||
|
|
@ -1,206 +1,43 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Servant.JS.Internal where
|
||||
module Servant.JS.Internal
|
||||
( JavaScriptGenerator
|
||||
, AjaxReq
|
||||
, jsSegments
|
||||
, segmentToStr
|
||||
, segmentTypeToStr
|
||||
, jsParams
|
||||
, jsGParams
|
||||
, jsMParams
|
||||
, paramToStr
|
||||
-- re-exports
|
||||
, (:<|>)(..)
|
||||
, (:>)
|
||||
, defReq
|
||||
, defCommonGeneratorOptions
|
||||
, reqHeaders
|
||||
, CommonGeneratorOptions(..)
|
||||
, HasForeign(..)
|
||||
, HeaderArg(..)
|
||||
, concatCase
|
||||
, snakeCase
|
||||
, camelCase
|
||||
, ReqBody
|
||||
, JSON
|
||||
, FormUrlEncoded
|
||||
, Post
|
||||
, Get
|
||||
, Raw
|
||||
, Header
|
||||
) where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative
|
||||
#endif
|
||||
import Control.Lens hiding (List)
|
||||
import Data.Char (toLower, toUpper)
|
||||
import qualified Data.CharSet as Set
|
||||
import qualified Data.CharSet.Unicode.Category as Set
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Data.Proxy
|
||||
import qualified Data.Text as T
|
||||
import GHC.Exts (Constraint)
|
||||
import GHC.TypeLits
|
||||
import Servant.API
|
||||
import Servant.Foreign
|
||||
|
||||
-- | this structure is used by JavaScriptGenerator 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 js function (empty mean local var)
|
||||
, urlPrefix :: String -- ^ a prefix we should add to the Url in the JS 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 = ""
|
||||
}
|
||||
|
||||
-- | Function name builder that simply concat each part together
|
||||
concatCase :: FunctionName -> String
|
||||
concatCase = concat
|
||||
|
||||
-- | Function name builder using the snake_case convention.
|
||||
-- each part is separated by a single underscore character.
|
||||
snakeCase :: FunctionName -> String
|
||||
snakeCase = intercalate "_"
|
||||
|
||||
-- | Function name builder using the CamelCase convention.
|
||||
-- each part begins with an upper case character.
|
||||
camelCase :: FunctionName -> String
|
||||
camelCase [] = ""
|
||||
camelCase (p:ps) = concat $ p : camelCase' ps
|
||||
where camelCase' [] = []
|
||||
camelCase' (r:rs) = capitalize r : camelCase' rs
|
||||
capitalize [] = []
|
||||
capitalize (x:xs) = toUpper x : xs
|
||||
|
||||
type Arg = String
|
||||
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
|
||||
-- generators are available in this package.
|
||||
type JavaScriptGenerator = [AjaxReq] -> String
|
||||
|
||||
data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] }
|
||||
deriving (Eq, Show)
|
||||
|
||||
data SegmentType = Static String -- ^ a static path segment. like "/foo"
|
||||
| Cap Arg -- ^ a capture. like "/:userid"
|
||||
deriving (Eq, Show)
|
||||
|
||||
type Path = [Segment]
|
||||
|
||||
data ArgType =
|
||||
Normal
|
||||
| Flag
|
||||
| List
|
||||
deriving (Eq, Show)
|
||||
|
||||
data QueryArg = QueryArg
|
||||
{ _argName :: Arg
|
||||
, _argType :: ArgType
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data HeaderArg = HeaderArg
|
||||
{ headerArgName :: String
|
||||
}
|
||||
| ReplaceHeaderArg
|
||||
{ headerArgName :: String
|
||||
, headerPattern :: String
|
||||
} deriving (Eq)
|
||||
|
||||
instance Show HeaderArg where
|
||||
show (HeaderArg n) = toValidFunctionName ("header" <> n)
|
||||
show (ReplaceHeaderArg n p)
|
||||
| pn `isPrefixOf` p = pv <> " + \"" <> rp <> "\""
|
||||
| pn `isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
|
||||
| pn `isInfixOf` p = "\"" <> (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
|
||||
|
||||
-- | Attempts to reduce the function name provided to that allowed by JS.
|
||||
-- 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 :: String -> String
|
||||
toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs
|
||||
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
|
||||
prefixOK c = c `elem` ['$','_']
|
||||
-- Unicode character sets
|
||||
firstLetterOK = [ Set.lowercaseLetter
|
||||
, Set.uppercaseLetter
|
||||
, Set.titlecaseLetter
|
||||
, Set.modifierLetter
|
||||
, Set.otherLetter
|
||||
, Set.letterNumber ]
|
||||
remainderOK = firstLetterOK <> [ Set.nonSpacingMark
|
||||
, Set.spacingCombiningMark
|
||||
, Set.decimalNumber
|
||||
, Set.connectorPunctuation ]
|
||||
toValidFunctionName [] = "_"
|
||||
|
||||
type MatrixArg = QueryArg
|
||||
|
||||
data Url = Url
|
||||
{ _path :: Path
|
||||
, _queryStr :: [QueryArg]
|
||||
} deriving (Eq, Show)
|
||||
|
||||
defUrl :: Url
|
||||
defUrl = Url [] []
|
||||
|
||||
type FunctionName = [String]
|
||||
type Method = String
|
||||
|
||||
data AjaxReq = AjaxReq
|
||||
{ _reqUrl :: Url
|
||||
, _reqMethod :: Method
|
||||
, _reqHeaders :: [HeaderArg]
|
||||
, _reqBody :: Bool
|
||||
, _funcName :: FunctionName
|
||||
} deriving (Eq, Show)
|
||||
|
||||
makeLenses ''QueryArg
|
||||
makeLenses ''Segment
|
||||
makeLenses ''Url
|
||||
makeLenses ''AjaxReq
|
||||
|
||||
isCapture :: Segment -> Bool
|
||||
isCapture (Segment (Cap _) _) = True
|
||||
isCapture _ = False
|
||||
|
||||
hasMatrixArgs :: Segment -> Bool
|
||||
hasMatrixArgs (Segment _ (_:_)) = True
|
||||
hasMatrixArgs _ = False
|
||||
|
||||
hasArgs :: Segment -> Bool
|
||||
hasArgs s = isCapture s || hasMatrixArgs s
|
||||
|
||||
matrixArgs :: Segment -> [MatrixArg]
|
||||
matrixArgs (Segment _ ms) = ms
|
||||
|
||||
captureArg :: Segment -> Arg
|
||||
captureArg (Segment (Cap s) _) = s
|
||||
captureArg _ = error "captureArg called on non capture"
|
||||
type JavaScriptGenerator = [Req] -> String
|
||||
|
||||
jsSegments :: [Segment] -> String
|
||||
jsSegments [] = ""
|
||||
|
|
@ -216,8 +53,8 @@ segmentTypeToStr (Static s) = s
|
|||
segmentTypeToStr (Cap s) = "' + encodeURIComponent(" ++ s ++ ") + '"
|
||||
|
||||
jsGParams :: String -> [QueryArg] -> String
|
||||
jsGParams _ [] = ""
|
||||
jsGParams _ [x] = paramToStr x False
|
||||
jsGParams _ [] = ""
|
||||
jsGParams _ [x] = paramToStr x False
|
||||
jsGParams s (x:xs) = paramToStr x True ++ s ++ jsGParams s xs
|
||||
|
||||
jsParams :: [QueryArg] -> String
|
||||
|
|
@ -234,191 +71,9 @@ paramToStr qarg notTheEnd =
|
|||
++ "=' + encodeURIComponent("
|
||||
++ name
|
||||
++ if notTheEnd then ") + '" else ")"
|
||||
|
||||
Flag -> name ++ "="
|
||||
|
||||
List -> name
|
||||
++ "[]=' + encodeURIComponent("
|
||||
++ name
|
||||
++ if notTheEnd then ") + '" else ")"
|
||||
|
||||
where name = qarg ^. argName
|
||||
|
||||
defReq :: AjaxReq
|
||||
defReq = AjaxReq defUrl "GET" [] False []
|
||||
|
||||
type family Elem (a :: *) (ls::[*]) :: Constraint where
|
||||
Elem a '[] = 'False ~ 'True
|
||||
Elem a (a ': list) = ()
|
||||
Elem a (b ': list) = Elem a list
|
||||
|
||||
class HasJS (layout :: *) where
|
||||
type JS layout :: *
|
||||
javascriptFor :: Proxy layout -> AjaxReq -> JS layout
|
||||
|
||||
instance (HasJS a, HasJS b)
|
||||
=> HasJS (a :<|> b) where
|
||||
type JS (a :<|> b) = JS a :<|> JS b
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy a) req
|
||||
:<|> javascriptFor (Proxy :: Proxy b) req
|
||||
|
||||
instance (KnownSymbol sym, HasJS sublayout)
|
||||
=> HasJS (Capture sym a :> sublayout) where
|
||||
type JS (Capture sym a :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.path <>~ [Segment (Cap str) []]
|
||||
& funcName %~ (++ ["by", str])
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance Elem JSON list => HasJS (Delete list a) where
|
||||
type JS (Delete list a) = AjaxReq
|
||||
|
||||
javascriptFor Proxy req =
|
||||
req & funcName %~ ("delete" :)
|
||||
& reqMethod .~ "DELETE"
|
||||
|
||||
instance Elem JSON list => HasJS (Get list a) where
|
||||
type JS (Get list a) = AjaxReq
|
||||
|
||||
javascriptFor Proxy req =
|
||||
req & funcName %~ ("get" :)
|
||||
& reqMethod .~ "GET"
|
||||
|
||||
instance (KnownSymbol sym, HasJS sublayout)
|
||||
=> HasJS (Header sym a :> sublayout) where
|
||||
type JS (Header sym a :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor subP (req & reqHeaders <>~ [HeaderArg hname])
|
||||
|
||||
where hname = symbolVal (Proxy :: Proxy sym)
|
||||
subP = Proxy :: Proxy sublayout
|
||||
|
||||
instance Elem JSON list => HasJS (Post list a) where
|
||||
type JS (Post list a) = AjaxReq
|
||||
|
||||
javascriptFor Proxy req =
|
||||
req & funcName %~ ("post" :)
|
||||
& reqMethod .~ "POST"
|
||||
|
||||
instance Elem JSON list => HasJS (Put list a) where
|
||||
type JS (Put list a) = AjaxReq
|
||||
|
||||
javascriptFor Proxy req =
|
||||
req & funcName %~ ("put" :)
|
||||
& reqMethod .~ "PUT"
|
||||
|
||||
instance (KnownSymbol sym, HasJS sublayout)
|
||||
=> HasJS (QueryParam sym a :> sublayout) where
|
||||
type JS (QueryParam sym a :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.queryStr <>~ [QueryArg str Normal]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance (KnownSymbol sym, HasJS sublayout)
|
||||
=> HasJS (QueryParams sym a :> sublayout) where
|
||||
type JS (QueryParams sym a :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.queryStr <>~ [QueryArg str List]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance (KnownSymbol sym, HasJS sublayout)
|
||||
=> HasJS (QueryFlag sym :> sublayout) where
|
||||
type JS (QueryFlag sym :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.queryStr <>~ [QueryArg str Flag]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance (KnownSymbol sym, HasJS sublayout)
|
||||
=> HasJS (MatrixParam sym a :> sublayout) where
|
||||
type JS (MatrixParam sym a :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
strArg = str ++ "Value"
|
||||
|
||||
instance (KnownSymbol sym, HasJS sublayout)
|
||||
=> HasJS (MatrixParams sym a :> sublayout) where
|
||||
type JS (MatrixParams sym a :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.path._last.matrix <>~ [QueryArg str List]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance (KnownSymbol sym, HasJS sublayout)
|
||||
=> HasJS (MatrixFlag sym :> sublayout) where
|
||||
type JS (MatrixFlag sym :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.path._last.matrix <>~ [QueryArg str Flag]
|
||||
|
||||
where str = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance HasJS Raw where
|
||||
type JS Raw = Method -> AjaxReq
|
||||
|
||||
javascriptFor Proxy req method =
|
||||
req & funcName %~ ((toLower <$> method) :)
|
||||
& reqMethod .~ method
|
||||
|
||||
instance (Elem JSON list, HasJS sublayout) => HasJS (ReqBody list a :> sublayout) where
|
||||
type JS (ReqBody list a :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) $
|
||||
req & reqBody .~ True
|
||||
|
||||
instance (KnownSymbol path, HasJS sublayout)
|
||||
=> HasJS (path :> sublayout) where
|
||||
type JS (path :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) $
|
||||
req & reqUrl.path <>~ [Segment (Static str) []]
|
||||
& funcName %~ (++ [str])
|
||||
|
||||
where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path)
|
||||
|
||||
instance HasJS sublayout => HasJS (RemoteHost :> sublayout) where
|
||||
type JS (RemoteHost :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) req
|
||||
|
||||
instance HasJS sublayout => HasJS (IsSecure :> sublayout) where
|
||||
type JS (IsSecure :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) req
|
||||
|
||||
instance HasJS sublayout => HasJS (Vault :> sublayout) where
|
||||
type JS (Vault :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) req
|
||||
|
||||
instance HasJS sublayout => HasJS (HttpVersion :> sublayout) where
|
||||
type JS (HttpVersion :> sublayout) = JS sublayout
|
||||
|
||||
javascriptFor Proxy req =
|
||||
javascriptFor (Proxy :: Proxy sublayout) req
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@ module Servant.JS.JQuery where
|
|||
import Control.Lens
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Servant.Foreign
|
||||
import Servant.JS.Internal
|
||||
|
||||
-- | Generate javascript functions that use the /jQuery/ library
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@ module Servant.JS.Vanilla where
|
|||
import Control.Lens
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Servant.Foreign
|
||||
import Servant.JS.Internal
|
||||
|
||||
-- | Generate vanilla javascript functions to make AJAX requests
|
||||
|
|
|
|||
|
|
@ -12,8 +12,8 @@ import Data.Proxy
|
|||
import Language.ECMAScript3.Parser (parseFromString)
|
||||
import Test.Hspec
|
||||
|
||||
import Servant.API
|
||||
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
|
||||
|
|
@ -75,7 +75,7 @@ spec = describe "Servant.JQuery" $ do
|
|||
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 { withCredentials = True }) customOptions)
|
||||
generateJSSpec AxiosCustom (AX.generateAxiosJSWith (AX.defAxiosOptions { AX.withCredentials = True }) customOptions)
|
||||
|
||||
angularSpec Angular
|
||||
axiosSpec
|
||||
|
|
|
|||
|
|
@ -12,8 +12,6 @@ import Control.Lens
|
|||
import Data.Monoid
|
||||
import Data.Proxy
|
||||
import GHC.TypeLits
|
||||
import Servant.API
|
||||
import Servant.JS
|
||||
import Servant.JS.Internal
|
||||
|
||||
-- | This is a hypothetical combinator that fetches an Authorization header.
|
||||
|
|
@ -21,11 +19,11 @@ import Servant.JS.Internal
|
|||
-- using -- Basic, Digest, whatever.
|
||||
data Authorization (sym :: Symbol) a
|
||||
|
||||
instance (KnownSymbol sym, HasJS sublayout)
|
||||
=> HasJS (Authorization sym a :> sublayout) where
|
||||
type JS (Authorization sym a :> sublayout) = JS sublayout
|
||||
instance (KnownSymbol sym, HasForeign sublayout)
|
||||
=> HasForeign (Authorization sym a :> sublayout) where
|
||||
type Foreign (Authorization sym a :> sublayout) = Foreign sublayout
|
||||
|
||||
javascriptFor Proxy req = javascriptFor (Proxy :: Proxy sublayout) $
|
||||
foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $
|
||||
tokenType (symbolVal (Proxy :: Proxy sym)) ]
|
||||
where
|
||||
|
|
@ -34,11 +32,11 @@ instance (KnownSymbol sym, HasJS sublayout)
|
|||
-- | This is a combinator that fetches an X-MyLovelyHorse header.
|
||||
data MyLovelyHorse a
|
||||
|
||||
instance (HasJS sublayout)
|
||||
=> HasJS (MyLovelyHorse a :> sublayout) where
|
||||
type JS (MyLovelyHorse a :> sublayout) = JS sublayout
|
||||
instance (HasForeign sublayout)
|
||||
=> HasForeign (MyLovelyHorse a :> sublayout) where
|
||||
type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout
|
||||
|
||||
javascriptFor Proxy req = javascriptFor (Proxy :: Proxy sublayout) $
|
||||
foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqHeaders <>~ [ ReplaceHeaderArg "X-MyLovelyHorse" tpl ]
|
||||
where
|
||||
tpl = "I am good friends with {X-MyLovelyHorse}"
|
||||
|
|
@ -46,11 +44,11 @@ instance (HasJS sublayout)
|
|||
-- | This is a combinator that fetches an X-WhatsForDinner header.
|
||||
data WhatsForDinner a
|
||||
|
||||
instance (HasJS sublayout)
|
||||
=> HasJS (WhatsForDinner a :> sublayout) where
|
||||
type JS (WhatsForDinner a :> sublayout) = JS sublayout
|
||||
instance (HasForeign sublayout)
|
||||
=> HasForeign (WhatsForDinner a :> sublayout) where
|
||||
type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout
|
||||
|
||||
javascriptFor Proxy req = javascriptFor (Proxy :: Proxy sublayout) $
|
||||
foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
|
||||
req & reqHeaders <>~ [ ReplaceHeaderArg "X-WhatsForDinner" tpl ]
|
||||
where
|
||||
tpl = "I would like {X-WhatsForDinner} with a cherry on top."
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@ servant
|
|||
servant-cassava
|
||||
servant-client
|
||||
servant-docs
|
||||
servant-foreign
|
||||
servant-js
|
||||
servant-server
|
||||
servant-examples
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@ packages:
|
|||
- servant-client/
|
||||
- servant-docs/
|
||||
- servant-examples/
|
||||
- servant-foreign/
|
||||
- servant-js/
|
||||
- servant-lucid/
|
||||
- servant-mock/
|
||||
|
|
|
|||
Loading…
Reference in New Issue