Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- type JavaScriptGenerator = [Req NoContent] -> Text
- data CommonGeneratorOptions = CommonGeneratorOptions {}
- defCommonGeneratorOptions :: CommonGeneratorOptions
- type AjaxReq = Req NoContent
- 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 :: k) :> a :: forall k. k -> Type -> Type
- defReq :: Req ftype
- reqHeaders :: Lens' (Req f) [HeaderArg f]
- class HasForeign (lang :: k) ftype api where
- class HasForeignType (lang :: k) ftype (a :: k1) where
- class GenerateList ftype reqs where
- generateList :: reqs -> [Req ftype]
- data NoTypes
- 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
- _reqBodyContentType :: ReqBodyContentType
- 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
- type ReqBody = ReqBody' (Required ': (Strict ': ([] :: [Type])))
- data JSON
- data FormUrlEncoded
- type Post = Verb POST 200
- type Get = Verb GET 200
- data Raw
- type Header = (Header' (Optional ': (Strict ': ([] :: [Type]))) :: Symbol -> k -> Type)
Documentation
data CommonGeneratorOptions Source #
This structure is used by specific implementations to let you customize the output
CommonGeneratorOptions | |
|
defCommonGeneratorOptions :: CommonGeneratorOptions Source #
Default options.
> defCommonGeneratorOptions = CommonGeneratorOptions > { functionNameBuilder = camelCase > , requestBody = "body" > , successCallback = "onSuccess" > , errorCallback = "onError" > , moduleName = "" > , urlPrefix = "" > }
jsSegments :: [Segment f] -> Text Source #
segmentTypeToStr :: SegmentType f -> 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 #
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 :}
a :<|> b infixr 3 |
Instances
Bitraversable (:<|>) | |
Defined in Servant.API.Alternative bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> (a :<|> b) -> f (c :<|> d) # | |
Bifoldable (:<|>) | |
Bifunctor (:<|>) | |
Biapplicative (:<|>) | |
Defined in Servant.API.Alternative | |
(HasForeign lang ftype a, HasForeign lang ftype b) => HasForeign (lang :: k) ftype (a :<|> b) | |
(GenerateList ftype start, GenerateList ftype rest) => GenerateList ftype (start :<|> rest) | |
Defined in Servant.Foreign.Internal generateList :: (start :<|> rest) -> [Req ftype] # | |
Functor ((:<|>) a) | |
Foldable ((:<|>) a) | |
Defined in Servant.API.Alternative fold :: Monoid m => (a :<|> m) -> m # foldMap :: Monoid m => (a0 -> m) -> (a :<|> a0) -> m # foldr :: (a0 -> b -> b) -> b -> (a :<|> a0) -> b # foldr' :: (a0 -> b -> b) -> b -> (a :<|> a0) -> b # foldl :: (b -> a0 -> b) -> b -> (a :<|> a0) -> b # foldl' :: (b -> a0 -> b) -> b -> (a :<|> a0) -> b # foldr1 :: (a0 -> a0 -> a0) -> (a :<|> a0) -> a0 # foldl1 :: (a0 -> a0 -> a0) -> (a :<|> a0) -> a0 # toList :: (a :<|> a0) -> [a0] # length :: (a :<|> a0) -> Int # elem :: Eq a0 => a0 -> (a :<|> a0) -> Bool # maximum :: Ord a0 => (a :<|> a0) -> a0 # minimum :: Ord a0 => (a :<|> a0) -> a0 # | |
Traversable ((:<|>) a) | |
(HasLink a, HasLink b) => HasLink (a :<|> b :: Type) | |
(Bounded a, Bounded b) => Bounded (a :<|> b) | |
(Eq a, Eq b) => Eq (a :<|> b) | |
(Show a, Show b) => Show (a :<|> b) | |
(Semigroup a, Semigroup b) => Semigroup (a :<|> b) | |
(Monoid a, Monoid b) => Monoid (a :<|> b) | |
type Foreign ftype (a :<|> b) | |
type MkLink (a :<|> b :: Type) r | |
data (path :: k) :> a :: forall k. k -> Type -> Type infixr 4 #
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 lang ftype [a], HasForeign lang ftype api) => HasForeign (lang :: k) ftype (QueryParams sym a :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (QueryParams sym a :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (QueryParams sym a :> api) -> Req ftype -> Foreign ftype (QueryParams sym a :> api) # | |
(KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype api) => HasForeign (lang :: k) ftype (QueryFlag sym :> api) | |
(Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype api) => HasForeign (lang :: k) ftype (ReqBody' mods list a :> api) | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (StreamBody' mods framing ctype a :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (StreamBody' mods framing ctype a :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (StreamBody' mods framing ctype a :> api) -> Req ftype -> Foreign ftype (StreamBody' mods framing ctype a :> api) # | |
(KnownSymbol path, HasForeign lang ftype api) => HasForeign (lang :: k) ftype (path :> api) | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (RemoteHost :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (RemoteHost :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (RemoteHost :> api) -> Req ftype -> Foreign ftype (RemoteHost :> api) # | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (IsSecure :> api) | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (Vault :> api) | |
(KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype api) => HasForeign (lang :: k) ftype (Capture' mods sym t :> api) | |
(KnownSymbol sym, HasForeignType lang ftype [t], HasForeign lang ftype sublayout) => HasForeign (lang :: k) ftype (CaptureAll sym t :> sublayout) | |
Defined in Servant.Foreign.Internal type Foreign ftype (CaptureAll sym t :> sublayout) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (CaptureAll sym t :> sublayout) -> Req ftype -> Foreign ftype (CaptureAll sym t :> sublayout) # | |
(KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api) => HasForeign (lang :: k) ftype (Header' mods sym a :> api) | |
(KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api) => HasForeign (lang :: k) ftype (QueryParam' mods sym a :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (QueryParam' mods sym a :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (QueryParam' mods sym a :> api) -> Req ftype -> Foreign ftype (QueryParam' mods sym a :> api) # | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (HttpVersion :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (HttpVersion :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (HttpVersion :> api) -> Req ftype -> Foreign ftype (HttpVersion :> api) # | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (Summary desc :> api) | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (Description desc :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (Description desc :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (Description desc :> api) -> Req ftype -> Foreign ftype (Description desc :> api) # | |
HasLink sub => HasLink (HttpVersion :> sub :: Type) | |
Defined in Servant.Links type MkLink (HttpVersion :> sub) a :: Type # toLink :: (Link -> a) -> Proxy (HttpVersion :> sub) -> Link -> MkLink (HttpVersion :> sub) a # | |
HasLink sub => HasLink (StreamBody' mods framing ct a :> sub :: Type) | |
Defined in Servant.Links type MkLink (StreamBody' mods framing ct a :> sub) a :: Type # toLink :: (Link -> a0) -> Proxy (StreamBody' mods framing ct a :> sub) -> Link -> MkLink (StreamBody' mods framing ct a :> sub) a0 # | |
HasLink sub => HasLink (ReqBody' mods ct a :> sub :: Type) | |
HasLink sub => HasLink (RemoteHost :> sub :: Type) | |
Defined in Servant.Links type MkLink (RemoteHost :> sub) a :: Type # toLink :: (Link -> a) -> Proxy (RemoteHost :> sub) -> Link -> MkLink (RemoteHost :> sub) a # | |
(KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods)) => HasLink (QueryParam' mods sym v :> sub :: Type) | |
Defined in Servant.Links type MkLink (QueryParam' mods sym v :> sub) a :: Type # toLink :: (Link -> a) -> Proxy (QueryParam' mods sym v :> sub) -> Link -> MkLink (QueryParam' mods sym v :> sub) a # | |
(KnownSymbol sym, ToHttpApiData v, HasLink sub) => HasLink (QueryParams sym v :> sub :: Type) | |
Defined in Servant.Links type MkLink (QueryParams sym v :> sub) a :: Type # toLink :: (Link -> a) -> Proxy (QueryParams sym v :> sub) -> Link -> MkLink (QueryParams sym v :> sub) a # | |
(KnownSymbol sym, HasLink sub) => HasLink (QueryFlag sym :> sub :: Type) | |
HasLink sub => HasLink (Header' mods sym a :> sub :: Type) | |
HasLink sub => HasLink (IsSecure :> sub :: Type) | |
HasLink sub => HasLink (AuthProtect tag :> sub :: Type) | |
Defined in Servant.Links type MkLink (AuthProtect tag :> sub) a :: Type # toLink :: (Link -> a) -> Proxy (AuthProtect tag :> sub) -> Link -> MkLink (AuthProtect tag :> sub) a # | |
HasLink sub => HasLink (Summary s :> sub :: Type) | |
HasLink sub => HasLink (Description s :> sub :: Type) | |
Defined in Servant.Links type MkLink (Description s :> sub) a :: Type # toLink :: (Link -> a) -> Proxy (Description s :> sub) -> Link -> MkLink (Description s :> sub) a # | |
(ToHttpApiData v, HasLink sub) => HasLink (Capture' mods sym v :> sub :: Type) | |
(ToHttpApiData v, HasLink sub) => HasLink (CaptureAll sym v :> sub :: Type) | |
Defined in Servant.Links type MkLink (CaptureAll sym v :> sub) a :: Type # toLink :: (Link -> a) -> Proxy (CaptureAll sym v :> sub) -> Link -> MkLink (CaptureAll sym v :> sub) a # | |
HasLink sub => HasLink (BasicAuth realm a :> sub :: Type) | |
HasLink sub => HasLink (Vault :> sub :: Type) | |
(KnownSymbol sym, HasLink sub) => HasLink (sym :> sub :: Type) | |
type Foreign ftype (Description desc :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (Summary desc :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (HttpVersion :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (Vault :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (IsSecure :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (RemoteHost :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (path :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (StreamBody' mods framing ctype a :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (ReqBody' mods list a :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (QueryFlag sym :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (QueryParams sym a :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (QueryParam' mods sym a :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (Header' mods sym a :> api) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (CaptureAll sym t :> sublayout) | |
Defined in Servant.Foreign.Internal | |
type Foreign ftype (Capture' mods sym t :> api) | |
Defined in Servant.Foreign.Internal | |
type MkLink (HttpVersion :> sub :: Type) a | |
Defined in Servant.Links | |
type MkLink (StreamBody' mods framing ct a :> sub :: Type) r | |
Defined in Servant.Links | |
type MkLink (ReqBody' mods ct a :> sub :: Type) r | |
type MkLink (RemoteHost :> sub :: Type) a | |
Defined in Servant.Links | |
type MkLink (QueryParam' mods sym v :> sub :: Type) a | |
Defined in Servant.Links type MkLink (QueryParam' mods sym v :> sub :: Type) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a | |
type MkLink (QueryParams sym v :> sub :: Type) a | |
Defined in Servant.Links | |
type MkLink (QueryFlag sym :> sub :: Type) a | |
type MkLink (Header' mods sym a :> sub :: Type) r | |
type MkLink (IsSecure :> sub :: Type) a | |
type MkLink (AuthProtect tag :> sub :: Type) a | |
Defined in Servant.Links | |
type MkLink (Summary s :> sub :: Type) a | |
type MkLink (Description s :> sub :: Type) a | |
Defined in Servant.Links | |
type MkLink (Capture' mods sym v :> sub :: Type) a | |
type MkLink (CaptureAll sym v :> sub :: Type) a | |
Defined in Servant.Links | |
type MkLink (BasicAuth realm a :> sub :: Type) r | |
type MkLink (Vault :> sub :: Type) a | |
type MkLink (sym :> sub :: Type) a | |
Defined in Servant.Links |
reqHeaders :: Lens' (Req f) [HeaderArg f] #
class HasForeign (lang :: k) ftype api where #
Instances
HasForeign (lang :: k) ftype Raw | |
HasForeign (lang :: k) ftype EmptyAPI | |
(HasForeignType lang ftype NoContent, ReflectMethod method) => HasForeign (lang :: k) ftype (NoContentVerb method) | |
Defined in Servant.Foreign.Internal type Foreign ftype (NoContentVerb method) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (NoContentVerb method) -> Req ftype -> Foreign ftype (NoContentVerb method) # | |
(HasForeign lang ftype a, HasForeign lang ftype b) => HasForeign (lang :: k) ftype (a :<|> b) | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (WithNamedContext name context api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (WithNamedContext name context api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (WithNamedContext name context api) -> Req ftype -> Foreign ftype (WithNamedContext name context api) # | |
(KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype api) => HasForeign (lang :: k) ftype (QueryParams sym a :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (QueryParams sym a :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (QueryParams sym a :> api) -> Req ftype -> Foreign ftype (QueryParams sym a :> api) # | |
(KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype api) => HasForeign (lang :: k) ftype (QueryFlag sym :> api) | |
(Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype api) => HasForeign (lang :: k) ftype (ReqBody' mods list a :> api) | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (StreamBody' mods framing ctype a :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (StreamBody' mods framing ctype a :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (StreamBody' mods framing ctype a :> api) -> Req ftype -> Foreign ftype (StreamBody' mods framing ctype a :> api) # | |
(KnownSymbol path, HasForeign lang ftype api) => HasForeign (lang :: k) ftype (path :> api) | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (RemoteHost :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (RemoteHost :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (RemoteHost :> api) -> Req ftype -> Foreign ftype (RemoteHost :> api) # | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (IsSecure :> api) | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (Vault :> api) | |
(KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype api) => HasForeign (lang :: k) ftype (Capture' mods sym t :> api) | |
(KnownSymbol sym, HasForeignType lang ftype [t], HasForeign lang ftype sublayout) => HasForeign (lang :: k) ftype (CaptureAll sym t :> sublayout) | |
Defined in Servant.Foreign.Internal type Foreign ftype (CaptureAll sym t :> sublayout) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (CaptureAll sym t :> sublayout) -> Req ftype -> Foreign ftype (CaptureAll sym t :> sublayout) # | |
(KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api) => HasForeign (lang :: k) ftype (Header' mods sym a :> api) | |
(KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api) => HasForeign (lang :: k) ftype (QueryParam' mods sym a :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (QueryParam' mods sym a :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (QueryParam' mods sym a :> api) -> Req ftype -> Foreign ftype (QueryParam' mods sym a :> api) # | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (HttpVersion :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (HttpVersion :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (HttpVersion :> api) -> Req ftype -> Foreign ftype (HttpVersion :> api) # | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (Summary desc :> api) | |
HasForeign lang ftype api => HasForeign (lang :: k) ftype (Description desc :> api) | |
Defined in Servant.Foreign.Internal type Foreign ftype (Description desc :> api) :: Type # foreignFor :: Proxy lang -> Proxy ftype -> Proxy (Description desc :> api) -> Req ftype -> Foreign ftype (Description desc :> api) # | |
(Elem JSON list, HasForeignType lang ftype a, ReflectMethod method) => HasForeign (lang :: k) ftype (Verb method status list a) | |
(ct ~ JSON, HasForeignType lang ftype a, ReflectMethod method) => HasForeign (lang :: k) ftype (Stream method status framing ct a) | TODO: doesn't taking framing into account. |
class HasForeignType (lang :: k) ftype (a :: k1) 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 NoContent output type:
getEndpoints :: (HasForeign NoTypes NoContent api, GenerateList Text (Foreign NoContent api)) => Proxy api -> [Req NoContent] getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) api
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.
generateList :: reqs -> [Req ftype] #
Instances
GenerateList ftype EmptyForeignAPI | |
Defined in Servant.Foreign.Internal generateList :: EmptyForeignAPI -> [Req ftype] # | |
GenerateList ftype (Req ftype) | |
Defined in Servant.Foreign.Internal generateList :: Req ftype -> [Req ftype] # | |
(GenerateList ftype start, GenerateList ftype rest) => GenerateList ftype (start :<|> rest) | |
Defined in Servant.Foreign.Internal generateList :: (start :<|> rest) -> [Req ftype] # |
Instances
Eq ArgType | |
Data ArgType | |
Defined in Servant.Foreign.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ArgType -> c ArgType # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ArgType # toConstr :: ArgType -> Constr # dataTypeOf :: ArgType -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ArgType) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArgType) # gmapT :: (forall b. Data b => b -> b) -> ArgType -> ArgType # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ArgType -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ArgType -> r # gmapQ :: (forall d. Data d => d -> u) -> ArgType -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> ArgType -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> ArgType -> m ArgType # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ArgType -> m ArgType # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ArgType -> m ArgType # | |
Show ArgType | |
HeaderArg | |
| |
ReplaceHeaderArg | |
|
Instances
Eq f => Eq (HeaderArg f) | |
Data f => Data (HeaderArg f) | |
Defined in Servant.Foreign.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> HeaderArg f -> c (HeaderArg f) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (HeaderArg f) # toConstr :: HeaderArg f -> Constr # dataTypeOf :: HeaderArg f -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (HeaderArg f)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (HeaderArg f)) # gmapT :: (forall b. Data b => b -> b) -> HeaderArg f -> HeaderArg f # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r # gmapQ :: (forall d. Data d => d -> u) -> HeaderArg f -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> HeaderArg f -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f) # | |
Show f => Show (HeaderArg f) | |
QueryArg | |
|
Instances
Eq f => Eq (QueryArg f) | |
Data f => Data (QueryArg f) | |
Defined in Servant.Foreign.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> QueryArg f -> c (QueryArg f) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (QueryArg f) # toConstr :: QueryArg f -> Constr # dataTypeOf :: QueryArg f -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (QueryArg f)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (QueryArg f)) # gmapT :: (forall b. Data b => b -> b) -> QueryArg f -> QueryArg f # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> QueryArg f -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> QueryArg f -> r # gmapQ :: (forall d. Data d => d -> u) -> QueryArg f -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> QueryArg f -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f) # | |
Show f => Show (QueryArg f) | |
Req | |
|
Instances
GenerateList ftype (Req ftype) | |
Defined in Servant.Foreign.Internal generateList :: Req ftype -> [Req ftype] # | |
Eq f => Eq (Req f) | |
Data f => Data (Req f) | |
Defined in Servant.Foreign.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Req f -> c (Req f) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Req f) # dataTypeOf :: Req f -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Req f)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Req f)) # gmapT :: (forall b. Data b => b -> b) -> Req f -> Req f # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r # gmapQ :: (forall d. Data d => d -> u) -> Req f -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Req f -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Req f -> m (Req f) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Req f -> m (Req f) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Req f -> m (Req f) # | |
Show f => Show (Req f) | |
Segment | |
|
Instances
Eq f => Eq (Segment f) | |
Data f => Data (Segment f) | |
Defined in Servant.Foreign.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Segment f -> c (Segment f) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Segment f) # toConstr :: Segment f -> Constr # dataTypeOf :: Segment f -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Segment f)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Segment f)) # gmapT :: (forall b. Data b => b -> b) -> Segment f -> Segment f # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Segment f -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Segment f -> r # gmapQ :: (forall d. Data d => d -> u) -> Segment f -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Segment f -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Segment f -> m (Segment f) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Segment f -> m (Segment f) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Segment f -> m (Segment f) # | |
Show f => Show (Segment f) | |
data SegmentType f #
Static PathSegment | a static path segment. like "/foo" |
Cap (Arg f) | a capture. like "/:userid" |
Instances
Eq f => Eq (SegmentType f) | |
Defined in Servant.Foreign.Internal (==) :: SegmentType f -> SegmentType f -> Bool # (/=) :: SegmentType f -> SegmentType f -> Bool # | |
Data f => Data (SegmentType f) | |
Defined in Servant.Foreign.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SegmentType f -> c (SegmentType f) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (SegmentType f) # toConstr :: SegmentType f -> Constr # dataTypeOf :: SegmentType f -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (SegmentType f)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (SegmentType f)) # gmapT :: (forall b. Data b => b -> b) -> SegmentType f -> SegmentType f # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SegmentType f -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SegmentType f -> r # gmapQ :: (forall d. Data d => d -> u) -> SegmentType f -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> SegmentType f -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> SegmentType f -> m (SegmentType f) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SegmentType f -> m (SegmentType f) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SegmentType f -> m (SegmentType f) # | |
Show f => Show (SegmentType f) | |
Defined in Servant.Foreign.Internal showsPrec :: Int -> SegmentType f -> ShowS # show :: SegmentType f -> String # showList :: [SegmentType f] -> ShowS # |
Instances
Eq f => Eq (Url f) | |
Data f => Data (Url f) | |
Defined in Servant.Foreign.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Url f -> c (Url f) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Url f) # dataTypeOf :: Url f -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Url f)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Url f)) # gmapT :: (forall b. Data b => b -> b) -> Url f -> Url f # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r # gmapQ :: (forall d. Data d => d -> u) -> Url f -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Url f -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Url f -> m (Url f) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Url f -> m (Url f) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Url f -> m (Url f) # | |
Show f => Show (Url f) | |
Arg | |
|
Instances
Eq f => Eq (Arg f) | |
Data f => Data (Arg f) | |
Defined in Servant.Foreign.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Arg f -> c (Arg f) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Arg f) # dataTypeOf :: Arg f -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Arg f)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Arg f)) # gmapT :: (forall b. Data b => b -> b) -> Arg f -> Arg f # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r # gmapQ :: (forall d. Data d => d -> u) -> Arg f -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Arg f -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Arg f -> m (Arg f) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Arg f -> m (Arg f) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Arg f -> m (Arg f) # | |
Show f => Show (Arg f) | |
newtype FunctionName #
Instances
newtype PathSegment #
Instances
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.
type ReqBody = ReqBody' (Required ': (Strict ': ([] :: [Type]))) #
Extract the request body as a value of type a
.
Example:
>>>
-- POST /books
>>>
type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
Instances
Accept JSON | application/json |
Defined in Servant.API.ContentTypes | |
ToJSON a => MimeRender JSON a | |
Defined in Servant.API.ContentTypes mimeRender :: Proxy JSON -> a -> ByteString # | |
FromJSON a => MimeUnrender JSON a |
|
Defined in Servant.API.ContentTypes mimeUnrender :: Proxy JSON -> ByteString -> Either String a # mimeUnrenderWithType :: Proxy JSON -> MediaType -> ByteString -> Either String a # |
data FormUrlEncoded #
Instances
Accept FormUrlEncoded | application/x-www-form-urlencoded |
Defined in Servant.API.ContentTypes | |
ToForm a => MimeRender FormUrlEncoded a |
|
Defined in Servant.API.ContentTypes mimeRender :: Proxy FormUrlEncoded -> a -> ByteString # | |
FromForm a => MimeUnrender FormUrlEncoded a |
|
Defined in Servant.API.ContentTypes mimeUnrender :: Proxy FormUrlEncoded -> ByteString -> Either String a # mimeUnrenderWithType :: Proxy FormUrlEncoded -> MediaType -> ByteString -> Either String a # |
Endpoint for plugging in your own Wai Application
s.
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 Application
s,
this can also be used with functions from
Servant.Server.StaticFiles
to serve static files stored in a particular directory on your filesystem
Instances
HasForeign (lang :: k) ftype Raw | |
HasLink Raw | |
type Foreign ftype Raw | |
Defined in Servant.Foreign.Internal | |
type MkLink Raw a | |
Defined in Servant.Links |
type Header = (Header' (Optional ': (Strict ': ([] :: [Type]))) :: Symbol -> k -> Type) #
Extract the given header's value as a value of type a
.
I.e. header sent by client, parsed by server.
Example:
>>>
newtype Referer = Referer Text deriving (Eq, Show)
>>>
>>>
-- GET /view-my-referer
>>>
type MyApi = "view-my-referer" :> Header "from" Referer :> Get '[JSON] Referer