| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Servant.JS.Internal
- type JavaScriptGenerator = [Req] -> Text
- data CommonGeneratorOptions = CommonGeneratorOptions {
- functionNameBuilder :: FunctionName -> Text
- requestBody :: Text
- successCallback :: Text
- errorCallback :: Text
- moduleName :: Text
- urlPrefix :: Text
- defCommonGeneratorOptions :: CommonGeneratorOptions
- type AjaxReq = Req
- jsSegments :: [Segment] -> Text
- segmentToStr :: Segment -> Bool -> Text
- segmentTypeToStr :: SegmentType -> Text
- jsParams :: [QueryArg] -> Text
- jsGParams :: Text -> [QueryArg] -> Text
- paramToStr :: QueryArg -> Bool -> Text
- toValidFunctionName :: Text -> Text
- toJSHeader :: HeaderArg -> Text
- data a :<|> b :: * -> * -> * = a :<|> b
- data path :> a :: k -> k1 -> *
- defReq :: Req
- reqHeaders :: Lens' Req [HeaderArg]
- class HasForeign layout where
- type Foreign layout :: *
- foreignFor :: Proxy * layout -> Req -> Foreign layout
- data HeaderArg :: *
- = HeaderArg {
- headerArgName :: Text
- | ReplaceHeaderArg {
- headerArgName :: Text
- headerPattern :: Text
- = HeaderArg {
- concatCase :: FunctionName -> Text
- snakeCase :: FunctionName -> Text
- camelCase :: FunctionName -> Text
- data ReqBody contentTypes a :: [*] -> k -> *
- data JSON :: *
- data FormUrlEncoded :: *
- data Post contentTypes a :: [*] -> * -> *
- data Get contentTypes a :: [*] -> * -> *
- data Raw :: *
- data Header sym a :: Symbol -> * -> *
Documentation
type JavaScriptGenerator = [Req] -> Text
This structure is used by specific implementations to let you customize the output
Constructors
| CommonGeneratorOptions | |
Fields
| |
defCommonGeneratorOptions :: CommonGeneratorOptions
Default options.
> defCommonGeneratorOptions = CommonGeneratorOptions
> { functionNameBuilder = camelCase
> , requestBody = "body"
> , successCallback = "onSuccess"
> , errorCallback = "onError"
> , moduleName = ""
> , urlPrefix = ""
> }
jsSegments :: [Segment] -> Text
segmentToStr :: Segment -> Bool -> Text
segmentTypeToStr :: SegmentType -> 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?
toJSHeader :: HeaderArg -> Text
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 |
reqHeaders :: Lens' Req [HeaderArg]
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
| |
| ReplaceHeaderArg | |
Fields
| |
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
data JSON :: *
Instances
| Accept * JSON | application/json |
| ToJSON a => MimeRender * JSON a |
|
| FromJSON a => MimeUnrender * JSON a |
|
data FormUrlEncoded :: *
Instances
| Accept * FormUrlEncoded | application/x-www-form-urlencoded |
| ToFormUrlEncoded a => MimeRender * FormUrlEncoded a |
|
| FromFormUrlEncoded a => MimeUnrender * FormUrlEncoded a |
|
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
data Get contentTypes a :: [*] -> * -> *
Endpoint for simple GET requests. Serves the result as JSON.
Example:
>>>type MyApi = "books" :> Get '[JSON] [Book]
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
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 |