module Control.Monad.Ology.Specific.LifecycleT
    ( LifecycleT(..)
    , Lifecycle
    , runLifecycle
    , lifecycleOnCloseIO
    , lifecycleOnClose
    , lifecycleGetCloser
    , forkLifecycle
    , lifecycleMonitor
    -- * With
    , With
    , withLifecycle
    , lifecycleWith
    -- * LifeState
    , LifeState
    , pattern NoLifeState
    , lifeStateModify
    , 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 (Maybe (IO (IO Any)))

pattern NoLifeState :: LifeState

pattern $mNoLifeState :: forall {r}. LifeState -> ((# #) -> r) -> ((# #) -> r) -> r
$bNoLifeState :: LifeState
NoLifeState = MkLifeState Nothing

lifeStateModify :: (IO --> IO) -> LifeState -> LifeState
lifeStateModify :: (IO --> IO) -> LifeState -> LifeState
lifeStateModify IO --> IO
_ (MkLifeState Maybe (IO (IO Any))
Nothing) = Maybe (IO (IO Any)) -> LifeState
MkLifeState Maybe (IO (IO Any))
forall a. Maybe a
Nothing
lifeStateModify IO --> IO
m (MkLifeState (Just IO (IO Any)
ioioa)) = Maybe (IO (IO Any)) -> LifeState
MkLifeState (Maybe (IO (IO Any)) -> LifeState)
-> Maybe (IO (IO Any)) -> LifeState
forall a b. (a -> b) -> a -> b
$ IO (IO Any) -> Maybe (IO (IO Any))
forall a. a -> Maybe a
Just (IO (IO Any) -> Maybe (IO (IO Any)))
-> IO (IO Any) -> Maybe (IO (IO Any))
forall a b. (a -> b) -> a -> b
$ IO (IO Any) -> IO (IO Any)
IO --> IO
m (IO (IO Any) -> IO (IO Any)) -> IO (IO Any) -> IO (IO Any)
forall a b. (a -> b) -> a -> b
$ (IO Any -> IO Any) -> IO (IO Any) -> IO (IO Any)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap IO Any -> IO Any
IO --> IO
m IO (IO Any)
ioioa

closeIOAny :: IO Any -> IO ()
closeIOAny :: IO Any -> IO ()
closeIOAny IO Any
ioa = do
    Any Bool
b <- IO Any
ioa
    if Bool
b
        then IO Any -> IO ()
closeIOAny IO Any
ioa
        else () -> IO ()
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

closeLifeState' :: LifeState -> IO Any
closeLifeState' :: LifeState -> IO Any
closeLifeState' (MkLifeState (Just IO (IO Any)
ioioa)) = do
    IO Any
ioa <- IO (IO Any)
ioioa
    IO Any -> IO ()
closeIOAny IO Any
ioa
    Any -> IO Any
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Any -> IO Any) -> Any -> IO Any
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
closeLifeState' (MkLifeState Maybe (IO (IO Any))
Nothing) = Any -> IO Any
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Any -> IO Any) -> Any -> IO Any
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
False

closeLifeState :: LifeState -> IO ()
closeLifeState :: LifeState -> IO ()
closeLifeState LifeState
ls = do
    Any
_ <- LifeState -> IO Any
closeLifeState' LifeState
ls
    () -> IO ()
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

varLifeState :: MVar LifeState -> LifeState
varLifeState :: MVar LifeState -> LifeState
varLifeState MVar LifeState
var =
    Maybe (IO (IO Any)) -> LifeState
MkLifeState (Maybe (IO (IO Any)) -> LifeState)
-> Maybe (IO (IO Any)) -> LifeState
forall a b. (a -> b) -> a -> b
$
    IO (IO Any) -> Maybe (IO (IO Any))
forall a. a -> Maybe a
Just (IO (IO Any) -> Maybe (IO (IO Any)))
-> IO (IO Any) -> Maybe (IO (IO Any))
forall a b. (a -> b) -> a -> b
$
    IO Any -> IO (IO Any)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (IO Any -> IO (IO Any)) -> IO Any -> IO (IO Any)
forall a b. (a -> b) -> a -> b
$ do
        LifeState
ls <- MVar LifeState -> IO LifeState
forall a. MVar a -> IO a
takeMVar MVar LifeState
var
        MVar LifeState -> LifeState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar LifeState
var LifeState
forall a. Monoid a => a
mempty
        LifeState -> IO Any
closeLifeState' LifeState
ls

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

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

