{-# LANGUAGE TemplateHaskell #-}
module Control.Effect.Resource
(
Resource'(..)
, finally'
, onException'
, Resource
, bracket
, bracketOnError
, finally
, onException
, LowerIO
, runResourceIO'
, runResourceIO
, tagResource'
, retagResource'
, untagResource'
) where
import qualified Control.Exception as IO
import Data.Coerce (coerce)
import Control.Effect.Machinery
class MonadIO m => Resource' tag m where
bracket' :: m a
-> (a -> m c)
-> (a -> m b)
-> m b
bracketOnError' :: m a
-> (a -> m c)
-> (a -> m b)
-> m b
makeTaggedEffect ''Resource'
finally' :: forall tag m a b. Resource' tag m
=> m a
-> m b
-> m a
finally' :: m a -> m b -> m a
finally' m a
use m b
free =
m () -> (() -> m b) -> (() -> m a) -> m a
forall k (tag :: k) (m :: * -> *) a c b.
Resource' tag m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket' @tag (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (m b -> () -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure m b
free) (m a -> () -> m a
forall a b. a -> b -> a
const m a
use)
{-# INLINE finally' #-}
onException' :: forall tag m a b. Resource' tag m
=> m a
-> m b
-> m a
onException' :: m a -> m b -> m a
onException' m a
use m b
free =
m () -> (() -> m b) -> (() -> m a) -> m a
forall k (tag :: k) (m :: * -> *) a c b.
Resource' tag m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError' @tag (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (m b -> () -> m b
forall a b. a -> b -> a
const m b
free) (m a -> () -> m a
forall a b. a -> b -> a
const m a
use)
{-# INLINE onException' #-}
makeUntagged ['finally', 'onException']
newtype LowerIO m a =
LowerIO { LowerIO m a -> m a
_runLowerIO :: m a }
deriving (Functor (LowerIO m)
a -> LowerIO m a
Functor (LowerIO m)
-> (forall a. a -> LowerIO m a)
-> (forall a b. LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b)
-> (forall a b c.
(a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c)
-> (forall a b. LowerIO m a -> LowerIO m b -> LowerIO m b)
-> (forall a b. LowerIO m a -> LowerIO m b -> LowerIO m a)
-> Applicative (LowerIO m)
LowerIO m a -> LowerIO m b -> LowerIO m b
LowerIO m a -> LowerIO m b -> LowerIO m a
LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b
(a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c
forall a. a -> LowerIO m a
forall a b. LowerIO m a -> LowerIO m b -> LowerIO m a
forall a b. LowerIO m a -> LowerIO m b -> LowerIO m b
forall a b. LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b
forall a b c.
(a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (LowerIO m)
forall (m :: * -> *) a. Applicative m => a -> LowerIO m a
forall (m :: * -> *) a b.
Applicative m =>
LowerIO m a -> LowerIO m b -> LowerIO m a
forall (m :: * -> *) a b.
Applicative m =>
LowerIO m a -> LowerIO m b -> LowerIO m b
forall (m :: * -> *) a b.
Applicative m =>
LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c
<* :: LowerIO m a -> LowerIO m b -> LowerIO m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
LowerIO m a -> LowerIO m b -> LowerIO m a
*> :: LowerIO m a -> LowerIO m b -> LowerIO m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
LowerIO m a -> LowerIO m b -> LowerIO m b
liftA2 :: (a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c
<*> :: LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b
pure :: a -> LowerIO m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> LowerIO m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (LowerIO m)
Applicative, a -> LowerIO m b -> LowerIO m a
(a -> b) -> LowerIO m a -> LowerIO m b
(forall a b. (a -> b) -> LowerIO m a -> LowerIO m b)
-> (forall a b. a -> LowerIO m b -> LowerIO m a)
-> Functor (LowerIO m)
forall a b. a -> LowerIO m b -> LowerIO m a
forall a b. (a -> b) -> LowerIO m a -> LowerIO m b
forall (m :: * -> *) a b.
Functor m =>
a -> LowerIO m b -> LowerIO m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LowerIO m a -> LowerIO m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LowerIO m b -> LowerIO m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> LowerIO m b -> LowerIO m a
fmap :: (a -> b) -> LowerIO m a -> LowerIO m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LowerIO m a -> LowerIO m b
Functor, Applicative (LowerIO m)
a -> LowerIO m a
Applicative (LowerIO m)
-> (forall a b. LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b)
-> (forall a b. LowerIO m a -> LowerIO m b -> LowerIO m b)
-> (forall a. a -> LowerIO m a)
-> Monad (LowerIO m)
LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
LowerIO m a -> LowerIO m b -> LowerIO m b
forall a. a -> LowerIO m a
forall a b. LowerIO m a -> LowerIO m b -> LowerIO m b
forall a b. LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
forall (m :: * -> *). Monad m => Applicative (LowerIO m)
forall (m :: * -> *) a. Monad m => a -> LowerIO m a
forall (m :: * -> *) a b.
Monad m =>
LowerIO m a -> LowerIO m b -> LowerIO m b
forall (m :: * -> *) a b.
Monad m =>
LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> LowerIO m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> LowerIO m a
>> :: LowerIO m a -> LowerIO m b -> LowerIO m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
LowerIO m a -> LowerIO m b -> LowerIO m b
>>= :: LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (LowerIO m)
Monad, Monad (LowerIO m)
Monad (LowerIO m)
-> (forall a. IO a -> LowerIO m a) -> MonadIO (LowerIO m)
IO a -> LowerIO m a
forall a. IO a -> LowerIO m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (LowerIO m)
forall (m :: * -> *) a. MonadIO m => IO a -> LowerIO m a
liftIO :: IO a -> LowerIO m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> LowerIO m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (LowerIO m)
MonadIO)
deriving (m a -> LowerIO m a
(forall (m :: * -> *) a. Monad m => m a -> LowerIO m a)
-> MonadTrans LowerIO
forall (m :: * -> *) a. Monad m => m a -> LowerIO m a
forall (t :: Transformer).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> LowerIO m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> LowerIO m a
MonadTrans, MonadTrans LowerIO
m (StT LowerIO a) -> LowerIO m a
MonadTrans LowerIO
-> (forall (m :: * -> *) a.
Monad m =>
(Run LowerIO -> m a) -> LowerIO m a)
-> (forall (m :: * -> *) a.
Monad m =>
m (StT LowerIO a) -> LowerIO m a)
-> MonadTransControl LowerIO
(Run LowerIO -> m a) -> LowerIO m a
forall (m :: * -> *) a. Monad m => m (StT LowerIO a) -> LowerIO m a
forall (m :: * -> *) a.
Monad m =>
(Run LowerIO -> m a) -> LowerIO m a
forall (t :: Transformer).
MonadTrans t
-> (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT LowerIO a) -> LowerIO m a
$crestoreT :: forall (m :: * -> *) a. Monad m => m (StT LowerIO a) -> LowerIO m a
liftWith :: (Run LowerIO -> m a) -> LowerIO m a
$cliftWith :: forall (m :: * -> *) a.
Monad m =>
(Run LowerIO -> m a) -> LowerIO m a
$cp1MonadTransControl :: MonadTrans LowerIO
MonadTransControl) via IdentityT
deriving (MonadBase b, MonadBaseControl b)
instance (MonadBaseControl IO m, MonadIO m) => Resource' tag (LowerIO m) where
bracket' :: LowerIO m a
-> (a -> LowerIO m c) -> (a -> LowerIO m b) -> LowerIO m b
bracket' LowerIO m a
alloc a -> LowerIO m c
free a -> LowerIO m b
use =
(RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b)) -> LowerIO m b
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b))
-> LowerIO m b)
-> (RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b))
-> LowerIO m b
forall a b. (a -> b) -> a -> b
$ \RunInBase (LowerIO m) IO
run ->
IO (StM m a)
-> (StM m a -> IO (StM m c))
-> (StM m a -> IO (StM m b))
-> IO (StM m b)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
IO.bracket
( LowerIO m a -> IO (StM (LowerIO m) a)
RunInBase (LowerIO m) IO
run LowerIO m a
alloc )
( \StM m a
a -> LowerIO m c -> IO (StM (LowerIO m) c)
RunInBase (LowerIO m) IO
run (StM (LowerIO m) a -> LowerIO m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
StM (LowerIO m) a
a LowerIO m a -> (a -> LowerIO m c) -> LowerIO m c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> LowerIO m c
free) )
( \StM m a
a -> LowerIO m b -> IO (StM (LowerIO m) b)
RunInBase (LowerIO m) IO
run (StM (LowerIO m) a -> LowerIO m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
StM (LowerIO m) a
a LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> LowerIO m b
use) )
{-# INLINABLE bracket' #-}
bracketOnError' :: LowerIO m a
-> (a -> LowerIO m c) -> (a -> LowerIO m b) -> LowerIO m b
bracketOnError' LowerIO m a
alloc a -> LowerIO m c
free a -> LowerIO m b
use =
(RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b)) -> LowerIO m b
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b))
-> LowerIO m b)
-> (RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b))
-> LowerIO m b
forall a b. (a -> b) -> a -> b
$ \RunInBase (LowerIO m) IO
run ->
IO (StM m a)
-> (StM m a -> IO (StM m c))
-> (StM m a -> IO (StM m b))
-> IO (StM m b)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
IO.bracketOnError
( LowerIO m a -> IO (StM (LowerIO m) a)
RunInBase (LowerIO m) IO
run LowerIO m a
alloc )
( \StM m a
a -> LowerIO m c -> IO (StM (LowerIO m) c)
RunInBase (LowerIO m) IO
run (StM (LowerIO m) a -> LowerIO m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
StM (LowerIO m) a
a LowerIO m a -> (a -> LowerIO m c) -> LowerIO m c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> LowerIO m c
free) )
( \StM m a
a -> LowerIO m b -> IO (StM (LowerIO m) b)
RunInBase (LowerIO m) IO
run (StM (LowerIO m) a -> LowerIO m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
StM (LowerIO m) a
a LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> LowerIO m b
use) )
{-# INLINABLE bracketOnError' #-}
runResourceIO' :: (Resource' tag `Via` LowerIO) m a -> m a
runResourceIO' :: Via (Resource' tag) LowerIO m a -> m a
runResourceIO' = Via (Resource' tag) LowerIO m a -> m a
coerce
{-# INLINE runResourceIO' #-}
makeUntagged ['runResourceIO']