servant-js-0.5: Automatically derive javascript functions to query servant webservices.

Safe HaskellNone
LanguageHaskell2010

Servant.JS.Internal

Synopsis

Documentation

type JavaScriptGenerator = [Req] -> Text

data CommonGeneratorOptions

This structure is used by specific implementations to let you customize the output

Constructors

CommonGeneratorOptions 

Fields

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

defCommonGeneratorOptions :: CommonGeneratorOptions

Default options.

> defCommonGeneratorOptions = CommonGeneratorOptions
>   { functionNameBuilder = camelCase
>   , requestBody = "body"
>   , successCallback = "onSuccess"
>   , errorCallback = "onError"
>   , moduleName = ""
>   , urlPrefix = ""
>   }

type AjaxReq = Req

jsSegments :: [Segment] -> Text

segmentToStr :: Segment -> Bool -> Text

jsParams :: [QueryArg] -> Text

jsGParams :: Text -> [QueryArg] -> Text

paramToStr :: QueryArg -> Bool -> Text

toValidFunctionName :: Text -> Text

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?

data a :<|> b :: * -> * -> * infixr 8

Union of two APIs, first takes precedence in case of overlap.

Example:

>>> :{
type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
       :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] () -- POST /books
:}

Constructors

a :<|> b infixr 8 

Instances

Functor ((:<|>) a) 
Foldable ((:<|>) a) 
Traversable ((:<|>) a) 
(Bounded a, Bounded b) => Bounded ((:<|>) a b) 
(Eq a, Eq b) => Eq ((:<|>) a b) 
(Show a, Show b) => Show ((:<|>) a b) 
(Monoid a, Monoid b) => Monoid ((:<|>) a b) 
(HasForeign a, HasForeign b) => HasForeign ((:<|>) a b) 
(GenerateList start, GenerateList rest) => GenerateList ((:<|>) start rest) 
type Foreign ((:<|>) a b) = (:<|>) (Foreign a) (Foreign b) 

data path :> a :: k -> k1 -> * infixr 9

The contained API (second argument) can be found under ("/" ++ path) (path being the first argument).

Example:

>>> -- GET /hello/world
>>> -- returning a JSON encoded World value
>>> type MyApi = "hello" :> "world" :> Get '[JSON] World

Instances