-- | This is for managing the automatic closing of opened resources.
newtype LifecycleT (m :: Type -> Type) (a :: Type) = MkLifecycleT
    { forall (m :: Type -> Type) a.
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) = (MVar LifeState -> m b) -> LifecycleT m b
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m b) -> LifecycleT m b)
-> (MVar LifeState -> m b) -> LifecycleT m b
forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> (a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
ab (m a -> m b) -> m a -> m b
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 = Dict (Functor (LifecycleT m))
forall (a :: Constraint). a => Dict a
Dict

instance Applicative m => Applicative (LifecycleT m) where
    pure :: forall a. a -> LifecycleT m a
pure a
t = (MVar LifeState -> m a) -> LifecycleT m a
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m a) -> LifecycleT m a)
-> (MVar LifeState -> m a) -> LifecycleT m a
forall a b. (a -> b) -> a -> b
$ \MVar LifeState
_ -> a -> m a
forall a. a -> m a
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) = (MVar LifeState -> m b) -> LifecycleT m b
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m b) -> LifecycleT m b)
-> (MVar LifeState -> m b) -> LifecycleT m b
forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> MVar LifeState -> m (a -> b)
ocab MVar LifeState
var m (a -> b) -> m a -> m b
forall a b. m (a -> b) -> m a -> m b
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 = Dict (Applicative (LifecycleT m))
forall (a :: Constraint). a => Dict a
Dict

instance Monad m => Monad (LifecycleT m) where
    return :: forall a. a -> LifecycleT m a
return = a -> LifecycleT m a
forall a. a -> LifecycleT m a
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 =
        (MVar LifeState -> m b) -> LifecycleT m b
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m b) -> LifecycleT m b)
-> (MVar LifeState -> m b) -> LifecycleT m b
forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> do
            a
a <- MVar LifeState -> m a
va MVar LifeState
var
            LifecycleT m b -> MVar LifeState -> m b
forall (m :: Type -> Type) a.
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 = Dict (Monad (LifecycleT m))
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 = (MVar LifeState -> m a) -> LifecycleT m a
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m a) -> LifecycleT m a)
-> (MVar LifeState -> m a) -> LifecycleT m a
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 = m a -> LifecycleT m a
forall (m :: Type -> Type) a. Monad m => m a -> LifecycleT m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> LifecycleT m a) -> m a -> LifecycleT m a
forall a b. (a -> b) -> a -> b
$ String -> m a
forall a. String -> m a
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 = Dict (MonadFail (LifecycleT m))
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 = m a -> LifecycleT m a
forall (m :: Type -> Type) a. Monad m => m a -> LifecycleT m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> LifecycleT m a) -> m a -> LifecycleT m a
forall a b. (a -> b) -> a -> b
$ Exc m -> m a
forall a. Exc m -> m a
forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc m
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 = (MVar LifeState -> m a) -> LifecycleT m a
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m a) -> LifecycleT m a)
-> (MVar LifeState -> m a) -> LifecycleT m a
forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> m a -> (Exc m -> m a) -> m a
forall a. m a -> (Exc m -> m a) -> m a
forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc (MVar LifeState -> m a
f MVar LifeState
var) ((Exc m -> m a) -> m a) -> (Exc m -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Exc m
e -> LifecycleT m a -> MVar LifeState -> m a
forall (m :: Type -> Type) a.
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 = Dict (MonadException (LifecycleT m))
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 = m a -> LifecycleT m a
forall (m :: Type -> Type) a. Monad m => m a -> LifecycleT m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> LifecycleT m a) -> m a -> LifecycleT m a
forall a b. (a -> b) -> a -> b
$ e -> m a
forall a. e -> m a
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 = Dict (MonadThrow e (LifecycleT m))
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 = (MVar LifeState -> m a) -> LifecycleT m a
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m a) -> LifecycleT m a)
-> (MVar LifeState -> m a) -> LifecycleT m a
forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> m a -> (e -> m a) -> m a
forall a. m a -> (e -> m a) -> m a
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) ((e -> m a) -> m a) -> (e -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \e
e -> LifecycleT m a -> MVar LifeState -> m a
forall (m :: Type -> Type) a.
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 = Dict (MonadCatch e (LifecycleT m))
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 = (MVar LifeState -> m a) -> LifecycleT m a
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m a) -> LifecycleT m a)
-> (MVar LifeState -> m a) -> LifecycleT m a
forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> (a -> m a) -> m a
forall a. (a -> m a) -> m a
forall (m :: Type -> Type) a. MonadFix m => (a -> m a) -> m a
mfix ((a -> m a) -> m a) -> (a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a
a -> LifecycleT m a -> MVar LifeState -> m a
forall (m :: Type -> Type) a.
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 = Dict (MonadFix (LifecycleT m))
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 = m a -> LifecycleT m a
forall (m :: Type -> Type) a. Monad m => m a -> LifecycleT m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> LifecycleT m a) -> m a -> LifecycleT m a
forall a b. (a -> b) -> a -> b
$ IO a -> m a
forall a. IO a -> m a
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 = Dict (MonadIO (LifecycleT m))
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) = (MVar LifeState -> m2 a) -> LifecycleT m2 a
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m2 a) -> LifecycleT m2 a)
-> (MVar LifeState -> m2 a) -> LifecycleT m2 a
forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> m1 a -> m2 a
m1 --> m2
f (m1 a -> m2 a) -> m1 a -> m2 a
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 = (MVar LifeState -> m r) -> LifecycleT m r
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m r) -> LifecycleT m r)
-> (MVar LifeState -> m r) -> LifecycleT m r
forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> (Identity r -> r) -> m (Identity r) -> m r
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity r -> r
forall a. Identity a -> a
runIdentity (m (Identity r) -> m r) -> m (Identity r) -> m r
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 (m1 :: Type -> Type) a.
  Monad m1 =>
  LifecycleT m1 a -> m1 (Identity a))
 -> m (Identity r))
