module Control.Monad.Ology.Specific.LifecycleT
    ( LifecycleT(..)
    , Lifecycle
    , runLifecycle
    , lifecycleOnCloseIO
    , lifecycleOnClose
    , lifecycleGetCloser
    , forkLifecycle
    , lifecycleMonitor
    -- * With
    , With
    , withLifecycle
    , lifecycleWith
    -- * LifeState
    , LifeState(..)
    , closeLifeState
    , getLifeState
    , addLifeState
    , modifyLifeState
    ) where

import Control.Monad.Ology.General
import Control.Monad.Ology.Specific.StateT
import Import

-- | This represents all the actions that need to be done when closing the lifecycle.
newtype LifeState = MkLifeState
    { LifeState -> Maybe (IO ())
unLifeState :: Maybe (IO ()) -- special case for empty
    }

closeLifeState :: LifeState -> IO ()
closeLifeState :: LifeState -> IO ()
closeLifeState (MkLifeState (Just IO ()
c)) = IO ()
c
closeLifeState (MkLifeState Maybe (IO ())
Nothing) = forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

instance Semigroup LifeState where
    MkLifeState Maybe (IO ())
Nothing <> :: LifeState -> LifeState -> LifeState
<> LifeState
q = LifeState
q
    LifeState
p <> MkLifeState Maybe (IO ())
Nothing = LifeState
p
    MkLifeState (Just IO ()
p) <> MkLifeState (Just IO ()
q) = Maybe (IO ()) -> LifeState
MkLifeState forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ IO ()
p forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> IO ()
q

instance Monoid LifeState where
    mempty :: LifeState
mempty = Maybe (IO ()) -> LifeState
MkLifeState forall a. Maybe a
Nothing

-- | This is for managing the automatic closing of opened resources.
newtype LifecycleT m a = MkLifecycleT
    { forall {k} (m :: k -> Type) (a :: k).
LifecycleT m a -> MVar LifeState -> m a
unLifecycleT :: MVar LifeState -> m a
    }

instance Functor m => Functor (LifecycleT m) where
    fmap :: forall a b. (a -> b) -> LifecycleT m a -> LifecycleT m b
fmap a -> b
ab (MkLifecycleT MVar LifeState -> m a
f) = forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
ab forall a b. (a -> b) -> a -> b
$ MVar LifeState -> m a
f MVar LifeState
var

instance TransConstraint Functor LifecycleT where
    hasTransConstraint :: forall (m :: Type -> Type).
