{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Network.Wai.Middleware.Context
(
addRequestContext
, addRequestContextMay
, addContext
) where
import Prelude
import qualified Context
import qualified Network.Wai as Wai
addRequestContext
:: Context.Store ctx
-> (Wai.Request -> IO ctx)
-> Wai.Middleware
addRequestContext :: Store ctx -> (Request -> IO ctx) -> Middleware
addRequestContext Store ctx
contextStore Request -> IO ctx
mkContext Application
app = \Request
request Response -> IO ResponseReceived
sendResponse -> do
ctx
context <- Request -> IO ctx
mkContext Request
request
Store ctx -> ctx -> IO ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) ctx a.
(MonadIO m, MonadMask m) =>
Store ctx -> ctx -> m a -> m a
Context.use Store ctx
contextStore ctx
context do
Application
app Request
request Response -> IO ResponseReceived
sendResponse
addRequestContextMay
:: Context.Store ctx
-> (Wai.Request -> IO (Maybe ctx))
-> Wai.Middleware
addRequestContextMay :: Store ctx -> (Request -> IO (Maybe ctx)) -> Middleware
addRequestContextMay Store ctx
contextStore Request -> IO (Maybe ctx)
mkContext Application
app = \Request
request Response -> IO ResponseReceived
sendResponse -> do
Request -> IO (Maybe ctx)
mkContext Request
request IO (Maybe ctx)
-> (Maybe ctx -> IO ResponseReceived) -> IO ResponseReceived
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe ctx
Nothing -> Application
app Request
request Response -> IO ResponseReceived
sendResponse
Just ctx
context ->
Store ctx -> ctx -> IO ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) ctx a.
(MonadIO m, MonadMask m) =>
Store ctx -> ctx -> m a -> m a
Context.use Store ctx
contextStore ctx
context do
Application
app Request
request Response -> IO ResponseReceived
sendResponse
addContext :: Context.Store ctx -> IO ctx -> Wai.Middleware
addContext :: Store ctx -> IO ctx -> Middleware
addContext Store ctx
contextStore IO ctx
mkContext Application
app = \Request
request Response -> IO ResponseReceived
sendResponse -> do
ctx
context <- IO ctx
mkContext
Store ctx -> ctx -> IO ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) ctx a.
(MonadIO m, MonadMask m) =>
Store ctx -> ctx -> m a -> m a
Context.use Store ctx
contextStore ctx
context do
Application
app Request
request Response -> IO ResponseReceived
sendResponse