-> (forall (m1 :: Type -> Type) a.
    Monad m1 =>
    LifecycleT m1 a -> m1 (Identity a))
-> m (Identity r)
forall a b. (a -> b) -> a -> b
$ \LifecycleT m1 a
a -> (a -> Identity a) -> m1 a -> m1 (Identity a)
forall a b. (a -> b) -> m1 a -> m1 b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity (m1 a -> m1 (Identity a)) -> m1 a -> m1 (Identity a)
forall a b. (a -> b) -> a -> b
$ LifecycleT m1 a -> MVar LifeState -> m1 a
forall (m :: Type -> Type) a.
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 MonadTunnelIO LifecycleT -> m r) -> LifecycleT m r
liftWithUnlift Unlift MonadTunnelIO LifecycleT -> m r
call = (MVar LifeState -> m r) -> LifecycleT m r
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m r) -> LifecycleT m r)
-> (MVar LifeState -> m r) -> LifecycleT m r
forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> Unlift MonadTunnelIO LifecycleT -> m r
call (Unlift MonadTunnelIO LifecycleT -> m r)
-> Unlift MonadTunnelIO LifecycleT -> m r
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 MonadTunnelIO LifecycleT)
getDiscardingUnlift =
        WUnlift MonadTunnelIO LifecycleT
-> LifecycleT m (WUnlift MonadTunnelIO LifecycleT)
forall a. a -> LifecycleT m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (WUnlift MonadTunnelIO LifecycleT
 -> LifecycleT m (WUnlift MonadTunnelIO LifecycleT))
-> WUnlift MonadTunnelIO LifecycleT
-> LifecycleT m (WUnlift MonadTunnelIO LifecycleT)
forall a b. (a -> b) -> a -> b
$
        Unlift MonadTunnelIO LifecycleT -> WUnlift MonadTunnelIO LifecycleT
forall (c :: (Type -> Type) -> Constraint) (t :: TransKind).
Unlift c t -> WUnlift c t
MkWUnlift (Unlift MonadTunnelIO LifecycleT
 -> WUnlift MonadTunnelIO LifecycleT)
-> Unlift MonadTunnelIO LifecycleT
-> WUnlift MonadTunnelIO LifecycleT
forall a b. (a -> b) -> a -> b
$ \(MkLifecycleT MVar LifeState -> m a
f) -> do
            MVar LifeState
var <- IO (MVar LifeState) -> m (MVar LifeState)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MVar LifeState) -> m (MVar LifeState))
-> IO (MVar LifeState) -> m (MVar LifeState)
forall a b. (a -> b) -> a -> b
$ LifeState -> IO (MVar LifeState)
forall a. a -> IO (MVar a)
newMVar LifeState
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 (MkLifeState Maybe (IO (IO Any))
Nothing) = () -> LifecycleT m ()
forall a. a -> LifecycleT m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
addLifeState LifeState
ls =
    (MVar LifeState -> m ()) -> LifecycleT m ()
forall (m :: Type -> Type) a.
(MVar LifeState -> m a) -> LifecycleT m a
MkLifecycleT ((MVar LifeState -> m ()) -> LifecycleT m ())
-> (MVar LifeState -> m ()) -> LifecycleT m ()
forall a b. (a -> b) -> a -> b
$ \MVar LifeState
var -> do
        MVar LifeState -> Unlift MonadIO (StateT LifeState)
