{-# LANGUAGE RankNTypes #-}
module Orville.PostgreSQL.UnliftIO
( liftWithConnectionViaUnliftIO
, liftCatchViaUnliftIO
, liftMaskViaUnliftIO
)
where
import qualified Control.Monad.IO.Unlift as UL
liftWithConnectionViaUnliftIO ::
UL.MonadUnliftIO m =>
(forall a. (conn -> IO a) -> IO a) ->
(conn -> m b) ->
m b
liftWithConnectionViaUnliftIO :: forall (m :: * -> *) conn b.
MonadUnliftIO m =>
(forall a. (conn -> IO a) -> IO a) -> (conn -> m b) -> m b
liftWithConnectionViaUnliftIO forall a. (conn -> IO a) -> IO a
ioWithConn conn -> m b
action =
((forall a. m a -> IO a) -> IO b) -> m b
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
UL.withRunInIO (((forall a. m a -> IO a) -> IO b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO -> (conn -> IO b) -> IO b
forall a. (conn -> IO a) -> IO a
ioWithConn (m b -> IO b
forall a. m a -> IO a
runInIO (m b -> IO b) -> (conn -> m b) -> conn -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. conn -> m b
action)
liftCatchViaUnliftIO ::
UL.MonadUnliftIO m =>
(forall a. IO a -> (e -> IO a) -> IO a) ->
m b ->
(e -> m b) ->
m b
liftCatchViaUnliftIO :: forall (m :: * -> *) e b.
MonadUnliftIO m =>
(forall a. IO a -> (e -> IO a) -> IO a) -> m b -> (e -> m b) -> m b
liftCatchViaUnliftIO forall a. IO a -> (e -> IO a) -> IO a
ioCatch m b
action e -> m b
handler = do
UnliftIO m
unlio <- m (UnliftIO m)
forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
UL.askUnliftIO
IO b -> m b
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
UL.liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$
IO b -> (e -> IO b) -> IO b
forall a. IO a -> (e -> IO a) -> IO a
ioCatch
(UnliftIO m -> forall a. m a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
UL.unliftIO UnliftIO m
unlio m b
action)
(\e
ex -> UnliftIO m -> forall a. m a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
UL.unliftIO UnliftIO m
unlio (e -> m b
handler e
ex))
liftMaskViaUnliftIO ::
UL.MonadUnliftIO m =>
(forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b) ->
((forall a. m a -> m a) -> m c) ->
m c
liftMaskViaUnliftIO :: forall (m :: * -> *) c.
MonadUnliftIO m =>
(forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. m a -> m a) -> m c) -> m c
liftMaskViaUnliftIO forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
ioMask (forall a. m a -> m a) -> m c
action = do
UnliftIO m
unlio <- m (UnliftIO m)
forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
UL.askUnliftIO
IO c -> m c
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
UL.liftIO (IO c -> m c) -> IO c -> m c
forall a b. (a -> b) -> a -> b
$
((forall a. IO a -> IO a) -> IO c) -> IO c
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
ioMask (((forall a. IO a -> IO a) -> IO c) -> IO c)
-> ((forall a. IO a -> IO a) -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore ->
UnliftIO m -> forall a. m a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
UL.unliftIO
UnliftIO m
unlio
((forall a. m a -> m a) -> m c
action (IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
UL.liftIO (IO a -> m a) -> (m a -> IO a) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
forall a. IO a -> IO a
restore (IO a -> IO a) -> (m a -> IO a) -> m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnliftIO m -> forall a. m a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
UL.unliftIO UnliftIO m
unlio))