{-# LANGUAGE FlexibleContexts #-}
module Network.Wai.Trans (
ApplicationT
, liftApplication
, runApplicationT
, MiddlewareT
, liftMiddleware
, runMiddlewareT
) where
import Control.Monad.IO.Unlift
import Network.Wai
type ApplicationT m = Request -> (Response -> m ResponseReceived) -> m ResponseReceived
liftApplication :: MonadUnliftIO m
=> Application
-> ApplicationT m
liftApplication :: Application -> ApplicationT m
liftApplication Application
app Request
request Response -> m ResponseReceived
respond = ((forall a. m a -> IO a) -> IO ResponseReceived)
-> m ResponseReceived
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ResponseReceived)
-> m ResponseReceived)
-> ((forall a. m a -> IO a) -> IO ResponseReceived)
-> m ResponseReceived
forall a b. (a -> b) -> a -> b
$ \ forall a. m a -> IO a
runInIO ->
Application
app Request
request ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ m ResponseReceived -> IO ResponseReceived
forall a. m a -> IO a
runInIO (m ResponseReceived -> IO ResponseReceived)
-> (Response -> m ResponseReceived)
-> Response
-> IO ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> m ResponseReceived
respond
runApplicationT :: MonadUnliftIO m
=> ApplicationT m
-> m Application
runApplicationT :: ApplicationT m -> m Application
runApplicationT ApplicationT m
appT = ((forall a. m a -> IO a) -> IO Application) -> m Application
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Application) -> m Application)
-> ((forall a. m a -> IO a) -> IO Application) -> m Application
forall a b. (a -> b) -> a -> b
$ \ forall a. m a -> IO a
runInIO ->
Application -> IO Application
forall (m :: * -> *) a. Monad m => a -> m a
return (Application -> IO Application) -> Application -> IO Application
forall a b. (a -> b) -> a -> b
$ \ Request
request Response -> IO ResponseReceived
respond -> m ResponseReceived -> IO ResponseReceived
forall a. m a -> IO a
runInIO (m ResponseReceived -> IO ResponseReceived)
-> m ResponseReceived -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ApplicationT m
appT Request
request ((Response -> m ResponseReceived) -> m ResponseReceived)
-> (Response -> m ResponseReceived) -> m ResponseReceived
forall a b. (a -> b) -> a -> b
$ IO ResponseReceived -> m ResponseReceived
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ResponseReceived -> m ResponseReceived)
-> (Response -> IO ResponseReceived)
-> Response
-> m ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> IO ResponseReceived
respond
type MiddlewareT m = ApplicationT m -> ApplicationT m
liftMiddleware :: MonadUnliftIO m
=> Middleware
-> MiddlewareT m
liftMiddleware :: Middleware -> MiddlewareT m
liftMiddleware Middleware
mid ApplicationT m
appT Request
request Response -> m ResponseReceived
respond = do
Application
app <- ApplicationT m -> m Application
forall (m :: * -> *).
MonadUnliftIO m =>
ApplicationT m -> m Application
runApplicationT ApplicationT m
appT
((forall a. m a -> IO a) -> IO ResponseReceived)
-> m ResponseReceived
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ResponseReceived)
-> m ResponseReceived)
-> ((forall a. m a -> IO a) -> IO ResponseReceived)
-> m ResponseReceived
forall a b. (a -> b) -> a -> b
$ \ forall a. m a -> IO a
runInIO -> Middleware
mid Application
app Request
request ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ m ResponseReceived -> IO ResponseReceived
forall a. m a -> IO a
runInIO (m ResponseReceived -> IO ResponseReceived)
-> (Response -> m ResponseReceived)
-> Response
-> IO ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> m ResponseReceived
respond
runMiddlewareT :: MonadUnliftIO m
=> MiddlewareT m
-> m Middleware
runMiddlewareT :: MiddlewareT m -> m Middleware
runMiddlewareT MiddlewareT m
midT = ((forall a. m a -> IO a) -> IO Middleware) -> m Middleware
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Middleware) -> m Middleware)
-> ((forall a. m a -> IO a) -> IO Middleware) -> m Middleware
forall a b. (a -> b) -> a -> b
$ \ forall a. m a -> IO a
runInIO ->
Middleware -> IO Middleware
forall (m :: * -> *) a. Monad m => a -> m a
return (Middleware -> IO Middleware) -> Middleware -> IO Middleware
forall a b. (a -> b) -> a -> b
$ \ Application
app Request
request Response -> IO ResponseReceived
respond -> do
Application
app' <- m Application -> IO Application
forall a. m a -> IO a
runInIO (m Application -> IO Application)
-> (ApplicationT m -> m Application)
-> ApplicationT m
-> IO Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplicationT m -> m Application
forall (m :: * -> *).
MonadUnliftIO m =>
ApplicationT m -> m Application
runApplicationT (ApplicationT m -> m Application)
-> MiddlewareT m -> ApplicationT m -> m Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MiddlewareT m
midT (ApplicationT m -> IO Application)
-> ApplicationT m -> IO Application
forall a b. (a -> b) -> a -> b
$ Application -> ApplicationT m
forall (m :: * -> *).
MonadUnliftIO m =>
Application -> ApplicationT m
liftApplication Application
app
Application
app' Request
request Response -> IO ResponseReceived
respond