forall s. MVar s -> Unlift MonadIO (StateT s)
dangerousMVarRunStateT MVar LifeState
var (StateT LifeState m () -> m ()) -> StateT LifeState m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            LifeState
s <- StateT LifeState m LifeState
forall (m :: Type -> Type) s. Monad m => StateT s m s
get
            LifeState -> StateT LifeState m ()
forall (m :: Type -> Type) s. Monad m => s -> StateT s m ()
put (LifeState -> StateT LifeState m ())
-> LifeState -> StateT LifeState m ()
forall a b. (a -> b) -> a -> b
$ LifeState
ls LifeState -> LifeState -> LifeState
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 =
    LifeState -> LifecycleT m ()
forall (m :: Type -> Type).
MonadIO m =>
LifeState -> LifecycleT m ()
addLifeState (LifeState -> LifecycleT m ()) -> LifeState -> LifecycleT m ()
forall a b. (a -> b) -> a -> b
$
    Maybe (IO (IO Any)) -> LifeState
MkLifeState (Maybe (IO (IO Any)) -> LifeState)
-> Maybe (IO (IO Any)) -> LifeState
forall a b. (a -> b) -> a -> b
$
    IO (IO Any) -> Maybe (IO (IO Any))
forall a. a -> Maybe a
Just (IO (IO Any) -> Maybe (IO (IO Any)))
-> IO (IO Any) -> Maybe (IO (IO Any))
forall a b. (a -> b) -> a -> b
$ do
        IO ()
closer
        IO Any -> IO (IO Any)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (IO Any -> IO (IO Any)) -> IO Any -> IO (IO Any)
forall a b. (a -> b) -> a -> b
$ Any -> IO Any
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Any -> IO Any) -> Any -> IO Any
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
False

-- | 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 <- m (WRaised m IO) -> LifecycleT m (WRaised m IO)
forall (m :: Type -> Type) a. Monad m => m a -> LifecycleT m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (WRaised m IO)
forall (m :: Type -> Type). MonadAskUnliftIO m => m (WRaised m IO)
askUnliftIO
    IO () -> LifecycleT m ()
forall (m :: Type -> Type). MonadIO m => IO () -> LifecycleT m ()
lifecycleOnCloseIO (IO () -> LifecycleT m ()) -> IO () -> LifecycleT m ()
forall a b. (a -> b) -> a -> b
$ m () -> IO ()
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 <- IO (MVar LifeState) -> m (MVar LifeState)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MVar LifeState) -> m (MVar LifeState))
-> IO (MVar LifeState) -> m (MVar LifeState)
forall a b. (a -> b) -> a -> b
$ LifeState -> IO (MVar LifeState)
forall a. a -> IO (MVar a)
newMVar LifeState
forall a. Monoid a => a
mempty
    m r -> m () -> m r
forall (m :: Type -> Type) a.
(MonadException m, MonadTunnelIO m) =>
m a -> m () -> m a
finally (MVar LifeState -> m a
f MVar LifeState
var m a -> (a -> m r) -> m r
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m r
run) (m () -> m r) -> m () -> m r
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LifeState -> IO ()
closeLifeState (LifeState -> IO ()) -> LifeState -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar LifeState -> LifeState
varLifeState MVar LifeState
var

-- | 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 = LifecycleT m a -> With m a
forall (m :: Type -> Type) a.
(MonadException m, MonadTunnelIO m) =>
LifecycleT m a -> With m a
withLifecycle LifecycleT m a
lc a -> m a
forall a. a -> m a
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 <- IO (MVar ()) -> LifecycleT m (MVar ())
forall a. IO a -> LifecycleT m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
    IO () -> LifecycleT m ()
forall (m :: Type -> Type). MonadIO m => IO () -> LifecycleT m ()
lifecycleOnCloseIO (IO () -> LifecycleT m ()) -> IO () -> LifecycleT m ()
forall a b. (a -> b) -> a -> b
$ MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
var
    m ThreadId -> LifecycleT m ThreadId
forall (m :: Type -> Type) a. Monad m => m a -> LifecycleT m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ThreadId -> LifecycleT m ThreadId)
-> m ThreadId -> LifecycleT m ThreadId
forall a b. (a -> b) -> a -> b
$ ((m --> IO) -> IO ThreadId) -> m ThreadId
IO -/-> m
forall (m :: Type -> Type). MonadUnliftIO m => IO -/-> m
liftIOWithUnlift (((m --> IO) -> IO ThreadId) -> m ThreadId)
-> ((m --> IO) -> IO ThreadId) -> m ThreadId
forall a b. (a -> b) -> a -> b
$ \m --> IO
unlift -> IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO () -> IO ()
forall (m :: Type -> Type) a.
(MonadException m, MonadTunnelIO m) =>
m a -> m () -> m a
finally (m () -> IO ()
m --> IO
unlift m ()
action) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO ()
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 <- IO (MVar LifeState) -> m (MVar LifeState)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MVar LifeState) -> m (MVar LifeState))
-> IO (MVar LifeState) -> m (MVar LifeState)
forall a b. (a -> b) -> a -> b
$ LifeState -> IO (MVar LifeState)
forall a. a -> IO (MVar a)
newMVar LifeState
forall a. Monoid a => a
mempty
    a