(KnownSymbol sym, ToHttpApiData v, HasLink k sub) => HasLink * ((:>) * k (QueryParam * sym v) sub) 
(KnownSymbol sym, ToHttpApiData v, HasLink k sub) => HasLink * ((:>) * k (QueryParams * sym v) sub) 
(KnownSymbol sym, HasLink k sub) => HasLink * ((:>) * k (QueryFlag sym) sub) 
HasLink k sub => HasLink * ((:>) * k (ReqBody k1 ct a) sub) 
(ToHttpApiData v, HasLink k sub) => HasLink * ((:>) * k (Capture * sym v) sub) 
HasLink k sub => HasLink * ((:>) * k (Header sym a) sub) 
(KnownSymbol sym, HasLink k sub) => HasLink * ((:>) Symbol k sym sub) 
(KnownSymbol sym, HasForeign sublayout) => HasForeign ((:>) * * (Capture * sym a) sublayout) 
(KnownSymbol sym, HasForeign sublayout) => HasForeign ((:>) * * (Header sym a) sublayout) 
HasForeign sublayout => HasForeign ((:>) * * HttpVersion sublayout) 
(KnownSymbol sym, HasForeign sublayout) => HasForeign ((:>) * * (QueryParam * sym a) sublayout) 
(KnownSymbol sym, HasForeign sublayout) => HasForeign ((:>) * * (QueryParams * sym a) sublayout) 
(KnownSymbol sym, HasForeign sublayout) => HasForeign ((:>) * * (QueryFlag sym) sublayout) 
(Elem JSON list, HasForeign sublayout) => HasForeign ((:>) * * (ReqBody * list a) sublayout) 
HasForeign sublayout => HasForeign ((:>) * * RemoteHost sublayout) 
HasForeign sublayout => HasForeign ((:>) * * IsSecure sublayout) 
HasForeign sublayout => HasForeign ((:>) * * Vault sublayout) 
(KnownSymbol path, HasForeign sublayout) => HasForeign ((:>) Symbol * path sublayout) 
type MkLink * ((:>) * k (Header sym a) sub) = MkLink k sub 
type MkLink * ((:>) * k (Capture * sym v) sub) = v -> MkLink k sub 
type MkLink * ((:>) * k (ReqBody k1 ct a) sub) = MkLink k sub 
type MkLink * ((:>) * k (QueryFlag sym) sub) = Bool -> MkLink k sub 
type MkLink * ((:>) * k (QueryParams * sym v) sub) = [v] -> MkLink k sub 
type MkLink * ((:>) * k (QueryParam * sym v) sub) = Maybe v -> MkLink k sub 
type MkLink * ((:>) Symbol k sym sub) = MkLink k sub 
type Foreign ((:>) * * (Capture * sym a) sublayout) = Foreign sublayout 
type Foreign ((:>) * * (Header sym a) sublayout) = Foreign sublayout 
type Foreign ((:>) * * HttpVersion sublayout) = Foreign sublayout 
type Foreign ((:>) * * (QueryParam * sym a) sublayout) = Foreign sublayout 
type Foreign ((:>) * * (QueryParams * sym a) sublayout) = Foreign sublayout 
type Foreign ((:>) * * (QueryFlag sym) sublayout) = Foreign sublayout 
type Foreign ((:>) * * (ReqBody * list a) sublayout) = Foreign sublayout 
type Foreign ((:>) * * RemoteHost sublayout) = Foreign sublayout 
type Foreign ((:>) * * IsSecure sublayout) = Foreign sublayout 
type Foreign ((:>) * * Vault sublayout) = Foreign sublayout 
type Foreign ((:>) Symbol * path sublayout) = Foreign sublayout 

class HasForeign layout where

Associated Types

type Foreign layout :: *

Methods

foreignFor :: Proxy * layout -> Req -> Foreign layout

Instances

HasForeign Raw 
(HasForeign a, HasForeign b) => HasForeign ((:<|>) a b) 
Elem JSON list => HasForeign (Get list a) 
Elem JSON list => HasForeign (Post list a) 
Elem JSON list => HasForeign (Delete list a) 
Elem JSON list => HasForeign (Put list a) 
(KnownSymbol sym, HasForeign sublayout) => HasForeign ((:>) * * (Capture * sym a) sublayout) 
(KnownSymbol sym, HasForeign sublayout) => HasForeign ((:>) * * (Header sym a) sublayout) 
HasForeign sublayout => HasForeign ((:>) * * HttpVersion sublayout) 
(KnownSymbol sym, HasForeign sublayout) => HasForeign ((:>) * * (QueryParam * sym a) sublayout) 
(KnownSymbol sym, HasForeign sublayout) => HasForeign ((:>) * * (QueryParams * sym a) sublayout) 
(KnownSymbol sym, HasForeign sublayout) => HasForeign ((:>) * * (QueryFlag sym) sublayout) 
(Elem JSON list, HasForeign sublayout) => HasForeign ((:>) * * (ReqBody * list a) sublayout) 
HasForeign sublayout => HasForeign ((:>) * * RemoteHost sublayout) 
HasForeign sublayout => HasForeign ((:>) * * IsSecure sublayout) 
HasForeign sublayout => HasForeign ((:>) * * Vault sublayout) 
(KnownSymbol path, HasForeign sublayout) => HasForeign ((:>) Symbol * path sublayout) 

data HeaderArg :: *

Constructors

HeaderArg 

Fields

headerArgName :: Text
 