Functor m =>
Dict (Functor (LifecycleT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Applicative m => Applicative (LifecycleT m) where
    pure :: forall a. a -> LifecycleT m a
pure a
t = forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
_ -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
t
    (MkLifecycleT MVar LifeState -> m (a -> b)
ocab) <*> :: forall a b.
LifecycleT m (a -> b) -> LifecycleT m a -> LifecycleT m b
<*> (MkLifecycleT MVar LifeState -> m a
oca) = forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> MVar LifeState -> m (a -> b)
ocab MVar LifeState
var forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> MVar LifeState -> m a
oca MVar LifeState
var

instance TransConstraint Applicative LifecycleT where
    hasTransConstraint :: forall (m :: Type -> Type).
Applicative m =>
Dict (Applicative (LifecycleT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Monad m => Monad (LifecycleT m) where
    return :: forall a. a -> LifecycleT m a
return = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
    (MkLifecycleT MVar LifeState -> m a
va) >>= :: forall a b.
LifecycleT m a -> (a -> LifecycleT m b) -> LifecycleT m b
>>= a -> LifecycleT m b
f =
        forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> do
            a
a <- MVar LifeState -> m a
va MVar LifeState
var
            forall {k} (m :: k -> Type) (a :: k).
LifecycleT m a -> MVar LifeState -> m a
unLifecycleT (a -> LifecycleT m b
f a
a) MVar LifeState
var

instance TransConstraint Monad LifecycleT where
    hasTransConstraint :: forall (m :: Type -> Type). Monad m => Dict (Monad (LifecycleT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance MonadTrans LifecycleT where
    lift :: forall (m :: Type -> Type) a. Monad m => m a -> LifecycleT m a
lift m a
ma = forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
_ -> m a
ma

instance MonadFail m => MonadFail (LifecycleT m) where
    fail :: forall a. String -> LifecycleT m a
fail String
s = forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
s

instance TransConstraint MonadFail LifecycleT where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadFail m =>
Dict (MonadFail (LifecycleT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance MonadException m => MonadException (LifecycleT m) where
    type Exc (LifecycleT m) = Exc m
    throwExc :: forall a. Exc (LifecycleT m) -> LifecycleT m a
throwExc Exc (LifecycleT m)
e = forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc (LifecycleT m)
e
    catchExc :: forall a. LifecycleT m a -> (Exc m -> LifecycleT m a) -> LifecycleT m a
    catchExc :: forall a.
LifecycleT m a -> (Exc m -> LifecycleT m a) -> LifecycleT m a
catchExc (MkLifecycleT MVar LifeState -> m a
f) Exc m -> LifecycleT m a
handler = forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc (MVar LifeState -> m a
f MVar LifeState
var) forall a b. (a -> b) -> a -> b
$ \Exc m
e -> forall {k} (m :: k -> Type) (a :: k).
LifecycleT m a -> MVar LifeState -> m a
unLifecycleT (Exc m -> LifecycleT m a
handler Exc m
e) MVar LifeState
var

instance TransConstraint MonadException LifecycleT where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadException m =>
Dict (MonadException (LifecycleT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance MonadThrow e m => MonadThrow e (LifecycleT m) where
    throw :: forall a. e -> LifecycleT m a
throw e
e = forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e (m :: Type -> Type) a. MonadThrow e m => e -> m a
throw e
e

instance TransConstraint (MonadThrow e) LifecycleT where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadThrow e m =>
Dict (MonadThrow e (LifecycleT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance MonadCatch e m => MonadCatch e (LifecycleT m) where
    catch :: forall a. LifecycleT m a -> (e -> LifecycleT m a) -> LifecycleT m a
catch (MkLifecycleT MVar LifeState -> m a
f) e -> LifecycleT m a
handler = forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> forall e (m :: Type -> Type) a.
MonadCatch e m =>
m a -> (e -> m a) -> m a
catch (MVar LifeState -> m a
f MVar LifeState
var) forall a b. (a -> b) -> a -> b
$ \e
e -> forall {k} (m :: k -> Type) (a :: k).
LifecycleT m a -> MVar LifeState -> m a
unLifecycleT (e -> LifecycleT m a
handler e
e) MVar LifeState
var

instance TransConstraint (MonadCatch e) LifecycleT where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadCatch e m =>
Dict (MonadCatch e (LifecycleT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance MonadFix m => MonadFix (LifecycleT m) where
    mfix :: forall a. (a -> LifecycleT m a) -> LifecycleT m a
mfix a -> LifecycleT m a
f = forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> forall (m :: Type -> Type) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \a
a -> forall {k} (m :: k -> Type) (a :: k).
LifecycleT m a -> MVar LifeState -> m a
unLifecycleT (a -> LifecycleT m a
f a
a) MVar LifeState
var

instance TransConstraint MonadFix LifecycleT where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadFix m =>
Dict (MonadFix (LifecycleT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance MonadIO m => MonadIO (LifecycleT m) where
    liftIO :: forall a. IO a -> LifecycleT m a
liftIO IO a
ioa = forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO a
ioa

instance TransConstraint MonadIO LifecycleT where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadIO m =>
Dict (MonadIO (LifecycleT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance MonadTransHoist LifecycleT where
    hoist :: forall (m1 :: Type -> Type) (m2 :: Type -> Type).
(Monad m1, Monad m2) =>
(m1 --> m2) -> LifecycleT m1 --> LifecycleT m2
hoist m1 --> m2
f (MkLifecycleT MVar LifeState -> m1 a
g) = forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> m1 --> m2
f forall a b. (a -> b) -> a -> b
$ MVar LifeState -> m1 a
g MVar LifeState
var

instance MonadTransTunnel LifecycleT where
    type Tunnel LifecycleT = Identity
    tunnel ::
           forall m r. Monad m
        => ((forall m1 a. Monad m1 => LifecycleT m1 a -> m1 (Identity a)) -> m (Identity r))
        -> LifecycleT m r
    tunnel :: forall (m :: Type -> Type) r.
Monad m =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  LifecycleT m1 a -> m1 (Identity a))
 -> m (Identity r))
-> LifecycleT m r
tunnel (forall (m1 :: Type -> Type) a.
 Monad m1 =>
 LifecycleT m1 a -> m1 (Identity a))
-> m (Identity r)
f = forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ (forall (m1 :: Type -> Type) a.
 Monad m1 =>
 LifecycleT m1 a -> m1 (Identity a))
-> m (Identity r)
f forall a b. (a -> b) -> a -> b
$ \LifecycleT m1 a
a -> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Identity a
Identity forall a b. (a -> b) -> a -> b
$ forall {k} (m :: k -> Type) (a :: k).
LifecycleT m a -> MVar LifeState -> m a
unLifecycleT LifecycleT m1 a
a MVar LifeState
var

instance MonadTransUnlift LifecycleT where
    liftWithUnlift :: forall (m :: Type -> Type) r.
MonadIO m =>
(Unlift MonadTunnelIOInner LifecycleT -> m r) -> LifecycleT m r
liftWithUnlift Unlift MonadTunnelIOInner LifecycleT -> m r
call = forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> Unlift MonadTunnelIOInner LifecycleT -> m r
call forall a b. (a -> b) -> a -> b
$ \(MkLifecycleT MVar LifeState -> m a
f) -> MVar LifeState -> m a
f MVar LifeState
var
    getDiscardingUnlift :: forall (m :: Type -> Type).
Monad m =>
LifecycleT m (WUnlift MonadTunnelIOInner LifecycleT)
getDiscardingUnlift =
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        forall (c :: (Type -> Type) -> Constraint) (t :: TransKind).
Unlift c t -> WUnlift c t
MkWUnlift forall a b. (a -> b) -> a -> b
$ \(MkLifecycleT MVar LifeState -> m a
f) -> do
            MVar LifeState
var <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar forall a. Monoid a => a
mempty
            MVar LifeState -> m a
f MVar LifeState
var

addLifeState :: MonadIO m => LifeState -> LifecycleT m ()
addLifeState :: forall (m :: Type -> Type).
MonadIO m =>
LifeState -> LifecycleT m ()
addLifeState LifeState
ls =
    forall {k} (m :: k -> Type) (a :: k).
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> do
        forall s. MVar s -> Unlift MonadIO (StateT s)
dangerousMVarRunStateT MVar LifeState
var forall a b. (a -> b) -> a -> b
$ do
            LifeState
s <- forall (m :: Type -> Type) s. Monad m => StateT s m s
get
            forall (m :: Type -> Type) s. Monad m => s -> StateT s m ()
put forall a b. (a -> b) -> a -> b
$ LifeState
ls forall a. Semigroup a => a -> a -> a
<> LifeState
s

-- | Add a closing action.
lifecycleOnCloseIO :: MonadIO m => IO () -> LifecycleT m ()
lifecycleOnCloseIO :: forall (m :: Type -> Type). MonadIO m => IO () -> LifecycleT m ()
lifecycleOnCloseIO IO ()
closer = forall (m :: Type -> Type).
MonadIO m =>
LifeState -> LifecycleT m ()
addLifeState forall a b. (a -> b) -> a -> b
$ Maybe (IO ()) -> LifeState
MkLifeState forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just IO ()
closer

-- | Add a closing action.
lifecycleOnClose :: MonadAskUnliftIO m => m () -> LifecycleT m ()
lifecycleOnClose :: forall (m :: Type -> Type).
MonadAskUnliftIO m =>
m () -> LifecycleT m ()
lifecycleOnClose m ()
closer = do
    MkWRaised m --> IO
unlift <- forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: Type -> Type). MonadAskUnliftIO m => m (WRaised m IO)
askUnliftIO
    forall (m :: Type -> Type). MonadIO m => IO () -> LifecycleT m ()
lifecycleOnCloseIO forall a b. (a -> b) -> a -> b
$ m --> IO
unlift m ()
closer

-- | Convert a lifecycle to a function that uses the \"with\" pattern.
withLifecycle ::
       forall m a. (MonadException m, MonadTunnelIO m)
    => LifecycleT m a
    -> With m a
withLifecycle :: forall (m :: Type -> Type) a.
(MonadException m, MonadTunnelIO m) =>
LifecycleT m a -> With m a
withLifecycle (MkLifecycleT MVar LifeState -> m a
f) a -> m r
run = do
    MVar LifeState
var <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar forall a. Monoid a => a
mempty
    forall (m :: Type -> Type) a.
(MonadException m, MonadTunnelIO m) =>
m a -> m () -> m a
finally (MVar LifeState -> m a
f MVar LifeState
var forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m r
run) forall a b. (a -> b) -> a -> b
$
        forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
            LifeState
ls <- forall a. MVar a -> IO a
takeMVar MVar LifeState
var
            LifeState -> IO ()
closeLifeState LifeState
ls

-- | Run the lifecycle, then close all resources in reverse order they were opened.
runLifecycle ::
       forall m. (MonadException m, MonadTunnelIO m)
    => LifecycleT m --> m
runLifecycle :: forall (m :: Type -> Type).
(MonadException m, MonadTunnelIO m) =>
LifecycleT m --> m
runLifecycle LifecycleT m a
lc = forall (m :: Type -> Type) a.
(MonadException m, MonadTunnelIO m) =>
LifecycleT m a -> With m a
withLifecycle LifecycleT m a
lc forall (m :: Type -> Type) a. Monad m => a -> m a
return

-- | Fork a thread that will complete in this lifecycle. Closing will wait for the thread to finish.
forkLifecycle :: MonadUnliftIO m => m () -> LifecycleT m ThreadId
forkLifecycle :: forall (m :: Type -> Type).
MonadUnliftIO m =>
m () -> LifecycleT m ThreadId
forkLifecycle m ()
action = do
    MVar ()
var <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a. IO (MVar a)
newEmptyMVar
    forall (m :: Type -> Type). MonadIO m => IO () -> LifecycleT m ()
lifecycleOnCloseIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar ()
var
    forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type). MonadUnliftIO m => IO -/-> m
liftIOWithUnlift forall a b. (a -> b) -> a -> b
$ \m --> IO
unlift -> IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a.
(MonadException m, MonadTunnelIO m) =>
m a -> m () -> m a
finally (m --> IO
unlift m ()
action) forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar ()
var ()

-- | Runs a lifecycle, but instead of running the closing actions, return them as a 'LifeState'.
getLifeState ::
       forall m a. MonadIO m
    => LifecycleT m a
    -> m (a, LifeState)
getLifeState :: forall (m :: Type -> Type) a.
MonadIO m =>
LifecycleT m a -> m (a, LifeState)
getLifeState (MkLifecycleT MVar LifeState -> m a
f) = do
    MVar LifeState
var <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar forall a. Monoid a => a
mempty
    a
t <- MVar LifeState -> m a
f MVar LifeState
var
    let
        ls :: LifeState
ls =
            Maybe (IO ()) -> LifeState
MkLifeState forall a b. (a -> b) -> a -> b
$
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
                LifeState
ls0 <- forall a. MVar a -> IO a
takeMVar MVar LifeState
var
                LifeState -> IO ()
closeLifeState LifeState
ls0
    forall (m :: Type -> Type) a. Monad m => a -> m a
return (a
t, LifeState
ls)

modifyLifeState ::
       forall m. MonadIO m
    => (LifeState -> LifeState)
    -> LifecycleT m --> LifecycleT m
modifyLifeState :: forall (m :: Type -> Type).
MonadIO m =>
(LifeState -> LifeState) -> LifecycleT m --> LifecycleT m
modifyLifeState LifeState -> LifeState
ss LifecycleT m a
la = do
    (a
a, LifeState
ls) <- forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a.
MonadIO m =>
LifecycleT m a -> m (a, LifeState)
getLifeState LifecycleT m a
la
    forall (m :: Type -> Type).
MonadIO m =>
LifeState -> LifecycleT m ()
addLifeState forall a b. (a -> b) -> a -> b
$ LifeState -> LifeState
ss LifeState
ls
    forall (m :: Type -> Type) a. Monad m => a -> m a
return a
a

-- | Runs the given lifecycle, returning a closer.
-- This is how you close things out of order.
--
-- The closer is an idempotent action that will close the lifecycle only if it hasn't already been closed.
-- The closer will also be run as the closer of the resulting lifecycle.
lifecycleGetCloser ::
       forall m a. MonadIO m
    => LifecycleT m a
    -> LifecycleT m (a, IO ())
lifecycleGetCloser :: forall (m :: Type -> Type) a.
MonadIO m =>
LifecycleT m a -> LifecycleT m (a, IO ())
lifecycleGetCloser LifecycleT m a
lc = do
    (a
a, LifeState
ls) <- forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a.
MonadIO m =>
LifecycleT m a -> m (a, LifeState)
getLifeState LifecycleT m a
lc
    MVar ()
var <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar ()
    let
        earlycloser :: IO ()
        earlycloser :: IO ()
earlycloser = do
            Maybe ()
mu <- forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar ()
var
            case Maybe ()
mu of
                Just () -> LifeState -> IO ()
closeLifeState LifeState
ls
                Maybe ()
Nothing -> forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
    forall (m :: Type -> Type). MonadIO m => IO () -> LifecycleT m ()
lifecycleOnCloseIO IO ()
earlycloser
    forall (m :: Type -> Type) a. Monad m => a -> m a
return (a
a, IO ()
earlycloser)

-- | Returned action returns 'True' if still alive, 'False' if closed.
lifecycleMonitor :: MonadIO m => LifecycleT m (IO Bool)
lifecycleMonitor :: forall (m :: Type -> Type). MonadIO m => LifecycleT m (IO Bool)
lifecycleMonitor = do
    IORef Bool
ref <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
True
    forall (m :: Type -> Type). MonadIO m => IO () -> LifecycleT m ()
lifecycleOnCloseIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref Bool
False
    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Bool
ref

-- | Convert a function that uses the \"with\" pattern to a lifecycle.
lifecycleWith :: (MonadCoroutine m, MonadAskUnliftIO m) => With m t -> LifecycleT m t
lifecycleWith :: forall (m :: Type -> Type) t.
(MonadCoroutine m, MonadAskUnliftIO m) =>
With m t -> LifecycleT m t
lifecycleWith With m t
withX = do
    (t
t, m ()
closer) <- forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a.
MonadCoroutine m =>
With m a -> m (a, m ())
unpickWith With m t
withX
    forall (m :: Type -> Type).
MonadAskUnliftIO m =>
m () -> LifecycleT m ()
lifecycleOnClose m ()
closer
    forall (m :: Type -> Type) a. Monad m => a -> m a
return t
t

-- | This is the expected most common use.
type Lifecycle = LifecycleT IO