module Control.Monad.Trans.Managed
( ManagedT (..),
allocate,
allocate_,
lowerManagedT,
hoistManagedTReaderT,
)
where
import Control.Concurrent qualified as C
import Control.Exception.Lifted (bracket, bracket_)
import Control.Monad.Codensity (Codensity (..))
import Control.Monad.Fix (MonadFix (..))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader.Class (MonadReader)
import Control.Monad.State.Class (MonadState)
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Reader (ReaderT (..))
import GHC.IO.Unsafe (unsafeDupableInterleaveIO)
import Prelude
newtype ManagedT m a = ManagedT {ManagedT m a -> forall r. (a -> m r) -> m r
runManagedT :: forall r. (a -> m r) -> m r}
deriving
( a -> ManagedT m b -> ManagedT m a
(a -> b) -> ManagedT m a -> ManagedT m b
(forall a b. (a -> b) -> ManagedT m a -> ManagedT m b)
-> (forall a b. a -> ManagedT m b -> ManagedT m a)
-> Functor (ManagedT m)
forall a b. a -> ManagedT m b -> ManagedT m a
forall a b. (a -> b) -> ManagedT m a -> ManagedT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> ManagedT m b -> ManagedT m a
forall (m :: * -> *) a b. (a -> b) -> ManagedT m a -> ManagedT m b
<$ :: a -> ManagedT m b -> ManagedT m a
$c<$ :: forall (m :: * -> *) a b. a -> ManagedT m b -> ManagedT m a
fmap :: (a -> b) -> ManagedT m a -> ManagedT m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> ManagedT m a -> ManagedT m b
Functor,
Functor (ManagedT m)
a -> ManagedT m a
Functor (ManagedT m)
-> (forall a. a -> ManagedT m a)
-> (forall a b.
ManagedT m (a -> b) -> ManagedT m a -> ManagedT m b)
-> (forall a b c.
(a -> b -> c) -> ManagedT m a -> ManagedT m b -> ManagedT m c)
-> (forall a b. ManagedT m a -> ManagedT m b -> ManagedT m b)
-> (forall a b. ManagedT m a -> ManagedT m b -> ManagedT m a)
-> Applicative (ManagedT m)
ManagedT m a -> ManagedT m b -> ManagedT m b
ManagedT m a -> ManagedT m b -> ManagedT m a
ManagedT m (a -> b) -> ManagedT m a -> ManagedT m b
(a -> b -> c) -> ManagedT m a -> ManagedT m b -> ManagedT m c
forall a. a -> ManagedT m a
forall a b. ManagedT m a -> ManagedT m b -> ManagedT m a
forall a b. ManagedT m a -> ManagedT m b -> ManagedT m b
forall a b. ManagedT m (a -> b) -> ManagedT m a -> ManagedT m b
forall a b c.
(a -> b -> c) -> ManagedT m a -> ManagedT m b -> ManagedT m c
forall (m :: * -> *). Functor (ManagedT m)
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 :: * -> *) a. a -> ManagedT m a
forall (m :: * -> *) a b.
ManagedT m a -> ManagedT m b -> ManagedT m a
forall (m :: * -> *) a b.
ManagedT m a -> ManagedT m b -> ManagedT m b
forall (m :: * -> *) a b.
ManagedT m (a -> b) -> ManagedT m a -> ManagedT m b
forall (m :: * -> *) a b c.
(a -> b -> c) -> ManagedT m a -> ManagedT m b -> ManagedT m c
<* :: ManagedT m a -> ManagedT m b -> ManagedT m a
$c<* :: forall (m :: * -> *) a b.
ManagedT m a -> ManagedT m b -> ManagedT m a
*> :: ManagedT m a -> ManagedT m b -> ManagedT m b
$c*> :: forall (m :: * -> *) a b.
ManagedT m a -> ManagedT m b -> ManagedT m b
liftA2 :: (a -> b -> c) -> ManagedT m a -> ManagedT m b -> ManagedT m c
$cliftA2 :: forall (m :: * -> *) a b c.
(a -> b -> c) -> ManagedT m a -> ManagedT m b -> ManagedT m c
<*> :: ManagedT m (a -> b) -> ManagedT m a -> ManagedT m b
$c<*> :: forall (m :: * -> *) a b.
ManagedT m (a -> b) -> ManagedT m a -> ManagedT m b
pure :: a -> ManagedT m a
$cpure :: forall (m :: * -> *) a. a -> ManagedT m a
$cp1Applicative :: forall (m :: * -> *). Functor (ManagedT m)
Applicative,
Applicative (ManagedT m)
a -> ManagedT m a
Applicative (ManagedT m)
-> (forall a b.
ManagedT m a -> (a -> ManagedT m b) -> ManagedT m b)
-> (forall a b. ManagedT m a -> ManagedT m b -> ManagedT m b)
-> (forall a. a -> ManagedT m a)
-> Monad (ManagedT m)
ManagedT m a -> (a -> ManagedT m b) -> ManagedT m b
ManagedT m a -> ManagedT m b -> ManagedT m b
forall a. a -> ManagedT m a
forall a b. ManagedT m a -> ManagedT m b -> ManagedT m b
forall a b. ManagedT m a -> (a -> ManagedT m b) -> ManagedT m b
forall (m :: * -> *). Applicative (ManagedT m)
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
forall (m :: * -> *) a. a -> ManagedT m a
forall (m :: * -> *) a b.
ManagedT m a -> ManagedT m b -> ManagedT m b
forall (m :: * -> *) a b.
ManagedT m a -> (a -> ManagedT m b) -> ManagedT m b
return :: a -> ManagedT m a
$creturn :: forall (m :: * -> *) a. a -> ManagedT m a
>> :: ManagedT m a -> ManagedT m b -> ManagedT m b
$c>> :: forall (m :: * -> *) a b.
ManagedT m a -> ManagedT m b -> ManagedT m b
>>= :: ManagedT m a -> (a -> ManagedT m b) -> ManagedT m b
$c>>= :: forall (m :: * -> *) a b.
ManagedT m a -> (a -> ManagedT m b) -> ManagedT m b
$cp1Monad :: forall (m :: * -> *). Applicative (ManagedT m)
Monad,
Monad (ManagedT m)
Monad (ManagedT m)
-> (forall a. IO a -> ManagedT m a) -> MonadIO (ManagedT m)
IO a -> ManagedT m a
forall a. IO a -> ManagedT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (ManagedT m)
forall (m :: * -> *) a. MonadIO m => IO a -> ManagedT m a
liftIO :: IO a -> ManagedT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ManagedT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (ManagedT m)
MonadIO,
MonadReader r,
MonadState s
)
via (Codensity m)
deriving (m a -> ManagedT m a
(forall (m :: * -> *) a. Monad m => m a -> ManagedT m a)
-> MonadTrans ManagedT
forall (m :: * -> *) a. Monad m => m a -> ManagedT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ManagedT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> ManagedT m a
MonadTrans) via Codensity
allocate :: MonadBaseControl IO m => m a -> (a -> m b) -> ManagedT m a
allocate :: m a -> (a -> m b) -> ManagedT m a
allocate m a
setup a -> m b
finalize = (forall r. (a -> m r) -> m r) -> ManagedT m a
forall (m :: * -> *) a.
(forall r. (a -> m r) -> m r) -> ManagedT m a
ManagedT (m a -> (a -> m b) -> (a -> m r) -> m r
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
setup a -> m b
finalize)
allocate_ :: MonadBaseControl IO m => m a -> m b -> ManagedT m ()
allocate_ :: m a -> m b -> ManagedT m ()
allocate_ m a
setup m b
finalize = (forall r. (() -> m r) -> m r) -> ManagedT m ()
forall (m :: * -> *) a.
(forall r. (a -> m r) -> m r) -> ManagedT m a
ManagedT (\() -> m r
k -> m a -> m b -> m r -> m r
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> m b -> m c -> m c
bracket_ m a
setup m b
finalize (() -> m r
k ()))
lowerManagedT :: Monad m => ManagedT m a -> m a
lowerManagedT :: ManagedT m a -> m a
lowerManagedT ManagedT m a
m = ManagedT m a -> (a -> m a) -> m a
forall (m :: * -> *) a. ManagedT m a -> forall r. (a -> m r) -> m r
runManagedT ManagedT m a
m a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
hoistManagedTReaderT :: Monad m => r -> ManagedT (ReaderT r m) a -> ManagedT m a
hoistManagedTReaderT :: r -> ManagedT (ReaderT r m) a -> ManagedT m a
hoistManagedTReaderT r
r ManagedT (ReaderT r m) a
cod = (forall r. (a -> m r) -> m r) -> ManagedT m a
forall (m :: * -> *) a.
(forall r. (a -> m r) -> m r) -> ManagedT m a
ManagedT ((forall r. (a -> m r) -> m r) -> ManagedT m a)
-> (forall r. (a -> m r) -> m r) -> ManagedT m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
k ->
ReaderT r m r -> r -> m r
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ManagedT (ReaderT r m) a -> (a -> ReaderT r m r) -> ReaderT r m r
forall (m :: * -> *) a. ManagedT m a -> forall r. (a -> m r) -> m r
runManagedT ManagedT (ReaderT r m) a
cod (m r -> ReaderT r m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m r -> ReaderT r m r) -> (a -> m r) -> a -> ReaderT r m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m r
k)) r
r
instance MonadIO m => MonadFix (ManagedT m) where
mfix :: (a -> ManagedT m a) -> ManagedT m a
mfix a -> ManagedT m a
f = (forall r. (a -> m r) -> m r) -> ManagedT m a
forall (m :: * -> *) a.
(forall r. (a -> m r) -> m r) -> ManagedT m a
ManagedT \a -> m r
k -> do
MVar a
m <- IO (MVar a) -> m (MVar a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar a)
forall a. IO (MVar a)
C.newEmptyMVar
a
ans <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ IO a -> IO a
forall a. IO a -> IO a
unsafeDupableInterleaveIO (MVar a -> IO a
forall a. MVar a -> IO a
C.readMVar MVar a
m)
ManagedT m a -> (a -> m r) -> m r
forall (m :: * -> *) a. ManagedT m a -> forall r. (a -> m r) -> m r
runManagedT (a -> ManagedT m a
f a
ans) \a
a -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
C.putMVar MVar a
m a
a
a -> m r
k a
a