Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Web.Minion
Synopsis
- data Router' i (ts :: Type) m
- type Router = Router' Void
- type MakeError = Status -> ByteString -> ServerError
- type ValueCombinator i v ts m = Router' i (ts :+ v) m -> Router' i ts m
- type Combinator i ts m = Router' i ts m -> Router' i ts m
- alt :: [Router' i ts r] -> Router' i ts r
- (/>) :: (Router' i ts r -> Router' i ts r) -> Router' i ts r -> Router' i ts r
- (.>) :: (Router' i ts' r -> Router' i ts r) -> Router' i ts' r -> Router' i ts r
- (!>) :: (Router' i (ts :+ x) r -> Router' i ts r) -> Router' i (ts :+ Hide x) r -> Router' i ts r
- hideIntrospection :: Router' i ts m -> Router' i' ts m
- description :: Introspection i Description a => a -> Combinator i ts m
- module Web.Minion.Request.Header
- module Web.Minion.Request.Query
- module Web.Minion.Request.Url
- newtype ReqBody (cts :: [Type]) a = ReqBody a
- reqBody :: forall cts r m i ts. Introspection i Request (ReqBody cts r) => (MonadIO m, MonadThrow m) => DecodeBody cts r => ValueCombinator i (WithReq m (ReqBody cts r)) ts m
- reqPlainText :: forall r m i ts. Introspection i Request (ReqBody '[PlainText] r) => (MonadIO m, MonadThrow m) => Decode PlainText r => ValueCombinator i (WithReq m (ReqBody '[PlainText] r)) ts m
- reqFormUrlEncoded :: forall r m i ts. Introspection i Request (ReqBody '[FormUrlEncoded] r) => (MonadIO m, MonadThrow m) => Decode FormUrlEncoded r => ValueCombinator i (WithReq m (ReqBody '[FormUrlEncoded] r)) ts m
- reqJson :: forall r m i ts. Introspection i Request (ReqBody '[Json] r) => FromJSON r => (MonadIO m, MonadThrow m) => ValueCombinator i (WithReq m (ReqBody '[Json] r)) ts m
- newtype LazyBytes = LazyBytes ByteString
- lazyBytesBody :: forall m i ts. Introspection i Request LazyBytes => MonadIO m => ValueCombinator i (WithReq m LazyBytes) ts m
- newtype Chunks = Chunks (IO ByteString)
- chunksBody :: forall m i ts. Introspection i Request Chunks => MonadIO m => ValueCombinator i (WithReq m Chunks) ts m
- data NoBody = NoBody
- class ToResponse m r where
- toResponse :: [ByteString] -> r -> m Response
- class CanRespond o where
- canRespond :: [ByteString] -> Bool
- handle :: forall o m ts i st. (HandleArgs ts st m, ToResponse m o, CanRespond o, Introspection i Response o) => Method -> (DelayedArgs st ~> m o) -> Router' i ts m
- handleJson :: forall o m ts i st. HandleArgs ts st m => ToJSON o => MonadIO m => Introspection i Response (RespBody '[Json] o) => Method -> (DelayedArgs st ~> m o) -> Router' i ts m
- handlePlainText :: forall o m ts i st. HandleArgs ts st m => ToResponse m (RespBody '[PlainText] o) => Introspection i Response (RespBody '[PlainText] o) => Method -> (DelayedArgs st ~> m o) -> Router' i ts m
- newtype RespBody cts a = RespBody a
- handleBody :: forall cts o m ts i st. HandleArgs ts st m => IsResponse m (RespBody cts o) => Introspection i Response (RespBody cts o) => Method -> (DelayedArgs st ~> m o) -> Router' i ts m
- module Web.Minion.Request.Method
- type MiddlewareM m = ApplicationM m -> ApplicationM m
- middleware :: MiddlewareM m -> Combinator i ts m
- type ApplicationM m = Request -> (Response -> IO ResponseReceived) -> m ResponseReceived
- data MinionSettings m = MinionSettings {
- notFound :: m Response
- httpError :: ServerError -> m Response
- errorBuilders :: ErrorBuilders
- serve :: (MonadIO m, MonadCatch m) => Router' i Void m -> ApplicationM m
- serveWithSettings :: (MonadIO m, MonadCatch m) => MinionSettings m -> Router' i Void m -> ApplicationM m
- defaultMinionSettings :: (MonadIO m, MonadCatch m) => MinionSettings m
- defaultErrorBuilders :: ErrorBuilders
- data NoMatch = NoMatch
- data SomethingWentWrong = SomethingWentWrong
- data ServerError = ServerError {}
- module Web.Minion.Args
- module Web.Minion.Auth
- data Void
- class MonadThrow m => MonadCatch (m :: Type -> Type) where
- catch :: (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
- class Monad m => MonadThrow (m :: Type -> Type) where
- throwM :: (HasCallStack, Exception e) => e -> m a
Minion
data Router' i (ts :: Type) m Source #
Instances
IsString (Combinator i ts m) Source # | |
Defined in Web.Minion.Router.Internal Methods fromString :: String -> Combinator i ts m # | |
Monoid (Router' i ts r) Source # | |
Semigroup (Router' i ts r) Source # | |
IsList (Router' i ts r) Source # | |
type Item (Router' i ts r) Source # | |
Defined in Web.Minion.Router.Internal |
type MakeError = Status -> ByteString -> ServerError Source #
Combinators
type Combinator i ts m = Router' i ts m -> Router' i ts m Source #
Use it after Combinator
Use it after ValueCombinator
and MapArgs
Arguments
:: (Router' i (ts :+ x) r -> Router' i ts r) | |
-> Router' i (ts :+ Hide x) r | . |
-> Router' i ts r |
Use it if you don't care about value captured by previous combinator
hideIntrospection :: Router' i ts m -> Router' i' ts m Source #
description :: Introspection i Description a => a -> Combinator i ts m Source #
Add description for route
Header
module Web.Minion.Request.Header
Query params
module Web.Minion.Request.Query
URL
module Web.Minion.Request.Url
Request
newtype ReqBody (cts :: [Type]) a Source #
Constructors
ReqBody a |
Instances
IsRequest (ReqBody cts a) Source # | |
Defined in Web.Minion.Request.Body Associated Types type RequestValue (ReqBody cts a) Source # Methods getRequestValue :: ReqBody cts a -> RequestValue (ReqBody cts a) Source # | |
type RequestValue (ReqBody cts a) Source # | |
Defined in Web.Minion.Request.Body |
Arguments
:: forall cts r m i ts. Introspection i Request (ReqBody cts r) | |
=> (MonadIO m, MonadThrow m) | |
=> DecodeBody cts r | |
=> ValueCombinator i (WithReq m (ReqBody cts r)) ts m | . |
Extracts request body with specified Content-Type
.../>
reqBody
@'[PlainText] @MyRequest
Arguments
:: forall r m i ts. Introspection i Request (ReqBody '[PlainText] r) | |
=> (MonadIO m, MonadThrow m) | |
=> Decode PlainText r | |
=> ValueCombinator i (WithReq m (ReqBody '[PlainText] r)) ts m | . |
Arguments
:: forall r m i ts. Introspection i Request (ReqBody '[FormUrlEncoded] r) | |
=> (MonadIO m, MonadThrow m) | |
=> Decode FormUrlEncoded r | |
=> ValueCombinator i (WithReq m (ReqBody '[FormUrlEncoded] r)) ts m | . |
Arguments
:: forall r m i ts. Introspection i Request (ReqBody '[Json] r) | |
=> FromJSON r | |
=> (MonadIO m, MonadThrow m) | |
=> ValueCombinator i (WithReq m (ReqBody '[Json] r)) ts m | . |
Extracts JSON from request
.../>
reqJson
@MyType.>
...
Constructors
LazyBytes ByteString |
Instances
IsRequest LazyBytes Source # | |
Defined in Web.Minion.Raw Associated Types type RequestValue LazyBytes Source # Methods getRequestValue :: LazyBytes -> RequestValue LazyBytes Source # | |
CanRespond LazyBytes Source # | |
Defined in Web.Minion.Response Methods canRespond :: [ByteString] -> Bool Source # | |
Applicative m => ToResponse m LazyBytes Source # | |
Defined in Web.Minion.Response Methods toResponse :: [ByteString] -> LazyBytes -> m Response Source # | |
type RequestValue LazyBytes Source # | |
Defined in Web.Minion.Raw |
Arguments
:: forall m i ts. Introspection i Request LazyBytes | |
=> MonadIO m | |
=> ValueCombinator i (WithReq m LazyBytes) ts m | . |
Constructors
Chunks (IO ByteString) |
Instances
IsRequest Chunks Source # | |
CanRespond Chunks Source # | |
Defined in Web.Minion.Response Methods canRespond :: [ByteString] -> Bool Source # | |
Applicative m => ToResponse m Chunks Source # | |
Defined in Web.Minion.Response Methods toResponse :: [ByteString] -> Chunks -> m Response Source # | |
type RequestValue Chunks Source # | |
Defined in Web.Minion.Raw |
Arguments
:: forall m i ts. Introspection i Request Chunks | |
=> MonadIO m | |
=> ValueCombinator i (WithReq m Chunks) ts m | . |
Response
Constructors
NoBody |
Instances
CanRespond NoBody Source # | |
Defined in Web.Minion.Response Methods canRespond :: [ByteString] -> Bool Source # | |
Monad m => ToResponse m NoBody Source # | |
Defined in Web.Minion.Response Methods toResponse :: [ByteString] -> NoBody -> m Response Source # |
class ToResponse m r where Source #
Methods
toResponse :: [ByteString] -> r -> m Response Source #
Instances
class CanRespond o where Source #
Instances
Handler
Arguments
:: forall o m ts i st. (HandleArgs ts st m, ToResponse m o, CanRespond o, Introspection i Response o) | |
=> Method | . |
-> (DelayedArgs st ~> m o) | |
-> Router' i ts m |
Arguments
:: forall o m ts i st. HandleArgs ts st m | |
=> ToJSON o | |
=> MonadIO m | |
=> Introspection i Response (RespBody '[Json] o) | |
=> Method | . |
-> (DelayedArgs st ~> m o) | |
-> Router' i ts m |
Arguments
:: forall o m ts i st. HandleArgs ts st m | |
=> ToResponse m (RespBody '[PlainText] o) | |
=> Introspection i Response (RespBody '[PlainText] o) | |
=> Method | . |
-> (DelayedArgs st ~> m o) | |
-> Router' i ts m |
newtype RespBody cts a Source #
Constructors
RespBody a |
Instances
AllContentTypes cts => CanRespond (RespBody cts a :: Type) Source # | |
Defined in Web.Minion.Response.Body Methods canRespond :: [ByteString] -> Bool Source # | |
(EncodeBody (ct ': cts) a2, Encode ct a2, MonadIO m, ContentType ct) => ToResponse m (RespBody (ct ': cts) a2) Source # | |
Defined in Web.Minion.Response.Body Methods toResponse :: [ByteString] -> RespBody (ct ': cts) a2 -> m Response Source # | |
MonadIO m => ToResponse m (RespBody ('[] :: [k]) a) Source # | |
Defined in Web.Minion.Response.Body Methods toResponse :: [ByteString] -> RespBody '[] a -> m Response Source # |
Arguments
:: forall cts o m ts i st. HandleArgs ts st m | |
=> IsResponse m (RespBody cts o) | |
=> Introspection i Response (RespBody cts o) | |
=> Method | . |
-> (DelayedArgs st ~> m o) | |
-> Router' i ts m |
Handles request with specified HTTP method and responds with specified Content-Type
.../>
handleBody
GET @'[PlainText] @MyResponse someEndpoint
module Web.Minion.Request.Method
Middleware
type MiddlewareM m = ApplicationM m -> ApplicationM m Source #
middleware :: MiddlewareM m -> Combinator i ts m Source #
Injects middleware
.../>
middleware
Wai.realIp/>
...
Server
type ApplicationM m = Request -> (Response -> IO ResponseReceived) -> m ResponseReceived Source #
Application
lifted to m
data MinionSettings m Source #
Constructors
MinionSettings | |
Fields
|
serve :: (MonadIO m, MonadCatch m) => Router' i Void m -> ApplicationM m Source #
serveWithSettings :: (MonadIO m, MonadCatch m) => MinionSettings m -> Router' i Void m -> ApplicationM m Source #
The same as serve
but allows to configure exceptions handlers
defaultMinionSettings :: (MonadIO m, MonadCatch m) => MinionSettings m Source #
Exceptions
Constructors
NoMatch |
Instances
Exception NoMatch Source # | |
Defined in Web.Minion.Error Methods toException :: NoMatch -> SomeException # fromException :: SomeException -> Maybe NoMatch # displayException :: NoMatch -> String # | |
Show NoMatch Source # | |
data SomethingWentWrong Source #
Constructors
SomethingWentWrong |
Instances
Exception SomethingWentWrong Source # | |
Defined in Web.Minion.Error Methods toException :: SomethingWentWrong -> SomeException # fromException :: SomeException -> Maybe SomethingWentWrong # | |
Show SomethingWentWrong Source # | |
Defined in Web.Minion.Error Methods showsPrec :: Int -> SomethingWentWrong -> ShowS # show :: SomethingWentWrong -> String # showList :: [SomethingWentWrong] -> ShowS # |
data ServerError Source #
Constructors
ServerError | |
Instances
Exception ServerError Source # | |
Defined in Web.Minion.Error Methods toException :: ServerError -> SomeException # fromException :: SomeException -> Maybe ServerError # displayException :: ServerError -> String # | |
Show ServerError Source # | |
Defined in Web.Minion.Error Methods showsPrec :: Int -> ServerError -> ShowS # show :: ServerError -> String # showList :: [ServerError] -> ShowS # |
Args
module Web.Minion.Args
Auth
module Web.Minion.Auth
Reexports
Uninhabited data type
Since: base-4.8.0.0
Instances
class MonadThrow m => MonadCatch (m :: Type -> Type) where #
A class for monads which allow exceptions to be caught, in particular
exceptions which were thrown by throwM
.
Instances should obey the following law:
catch (throwM e) f = f e
Note that the ability to catch an exception does not guarantee that we can
deal with all possible exit points from a computation. Some monads, such as
continuation-based stacks, allow for more than just a success/failure
strategy, and therefore catch
cannot be used by those monads to properly
implement a function such as finally
. For more information, see
MonadMask
.
Methods
catch :: (HasCallStack, Exception e) => m a -> (e -> m a) -> m a #
Provide a handler for exceptions thrown during execution of the first
action. Note that type of the type of the argument to the handler will
constrain which exceptions are caught. See Control.Exception's
catch
.
Instances
class Monad m => MonadThrow (m :: Type -> Type) where #
A class for monads in which exceptions may be thrown.
Instances should obey the following law:
throwM e >> x = throwM e
In other words, throwing an exception short-circuits the rest of the monadic computation.
Methods
throwM :: (HasCallStack, Exception e) => e -> m a #
Throw an exception. Note that this throws when this action is run in
the monad m
, not when it is applied. It is a generalization of
Control.Exception's throwIO
.
Should satisfy the law:
throwM e >> f = throwM e