ReplaceHeaderArg 

Fields

headerArgName :: Text
 
headerPattern :: Text
 

concatCase :: FunctionName -> Text

Function name builder that simply concat each part together

snakeCase :: FunctionName -> Text

Function name builder using the snake_case convention. each part is separated by a single underscore character.

camelCase :: FunctionName -> Text

Function name builder using the CamelCase convention. each part begins with an upper case character.

data ReqBody contentTypes a :: [*] -> k -> *

Extract the request body as a value of type a.

Example:

>>> -- POST /books
>>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book

Instances

HasLink k sub => HasLink * ((:>) * k (ReqBody k1 ct a) sub) 
(Elem JSON list, HasForeign sublayout) => HasForeign ((:>) * * (ReqBody * list a) sublayout) 
type MkLink * ((:>) * k (ReqBody k1 ct a) sub) = MkLink k sub 
type Foreign ((:>) * * (ReqBody * list a) sublayout) = Foreign sublayout 

data JSON :: *

Instances

Accept * JSON
application/json
ToJSON a => MimeRender * JSON a

encode

FromJSON a => MimeUnrender * JSON a

eitherDecode

data FormUrlEncoded :: *

Instances

Accept * FormUrlEncoded
application/x-www-form-urlencoded
ToFormUrlEncoded a => MimeRender * FormUrlEncoded a

encodeFormUrlEncoded . toFormUrlEncoded Note that the mimeUnrender p (mimeRender p x) == Right x law only holds if every element of x is non-null (i.e., not ("", ""))

FromFormUrlEncoded a => MimeUnrender * FormUrlEncoded a

decodeFormUrlEncoded >=> fromFormUrlEncoded Note that the mimeUnrender p (mimeRender p x) == Right x law only holds if every element of x is non-null (i.e., not ("", ""))

data Post contentTypes a :: [*] -> * -> *

Endpoint for POST requests. The type variable represents the type of the response body (not the request body, use ReqBody for that).

Example:

>>> -- POST /books
>>> -- with a JSON encoded Book as the request body
>>> -- returning the just-created Book
>>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book

Instances

HasLink * (Post y r) 
Elem JSON list => HasForeign (Post list a) 
type MkLink * (Post y r) = URI 
type Foreign (Post list a) = Req 

data Get contentTypes a :: [*] -> * -> *

Endpoint for simple GET requests. Serves the result as JSON.

Example:

>>> type MyApi = "books" :> Get '[JSON] [Book]

Instances

HasLink * (Get y r) 
Elem JSON list => HasForeign (Get list a) 
type MkLink * (Get y r) = URI 
type Foreign (Get list a) = Req 

data Raw :: *

Endpoint for plugging in your own Wai Applications.

The given Application will get the request as received by the server, potentially with a modified (stripped) pathInfo if the Application is being routed with :>.

In addition to just letting you plug in your existing WAI Applications, this can also be used with serveDirectory to serve static files stored in a particular directory on your filesystem

Instances

HasForeign Raw 
HasLink * Raw 
type Foreign Raw = Method -> Req 
type MkLink * Raw = URI 

data Header sym a :: Symbol -> * -> *

Extract the given header's value as a value of type a.

Example:

>>> newtype Referer = Referer Text deriving (Eq, Show)
>>> 
>>> -- GET /view-my-referer
>>> type MyApi = "view-my-referer" :> Header "from" Referer :> Get '[JSON] Referer

Instances

HasLink k sub => HasLink * ((:>) * k (Header sym a) sub) 
Functor (Header sym) 
Eq a => Eq (Header sym a) 
Show a => Show (Header sym a) 
(KnownSymbol sym, HasForeign sublayout) => HasForeign ((:>) * * (Header sym a) sublayout) 
type MkLink * ((:>) * k (Header sym a) sub) = MkLink k sub 
type Foreign ((:>) * * (Header sym a) sublayout) = Foreign sublayout