| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Servant.JS.Internal
- type JavaScriptGenerator = [Req ()] -> Text
- data CommonGeneratorOptions = CommonGeneratorOptions {}
- defCommonGeneratorOptions :: CommonGeneratorOptions
- type AjaxReq = Req ()
- jsSegments :: [Segment f] -> Text
- segmentToStr :: Segment f -> Bool -> Text
- segmentTypeToStr :: SegmentType f -> Text
- jsParams :: [QueryArg f] -> Text
- jsGParams :: Text -> [QueryArg f] -> Text
- paramToStr :: QueryArg f -> Bool -> Text
- toValidFunctionName :: Text -> Text
- toJSHeader :: HeaderArg f -> Text
- data a :<|> b :: * -> * -> * = a :<|> b
- data path :> a :: k -> k1 -> *
- defReq :: Req ftype
- reqHeaders :: Functor f => ([HeaderArg f0] -> f [HeaderArg f0]) -> Req f0 -> f (Req f0)
- class HasForeign lang ftype layout where
- class HasForeignType lang ftype a where
- class GenerateList ftype reqs where
- generateList :: reqs -> [Req ftype]
- data NoTypes :: *
- data HeaderArg f :: * -> *
- = HeaderArg {
- _headerArg :: Arg f
- | ReplaceHeaderArg {
- _headerArg :: Arg f
- _headerPattern :: Text
- = HeaderArg {
- data ArgType :: *
- data HeaderArg f :: * -> *
- = HeaderArg {
- _headerArg :: Arg f
- | ReplaceHeaderArg {
- _headerArg :: Arg f
- _headerPattern :: Text
- = HeaderArg {
- data QueryArg f :: * -> * = QueryArg {
- _queryArgName :: Arg f
- _queryArgType :: ArgType
- data Req f :: * -> * = Req {
- _reqUrl :: Url f
- _reqMethod :: Method
- _reqHeaders :: [HeaderArg f]
- _reqBody :: Maybe f
- _reqReturnType :: Maybe f
- _reqFuncName :: FunctionName
- newtype Segment f :: * -> * = Segment {
- unSegment :: SegmentType f
- data SegmentType f :: * -> *
- = Static PathSegment
- | Cap (Arg f)
- data Url f :: * -> * = Url {}
- type Path f = [Segment f]
- data Arg f :: * -> * = Arg {
- _argName :: PathSegment
- _argType :: f
- newtype FunctionName :: * = FunctionName {
- unFunctionName :: [Text]
- newtype PathSegment :: * = PathSegment {}
- concatCase :: FunctionName -> Text
- snakeCase :: FunctionName -> Text
- camelCase :: FunctionName -> Text
- data ReqBody contentTypes a :: [*] -> k -> *
- data JSON :: *
- data FormUrlEncoded :: *
- type Post = Verb StdMethod k POST 200
- type Get = Verb StdMethod k GET 200
- data Raw :: *
- data Header sym a :: Symbol -> * -> *
Documentation
type JavaScriptGenerator = [Req ()] -> Text Source
data CommonGeneratorOptions Source
This structure is used by specific implementations to let you customize the output
Constructors
| CommonGeneratorOptions | |
Fields
| |
defCommonGeneratorOptions :: CommonGeneratorOptions Source
Default options.
> defCommonGeneratorOptions = CommonGeneratorOptions
> { functionNameBuilder = camelCase
> , requestBody = "body"
> , successCallback = "onSuccess"
> , errorCallback = "onError"
> , moduleName = ""
> , urlPrefix = ""
> }
jsSegments :: [Segment f] -> Text Source
segmentToStr :: Segment f -> Bool -> Text Source
segmentTypeToStr :: SegmentType f -> Text Source
paramToStr :: QueryArg f -> Bool -> Text Source
toValidFunctionName :: Text -> Text Source
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 f -> Text Source
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
| (HasForeign k lang ftype a, HasForeign k lang ftype b) => HasForeign k lang ftype ((:<|>) a b) | |
| (GenerateList ftype start, GenerateList ftype rest) => GenerateList ftype ((:<|>) start rest) | |
| 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) | |
| type Foreign ftype ((:<|>) a b) = (:<|>) (Foreign ftype a) (Foreign ftype 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, HasForeignType k k1 lang ftype t, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (Capture k1 sym t) sublayout) | |
| (KnownSymbol sym, HasForeignType k * lang ftype a, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (Header sym a) sublayout) | |
| (KnownSymbol sym, HasForeignType k k1 lang ftype a, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (QueryParam k1 sym a) sublayout) | |
| (KnownSymbol sym, HasForeignType k * lang ftype [a], HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (QueryParams * sym a) sublayout) | |
| (KnownSymbol sym, HasForeignType k * lang ftype Bool, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (QueryFlag sym) sublayout) | |
| (Elem JSON list, HasForeignType k k1 lang ftype a, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (ReqBody k1 list a) sublayout) | |
| (KnownSymbol path, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) Symbol * path sublayout) | |
| HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * RemoteHost sublayout) | |
| HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * IsSecure sublayout) | |
| HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * Vault sublayout) | |
| HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * HttpVersion sublayout) | |
| type Foreign ftype ((:>) * * HttpVersion sublayout) = Foreign ftype sublayout | |
| type Foreign ftype ((:>) * * Vault sublayout) = Foreign ftype sublayout | |
| type Foreign ftype ((:>) * * IsSecure sublayout) = Foreign ftype sublayout | |
| type Foreign ftype ((:>) * * RemoteHost sublayout) = Foreign ftype sublayout | |
| type Foreign ftype ((:>) Symbol * path sublayout) = Foreign ftype sublayout | |
| type Foreign ftype ((:>) * * (ReqBody k list a) sublayout) = Foreign ftype sublayout | |
| type Foreign ftype ((:>) * * (QueryFlag sym) sublayout) = Foreign ftype sublayout | |
| type Foreign ftype ((:>) * * (QueryParams * sym a) sublayout) = Foreign ftype sublayout | |
| type Foreign ftype ((:>) * * (QueryParam k sym a) sublayout) = Foreign ftype sublayout | |
| type Foreign ftype ((:>) * * (Header sym a) sublayout) = Foreign ftype sublayout | |
| type Foreign ftype ((:>) * * (Capture k sym a) sublayout) = Foreign ftype sublayout |
class HasForeign lang ftype layout where
Associated Types
type Foreign ftype layout :: *
Methods
foreignFor :: Proxy k lang -> Proxy * ftype -> Proxy * layout -> Req ftype -> Foreign ftype layout
Instances
| HasForeign k lang ftype Raw | |
| (HasForeign k lang ftype a, HasForeign k lang ftype b) => HasForeign k lang ftype ((:<|>) a b) | |
| HasForeign k lang ftype sublayout => HasForeign k lang ftype (WithNamedContext name context sublayout) | |
| (KnownSymbol sym, HasForeignType k k1 lang ftype t, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (Capture k1 sym t) sublayout) | |
| (KnownSymbol sym, HasForeignType k * lang ftype a, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (Header sym a) sublayout) | |
| (KnownSymbol sym, HasForeignType k k1 lang ftype a, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (QueryParam k1 sym a) sublayout) | |
| (KnownSymbol sym, HasForeignType k * lang ftype [a], HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (QueryParams * sym a) sublayout) | |
| (KnownSymbol sym, HasForeignType k * lang ftype Bool, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (QueryFlag sym) sublayout) | |
| (Elem JSON list, HasForeignType k k1 lang ftype a, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (ReqBody k1 list a) sublayout) | |
| (KnownSymbol path, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) Symbol * path sublayout) | |
| HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * RemoteHost sublayout) | |
| HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * IsSecure sublayout) | |
| HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * Vault sublayout) | |
| HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * HttpVersion sublayout) | |
| (Elem JSON list, HasForeignType k k2 lang ftype a, ReflectMethod k1 method) => HasForeign k lang ftype (Verb k1 k2 method status list a) |
class HasForeignType lang ftype a where
HasForeignType maps Haskell types with types in the target
language of your backend. For example, let's say you're
implementing a backend to some language X, and you want
a Text representation of each input/output type mentioned in the API:
-- First you need to create a dummy type to parametrize your -- instances. data LangX -- Otherwise you define instances for the types you need instance HasForeignType LangX Text Int where typeFor _ _ _ = "intX" -- Or for example in case of lists instance HasForeignType LangX Text a => HasForeignType LangX Text [a] where typeFor lang type _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
Finally to generate list of information about all the endpoints for an API you create a function of a form:
getEndpoints :: (HasForeign LangX Text api, GenerateList Text (Foreign Text api))
=> Proxy api -> [Req Text]
getEndpoints api = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy Text) api-- If language __X__ is dynamically typed then you can use -- a predefined NoTypes parameter with the () output type:
getEndpoints :: (HasForeign NoTypes () api, GenerateList Text (Foreign () api))
=> Proxy api -> [Req ()]
getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) api
Instances
| HasForeignType * k NoTypes () ftype |
class GenerateList ftype reqs where
Utility class used by listFromAPI which computes
the data needed to generate a function for each endpoint
and hands it all back in a list.
Methods
generateList :: reqs -> [Req ftype]
Instances
| GenerateList ftype (Req ftype) | |
| (GenerateList ftype start, GenerateList ftype rest) => GenerateList ftype ((:<|>) start rest) |
data NoTypes :: *
Instances
| HasForeignType * k NoTypes () ftype |
data HeaderArg f :: * -> *
Constructors
| HeaderArg | |
Fields
| |
| ReplaceHeaderArg | |
Fields
| |
data HeaderArg f :: * -> *
Constructors
| HeaderArg | |
Fields
| |
| ReplaceHeaderArg | |
Fields
| |
data QueryArg f :: * -> *
Constructors
| QueryArg | |
Fields
| |
data Req f :: * -> *
Constructors
| Req | |
Fields
| |
newtype Segment f :: * -> *
Constructors
| Segment | |
Fields
| |
data SegmentType f :: * -> *
Constructors
| Static PathSegment | a static path segment. like "/foo" |
| Cap (Arg f) | a capture. like "/:userid" |
Instances
| Eq f => Eq (SegmentType f) | |
| Show f => Show (SegmentType f) |
data Url f :: * -> *
data Arg f :: * -> *
Constructors
| Arg | |
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
Instances
| (Elem JSON list, HasForeignType k k1 lang ftype a, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (ReqBody k1 list a) sublayout) | |
| type Foreign ftype ((:>) * * (ReqBody k list a) sublayout) = Foreign ftype sublayout |
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 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
| (KnownSymbol sym, HasForeignType k * lang ftype a, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (Header sym a) sublayout) | |
| Functor (Header sym) | |
| Eq a => Eq (Header sym a) | |
| Show a => Show (Header sym a) | |
| type Foreign ftype ((:>) * * (Header sym a) sublayout) = Foreign ftype sublayout |