Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
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
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
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 #
ReqBody a |
Instances
IsRequest (ReqBody cts a) Source # | |
Defined in Web.Minion.Request.Body type RequestValue (ReqBody cts a) Source # getRequestValue :: ReqBody cts a -> RequestValue (ReqBody cts a) Source # | |
type RequestValue (ReqBody cts a) Source # | |
Defined in Web.Minion.Request.Body |
:: 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
:: 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 | . |
:: 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 | . |
:: 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.>
...
Instances
IsRequest LazyBytes Source # | |
Defined in Web.Minion.Raw type RequestValue LazyBytes Source # | |
CanRespond LazyBytes Source # | |
Defined in Web.Minion.Response canRespond :: [ByteString] -> Bool Source # | |
Applicative m => ToResponse m LazyBytes Source # | |
Defined in Web.Minion.Response toResponse :: [ByteString] -> LazyBytes -> m Response Source # | |
type RequestValue LazyBytes Source # | |
Defined in Web.Minion.Raw |
:: forall m i ts. Introspection i Request LazyBytes | |
=> MonadIO m | |
=> ValueCombinator i (WithReq m LazyBytes) ts m | . |
Instances
IsRequest Chunks Source # | |
Defined in Web.Minion.Raw type RequestValue Chunks Source # | |
CanRespond Chunks Source # | |
Defined in Web.Minion.Response canRespond :: [ByteString] -> Bool Source # | |
Applicative m => ToResponse m Chunks Source # | |
Defined in Web.Minion.Response toResponse :: [ByteString] -> Chunks -> m Response Source # | |
type RequestValue Chunks Source # | |
Defined in Web.Minion.Raw |
:: forall m i ts. Introspection i Request Chunks | |
=> MonadIO m | |
=> ValueCombinator i (WithReq m Chunks) ts m | . |
Response
Instances
CanRespond NoBody Source # | |
Defined in Web.Minion.Response canRespond :: [ByteString] -> Bool Source # | |
Monad m => ToResponse m NoBody Source # | |
Defined in Web.Minion.Response toResponse :: [ByteString] -> NoBody -> m Response Source # |
class ToResponse m r where Source #
toResponse :: [ByteString] -> r -> m Response Source #
Instances
class CanRespond o where Source #
:: [ByteString] | Accept header values |
-> Bool |
Instances
Handler
:: 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 |
:: 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 |
:: 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 #
RespBody a |
Instances
AllContentTypes cts => CanRespond (RespBody cts a :: Type) Source # | |
Defined in Web.Minion.Response.Body 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 toResponse :: [ByteString] -> RespBody (ct ': cts) a2 -> m Response Source # | |
MonadIO m => ToResponse m (RespBody ('[] :: [k]) a) Source # | |
Defined in Web.Minion.Response.Body toResponse :: [ByteString] -> RespBody '[] a -> m Response Source # |
:: 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 #
MinionSettings | |
|
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
Instances
Exception NoMatch Source # | |
Defined in Web.Minion.Error toException :: NoMatch -> SomeException # fromException :: SomeException -> Maybe NoMatch # displayException :: NoMatch -> String # | |
Show NoMatch Source # | |
data SomethingWentWrong Source #
Instances
Exception SomethingWentWrong Source # | |
Defined in Web.Minion.Error | |
Show SomethingWentWrong Source # | |
Defined in Web.Minion.Error showsPrec :: Int -> SomethingWentWrong -> ShowS # show :: SomethingWentWrong -> String # showList :: [SomethingWentWrong] -> ShowS # |
data ServerError Source #
Instances
Exception ServerError Source # | |
Defined in Web.Minion.Error | |
Show ServerError Source # | |
Defined in Web.Minion.Error 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
.
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.
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