t <- MVar LifeState -> m a
f MVar LifeState
var
    (a, LifeState) -> m (a, LifeState)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a
t, MVar LifeState -> LifeState
varLifeState MVar LifeState
var)

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) <- m (a, LifeState) -> LifecycleT m (a, LifeState)
forall (m :: Type -> Type) a. Monad m => m a -> LifecycleT m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, LifeState) -> LifecycleT m (a, LifeState))
-> m (a, LifeState) -> LifecycleT m (a, LifeState)
forall a b. (a -> b) -> a -> b
$ LifecycleT m a -> m (a, LifeState)
forall (m :: Type -> Type) a.
MonadIO m =>
LifecycleT m a -> m (a, LifeState)
getLifeState LifecycleT m a
la
    LifeState -> LifecycleT m ()
forall (m :: Type -> Type).
MonadIO m =>
LifeState -> LifecycleT m ()
addLifeState (LifeState -> LifecycleT m ()) -> LifeState -> LifecycleT m ()
forall a b. (a -> b) -> a -> b
$ LifeState -> LifeState
ss LifeState
ls
    a -> LifecycleT m a
forall a. a -> LifecycleT m a
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) <- m (a, LifeState) -> LifecycleT m (a, LifeState)
forall (m :: Type -> Type) a. Monad m => m a -> LifecycleT m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, LifeState) -> LifecycleT m (a, LifeState))
-> m (a, LifeState) -> LifecycleT m (a, LifeState)
forall a b. (a -> b) -> a -> b
$ LifecycleT m a -> m (a, LifeState)
forall (m :: Type -> Type) a.
MonadIO m =>
LifecycleT m a -> m (a, LifeState)
getLifeState LifecycleT m a
lc
    MVar ()
var <- IO (MVar ()) -> LifecycleT m (MVar ())
forall a. IO a -> LifecycleT m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MVar ()) -> LifecycleT m (MVar ()))
-> IO (MVar ()) -> LifecycleT m (MVar ())
forall a b. (a -> b) -> a -> b
$ () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
    let
        earlycloser :: IO ()
        earlycloser :: IO ()
earlycloser = do
            Maybe ()
mu <- MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar ()
var
            case Maybe ()
mu of
                Just () -> LifeState -> IO ()
closeLifeState LifeState
ls
                Maybe ()
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
    IO () -> LifecycleT m ()
forall (m :: Type -> Type). MonadIO m => IO () -> LifecycleT m ()
lifecycleOnCloseIO IO ()
earlycloser
    (a, IO ()) -> LifecycleT m (a, IO ())
forall a. a -> LifecycleT m a
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 <- IO (IORef Bool) -> LifecycleT m (IORef Bool)
forall a. IO a -> LifecycleT m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> LifecycleT m (IORef Bool))
-> IO (IORef Bool) -> LifecycleT m (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True
    IO () -> LifecycleT m ()
forall (m :: Type -> Type). MonadIO m => IO () -> LifecycleT m ()
lifecycleOnCloseIO (IO () -> LifecycleT m ()) -> IO () -> LifecycleT m ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref Bool
False
    IO Bool -> LifecycleT m (IO Bool)
forall a. a -> LifecycleT m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (IO Bool -> LifecycleT m (IO Bool))
-> IO Bool -> LifecycleT m (IO Bool)
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
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) <- m (t, m ()) -> LifecycleT m (t, m ())
forall (m :: Type -> Type) a. Monad m => m a -> LifecycleT m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (t, m ()) -> LifecycleT m (t, m ()))
-> m (t, m ()) -> LifecycleT m (t, m ())
forall a b. (a -> b) -> a -> b
$ With m t -> m (t, m ())
forall (m :: Type -> Type) a.
MonadCoroutine m =>
With m a -> m (a, m ())
unpickWith (t -> m r) -> m r
With m t
withX
    m () -> LifecycleT m ()
forall (m :: Type -> Type).
MonadAskUnliftIO m =>
m () -> LifecycleT m ()
lifecycleOnClose m ()
closer
    t -> LifecycleT m t
forall a. a -> LifecycleT m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return t
t

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