{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE QuantifiedConstraints      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

module Ouroboros.Consensus.Util.EarlyExit (
    WithEarlyExit -- opaque
  , withEarlyExit
  , withEarlyExit_
  , exitEarly
    -- * Re-exports
  , lift
  ) where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST (ST)
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Maybe
import           Data.Function (on)
import           Data.Proxy
import           NoThunks.Class (NoThunks (..))

import           Control.Monad.Class.MonadAsync
import           Control.Monad.Class.MonadEventlog
import           Control.Monad.Class.MonadFork
import           Control.Monad.Class.MonadST
import           Control.Monad.Class.MonadSTM
import           Control.Monad.Class.MonadThrow
import           Control.Monad.Class.MonadTimer

import           Ouroboros.Consensus.Util ((.:))
import           Ouroboros.Consensus.Util.IOLike (IOLike (..),
                     MonadMonotonicTime (..), StrictMVar, StrictTVar)

{-------------------------------------------------------------------------------
  Basic definitions
-------------------------------------------------------------------------------}

newtype WithEarlyExit m a = WithEarlyExit {
      WithEarlyExit m a -> MaybeT m a
unWithEarlyExit :: MaybeT m a
    }
  deriving ( a -> WithEarlyExit m b -> WithEarlyExit m a
(a -> b) -> WithEarlyExit m a -> WithEarlyExit m b
(forall a b. (a -> b) -> WithEarlyExit m a -> WithEarlyExit m b)
-> (forall a b. a -> WithEarlyExit m b -> WithEarlyExit m a)
-> Functor (WithEarlyExit m)
forall a b. a -> WithEarlyExit m b -> WithEarlyExit m a
forall a b. (a -> b) -> WithEarlyExit m a -> WithEarlyExit m b
forall (m :: * -> *) a b.
Functor m =>
a -> WithEarlyExit m b -> WithEarlyExit m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithEarlyExit m a -> WithEarlyExit m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WithEarlyExit m b -> WithEarlyExit m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WithEarlyExit m b -> WithEarlyExit m a
fmap :: (a -> b) -> WithEarlyExit m a -> WithEarlyExit m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithEarlyExit m a -> WithEarlyExit m b
Functor
           , Functor (WithEarlyExit m)
a -> WithEarlyExit m a
Functor (WithEarlyExit m)
-> (forall a. a -> WithEarlyExit m a)
-> (forall a b.
    WithEarlyExit m (a -> b) -> WithEarlyExit m a -> WithEarlyExit m b)
-> (forall a b c.
    (a -> b -> c)
    -> WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m c)
-> (forall a b.
    WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b)
-> (forall a b.
    WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m a)
-> Applicative (WithEarlyExit m)
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m a
WithEarlyExit m (a -> b) -> WithEarlyExit m a -> WithEarlyExit m b
(a -> b -> c)
-> WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m c
forall a. a -> WithEarlyExit m a
forall a b.
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m a
forall a b.
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b
forall a b.
WithEarlyExit m (a -> b) -> WithEarlyExit m a -> WithEarlyExit m b
forall a b c.
(a -> b -> c)
-> WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m c
forall (m :: * -> *). Monad m => Functor (WithEarlyExit m)
forall (m :: * -> *) a. Monad m => a -> WithEarlyExit m a
forall (m :: * -> *) a b.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m a
forall (m :: * -> *) a b.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b
forall (m :: * -> *) a b.
Monad m =>
WithEarlyExit m (a -> b) -> WithEarlyExit m a -> WithEarlyExit m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit 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
<* :: WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m a
*> :: WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b
liftA2 :: (a -> b -> c)
-> WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m c
<*> :: WithEarlyExit m (a -> b) -> WithEarlyExit m a -> WithEarlyExit m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
WithEarlyExit m (a -> b) -> WithEarlyExit m a -> WithEarlyExit m b
pure :: a -> WithEarlyExit m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> WithEarlyExit m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (WithEarlyExit m)
Applicative
           , Applicative (WithEarlyExit m)
WithEarlyExit m a
Applicative (WithEarlyExit m)
-> (forall a. WithEarlyExit m a)
-> (forall a.
    WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a)
-> (forall a. WithEarlyExit m a -> WithEarlyExit m [a])
-> (forall a. WithEarlyExit m a -> WithEarlyExit m [a])
-> Alternative (WithEarlyExit m)
WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a
WithEarlyExit m a -> WithEarlyExit m [a]
WithEarlyExit m a -> WithEarlyExit m [a]
forall a. WithEarlyExit m a
forall a. WithEarlyExit m a -> WithEarlyExit m [a]
forall a.
WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a
forall (m :: * -> *). Monad m => Applicative (WithEarlyExit m)
forall (m :: * -> *) a. Monad m => WithEarlyExit m a
forall (m :: * -> *) a.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m [a]
forall (m :: * -> *) a.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: WithEarlyExit m a -> WithEarlyExit m [a]
$cmany :: forall (m :: * -> *) a.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m [a]
some :: WithEarlyExit m a -> WithEarlyExit m [a]
$csome :: forall (m :: * -> *) a.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m [a]
<|> :: WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a
$c<|> :: forall (m :: * -> *) a.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a
empty :: WithEarlyExit m a
$cempty :: forall (m :: * -> *) a. Monad m => WithEarlyExit m a
$cp1Alternative :: forall (m :: * -> *). Monad m => Applicative (WithEarlyExit m)
Alternative
           , Applicative (WithEarlyExit m)
a -> WithEarlyExit m a
Applicative (WithEarlyExit m)
-> (forall a b.
    WithEarlyExit m a -> (a -> WithEarlyExit m b) -> WithEarlyExit m b)
-> (forall a b.
    WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b)
-> (forall a. a -> WithEarlyExit m a)
-> Monad (WithEarlyExit m)
WithEarlyExit m a -> (a -> WithEarlyExit m b) -> WithEarlyExit m b
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b
forall a. a -> WithEarlyExit m a
forall a b.
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b
forall a b.
WithEarlyExit m a -> (a -> WithEarlyExit m b) -> WithEarlyExit m b
forall (m :: * -> *). Monad m => Applicative (WithEarlyExit m)
forall (m :: * -> *) a. Monad m => a -> WithEarlyExit m a
forall (m :: * -> *) a b.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b
forall (m :: * -> *) a b.
Monad m =>
WithEarlyExit m a -> (a -> WithEarlyExit m b) -> WithEarlyExit 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 -> WithEarlyExit m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> WithEarlyExit m a
>> :: WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m b -> WithEarlyExit m b
>>= :: WithEarlyExit m a -> (a -> WithEarlyExit m b) -> WithEarlyExit m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WithEarlyExit m a -> (a -> WithEarlyExit m b) -> WithEarlyExit m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (WithEarlyExit m)
Monad
           , m a -> WithEarlyExit m a
(forall (m :: * -> *) a. Monad m => m a -> WithEarlyExit m a)
-> MonadTrans WithEarlyExit
forall (m :: * -> *) a. Monad m => m a -> WithEarlyExit m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> WithEarlyExit m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> WithEarlyExit m a
MonadTrans
           , Monad (WithEarlyExit m)
Alternative (WithEarlyExit m)
WithEarlyExit m a
Alternative (WithEarlyExit m)
-> Monad (WithEarlyExit m)
-> (forall a. WithEarlyExit m a)
-> (forall a.
    WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a)
-> MonadPlus (WithEarlyExit m)
WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a
forall a. WithEarlyExit m a
forall a.
WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a
forall (m :: * -> *). Monad m => Monad (WithEarlyExit m)
forall (m :: * -> *). Monad m => Alternative (WithEarlyExit m)
forall (m :: * -> *) a. Monad m => WithEarlyExit m a
forall (m :: * -> *) a.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a
$cmplus :: forall (m :: * -> *) a.
Monad m =>
WithEarlyExit m a -> WithEarlyExit m a -> WithEarlyExit m a
mzero :: WithEarlyExit m a
$cmzero :: forall (m :: * -> *) a. Monad m => WithEarlyExit m a
$cp2MonadPlus :: forall (m :: * -> *). Monad m => Monad (WithEarlyExit m)
$cp1MonadPlus :: forall (m :: * -> *). Monad m => Alternative (WithEarlyExit m)
MonadPlus
           )

-- | Internal only
earlyExit :: m (Maybe a) -> WithEarlyExit m a
earlyExit :: m (Maybe a) -> WithEarlyExit m a
earlyExit = MaybeT m a -> WithEarlyExit m a
forall (m :: * -> *) a. MaybeT m a -> WithEarlyExit m a
WithEarlyExit (MaybeT m a -> WithEarlyExit m a)
-> (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> WithEarlyExit m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT

withEarlyExit :: WithEarlyExit m a -> m (Maybe a)
withEarlyExit :: WithEarlyExit m a -> m (Maybe a)
withEarlyExit = MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m a -> m (Maybe a))
-> (WithEarlyExit m a -> MaybeT m a)
-> WithEarlyExit m a
-> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithEarlyExit m a -> MaybeT m a
forall (m :: * -> *) a. WithEarlyExit m a -> MaybeT m a
unWithEarlyExit

withEarlyExit_ :: Functor m => WithEarlyExit m () -> m ()
withEarlyExit_ :: WithEarlyExit m () -> m ()
withEarlyExit_ = (Maybe () -> ()) -> m (Maybe ()) -> m ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe () -> ()
collapse (m (Maybe ()) -> m ())
-> (WithEarlyExit m () -> m (Maybe ()))
-> WithEarlyExit m ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithEarlyExit m () -> m (Maybe ())
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit

collapse :: Maybe () -> ()
collapse :: Maybe () -> ()
collapse Maybe ()
Nothing   = ()
collapse (Just ()) = ()

exitEarly :: Applicative m => WithEarlyExit m a
exitEarly :: WithEarlyExit m a
exitEarly = m (Maybe a) -> WithEarlyExit m a
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Maybe a) -> WithEarlyExit m a)
-> m (Maybe a) -> WithEarlyExit m a
forall a b. (a -> b) -> a -> b
$ Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

instance (forall a'. NoThunks (m a'))
      => NoThunks (WithEarlyExit m a) where
   showTypeOf :: Proxy (WithEarlyExit m a) -> String
showTypeOf Proxy (WithEarlyExit m a)
_p = String
"WithEarlyExit " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Proxy (m a) -> String
forall a. NoThunks a => Proxy a -> String
showTypeOf (Proxy (m a)
forall k (t :: k). Proxy t
Proxy @(m a))
   wNoThunks :: Context -> WithEarlyExit m a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt = Context -> m (Maybe a) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt (m (Maybe a) -> IO (Maybe ThunkInfo))
-> (WithEarlyExit m a -> m (Maybe a))
-> WithEarlyExit m a
-> IO (Maybe ThunkInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithEarlyExit m a -> m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit

{-------------------------------------------------------------------------------
  Instances for io-classes
-------------------------------------------------------------------------------}

instance MonadSTMTx stm => MonadSTMTx (WithEarlyExit stm) where
  type TVar_    (WithEarlyExit stm) = TVar_    stm
  type TMVar_   (WithEarlyExit stm) = TMVar_   stm
  type TQueue_  (WithEarlyExit stm) = TQueue_  stm
  type TBQueue_ (WithEarlyExit stm) = TBQueue_ stm

  newTVar :: a -> WithEarlyExit stm (TVar_ (WithEarlyExit stm) a)
newTVar         = stm (TVar_ stm a) -> WithEarlyExit stm (TVar_ stm a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm (TVar_ stm a) -> WithEarlyExit stm (TVar_ stm a))
-> (a -> stm (TVar_ stm a)) -> a -> WithEarlyExit stm (TVar_ stm a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  a -> stm (TVar_ stm a)
forall (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TVar_ stm a)
newTVar
  readTVar :: TVar_ (WithEarlyExit stm) a -> WithEarlyExit stm a
readTVar        = stm a -> WithEarlyExit stm a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm a -> WithEarlyExit stm a)
-> (TVar_ stm a -> stm a) -> TVar_ stm a -> WithEarlyExit stm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TVar_ stm a -> stm a
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar
  writeTVar :: TVar_ (WithEarlyExit stm) a -> a -> WithEarlyExit stm ()
writeTVar       = stm () -> WithEarlyExit stm ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm () -> WithEarlyExit stm ())
-> (TVar_ stm a -> a -> stm ())
-> TVar_ stm a
-> a
-> WithEarlyExit stm ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TVar_ stm a -> a -> stm ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar
  retry :: WithEarlyExit stm a
retry           = stm a -> WithEarlyExit stm a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    stm a
forall (stm :: * -> *) a. MonadSTMTx stm => stm a
retry
  orElse :: WithEarlyExit stm a -> WithEarlyExit stm a -> WithEarlyExit stm a
orElse          = (stm (Maybe a) -> WithEarlyExit stm a
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (stm (Maybe a) -> WithEarlyExit stm a)
-> (stm (Maybe a) -> stm (Maybe a) -> stm (Maybe a))
-> stm (Maybe a)
-> stm (Maybe a)
-> WithEarlyExit stm a
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: stm (Maybe a) -> stm (Maybe a) -> stm (Maybe a)
forall (stm :: * -> *) a. MonadSTMTx stm => stm a -> stm a -> stm a
orElse) (stm (Maybe a) -> stm (Maybe a) -> WithEarlyExit stm a)
-> (WithEarlyExit stm a -> stm (Maybe a))
-> WithEarlyExit stm a
-> WithEarlyExit stm a
-> WithEarlyExit stm a
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` WithEarlyExit stm a -> stm (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit
  newTMVar :: a -> WithEarlyExit stm (TMVar_ (WithEarlyExit stm) a)
newTMVar        = stm (TMVar_ stm a) -> WithEarlyExit stm (TMVar_ stm a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm (TMVar_ stm a) -> WithEarlyExit stm (TMVar_ stm a))
-> (a -> stm (TMVar_ stm a))
-> a
-> WithEarlyExit stm (TMVar_ stm a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  a -> stm (TMVar_ stm a)
forall (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TMVar_ stm a)
newTMVar
  newEmptyTMVar :: WithEarlyExit stm (TMVar_ (WithEarlyExit stm) a)
newEmptyTMVar   = stm (TMVar_ stm a) -> WithEarlyExit stm (TMVar_ stm a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    stm (TMVar_ stm a)
forall (stm :: * -> *) a. MonadSTMTx stm => stm (TMVar_ stm a)
newEmptyTMVar
  takeTMVar :: TMVar_ (WithEarlyExit stm) a -> WithEarlyExit stm a
takeTMVar       = stm a -> WithEarlyExit stm a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm a -> WithEarlyExit stm a)
-> (TMVar_ stm a -> stm a) -> TMVar_ stm a -> WithEarlyExit stm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar_ stm a -> stm a
forall (stm :: * -> *) a. MonadSTMTx stm => TMVar_ stm a -> stm a
takeTMVar
  tryTakeTMVar :: TMVar_ (WithEarlyExit stm) a -> WithEarlyExit stm (Maybe a)
tryTakeTMVar    = stm (Maybe a) -> WithEarlyExit stm (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm (Maybe a) -> WithEarlyExit stm (Maybe a))
-> (TMVar_ stm a -> stm (Maybe a))
-> TMVar_ stm a
-> WithEarlyExit stm (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar_ stm a -> stm (Maybe a)
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> stm (Maybe a)
tryTakeTMVar
  putTMVar :: TMVar_ (WithEarlyExit stm) a -> a -> WithEarlyExit stm ()
putTMVar        = stm () -> WithEarlyExit stm ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm () -> WithEarlyExit stm ())
-> (TMVar_ stm a -> a -> stm ())
-> TMVar_ stm a
-> a
-> WithEarlyExit stm ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TMVar_ stm a -> a -> stm ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> a -> stm ()
putTMVar
  tryPutTMVar :: TMVar_ (WithEarlyExit stm) a -> a -> WithEarlyExit stm Bool
tryPutTMVar     = stm Bool -> WithEarlyExit stm Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm Bool -> WithEarlyExit stm Bool)
-> (TMVar_ stm a -> a -> stm Bool)
-> TMVar_ stm a
-> a
-> WithEarlyExit stm Bool
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TMVar_ stm a -> a -> stm Bool
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> a -> stm Bool
tryPutTMVar
  readTMVar :: TMVar_ (WithEarlyExit stm) a -> WithEarlyExit stm a
readTMVar       = stm a -> WithEarlyExit stm a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm a -> WithEarlyExit stm a)
-> (TMVar_ stm a -> stm a) -> TMVar_ stm a -> WithEarlyExit stm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar_ stm a -> stm a
forall (stm :: * -> *) a. MonadSTMTx stm => TMVar_ stm a -> stm a
readTMVar
  tryReadTMVar :: TMVar_ (WithEarlyExit stm) a -> WithEarlyExit stm (Maybe a)
tryReadTMVar    = stm (Maybe a) -> WithEarlyExit stm (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm (Maybe a) -> WithEarlyExit stm (Maybe a))
-> (TMVar_ stm a -> stm (Maybe a))
-> TMVar_ stm a
-> WithEarlyExit stm (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar_ stm a -> stm (Maybe a)
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> stm (Maybe a)
tryReadTMVar
  swapTMVar :: TMVar_ (WithEarlyExit stm) a -> a -> WithEarlyExit stm a
swapTMVar       = stm a -> WithEarlyExit stm a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm a -> WithEarlyExit stm a)
-> (TMVar_ stm a -> a -> stm a)
-> TMVar_ stm a
-> a
-> WithEarlyExit stm a
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TMVar_ stm a -> a -> stm a
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> a -> stm a
swapTMVar
  isEmptyTMVar :: TMVar_ (WithEarlyExit stm) a -> WithEarlyExit stm Bool
isEmptyTMVar    = stm Bool -> WithEarlyExit stm Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm Bool -> WithEarlyExit stm Bool)
-> (TMVar_ stm a -> stm Bool)
-> TMVar_ stm a
-> WithEarlyExit stm Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar_ stm a -> stm Bool
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TMVar_ stm a -> stm Bool
isEmptyTMVar
  newTQueue :: WithEarlyExit stm (TQueue_ (WithEarlyExit stm) a)
newTQueue       = stm (TQueue_ stm a) -> WithEarlyExit stm (TQueue_ stm a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    stm (TQueue_ stm a)
forall (stm :: * -> *) a. MonadSTMTx stm => stm (TQueue_ stm a)
newTQueue
  readTQueue :: TQueue_ (WithEarlyExit stm) a -> WithEarlyExit stm a
readTQueue      = stm a -> WithEarlyExit stm a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm a -> WithEarlyExit stm a)
-> (TQueue_ stm a -> stm a) -> TQueue_ stm a -> WithEarlyExit stm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue_ stm a -> stm a
forall (stm :: * -> *) a. MonadSTMTx stm => TQueue_ stm a -> stm a
readTQueue
  tryReadTQueue :: TQueue_ (WithEarlyExit stm) a -> WithEarlyExit stm (Maybe a)
tryReadTQueue   = stm (Maybe a) -> WithEarlyExit stm (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm (Maybe a) -> WithEarlyExit stm (Maybe a))
-> (TQueue_ stm a -> stm (Maybe a))
-> TQueue_ stm a
-> WithEarlyExit stm (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue_ stm a -> stm (Maybe a)
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TQueue_ stm a -> stm (Maybe a)
tryReadTQueue
  writeTQueue :: TQueue_ (WithEarlyExit stm) a -> a -> WithEarlyExit stm ()
writeTQueue     = stm () -> WithEarlyExit stm ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm () -> WithEarlyExit stm ())
-> (TQueue_ stm a -> a -> stm ())
-> TQueue_ stm a
-> a
-> WithEarlyExit stm ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TQueue_ stm a -> a -> stm ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TQueue_ stm a -> a -> stm ()
writeTQueue
  isEmptyTQueue :: TQueue_ (WithEarlyExit stm) a -> WithEarlyExit stm Bool
isEmptyTQueue   = stm Bool -> WithEarlyExit stm Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm Bool -> WithEarlyExit stm Bool)
-> (TQueue_ stm a -> stm Bool)
-> TQueue_ stm a
-> WithEarlyExit stm Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue_ stm a -> stm Bool
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TQueue_ stm a -> stm Bool
isEmptyTQueue
  newTBQueue :: Natural -> WithEarlyExit stm (TBQueue_ (WithEarlyExit stm) a)
newTBQueue      = stm (TBQueue_ stm a) -> WithEarlyExit stm (TBQueue_ stm a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm (TBQueue_ stm a) -> WithEarlyExit stm (TBQueue_ stm a))
-> (Natural -> stm (TBQueue_ stm a))
-> Natural
-> WithEarlyExit stm (TBQueue_ stm a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Natural -> stm (TBQueue_ stm a)
forall (stm :: * -> *) a.
MonadSTMTx stm =>
Natural -> stm (TBQueue_ stm a)
newTBQueue
  readTBQueue :: TBQueue_ (WithEarlyExit stm) a -> WithEarlyExit stm a
readTBQueue     = stm a -> WithEarlyExit stm a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm a -> WithEarlyExit stm a)
-> (TBQueue_ stm a -> stm a)
-> TBQueue_ stm a
-> WithEarlyExit stm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue_ stm a -> stm a
forall (stm :: * -> *) a. MonadSTMTx stm => TBQueue_ stm a -> stm a
readTBQueue
  tryReadTBQueue :: TBQueue_ (WithEarlyExit stm) a -> WithEarlyExit stm (Maybe a)
tryReadTBQueue  = stm (Maybe a) -> WithEarlyExit stm (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm (Maybe a) -> WithEarlyExit stm (Maybe a))
-> (TBQueue_ stm a -> stm (Maybe a))
-> TBQueue_ stm a
-> WithEarlyExit stm (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue_ stm a -> stm (Maybe a)
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TBQueue_ stm a -> stm (Maybe a)
tryReadTBQueue
  flushTBQueue :: TBQueue_ (WithEarlyExit stm) a -> WithEarlyExit stm [a]
flushTBQueue    = stm [a] -> WithEarlyExit stm [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm [a] -> WithEarlyExit stm [a])
-> (TBQueue_ stm a -> stm [a])
-> TBQueue_ stm a
-> WithEarlyExit stm [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue_ stm a -> stm [a]
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TBQueue_ stm a -> stm [a]
flushTBQueue
  writeTBQueue :: TBQueue_ (WithEarlyExit stm) a -> a -> WithEarlyExit stm ()
writeTBQueue    = stm () -> WithEarlyExit stm ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm () -> WithEarlyExit stm ())
-> (TBQueue_ stm a -> a -> stm ())
-> TBQueue_ stm a
-> a
-> WithEarlyExit stm ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TBQueue_ stm a -> a -> stm ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TBQueue_ stm a -> a -> stm ()
writeTBQueue
  lengthTBQueue :: TBQueue_ (WithEarlyExit stm) a -> WithEarlyExit stm Natural
lengthTBQueue   = stm Natural -> WithEarlyExit stm Natural
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm Natural -> WithEarlyExit stm Natural)
-> (TBQueue_ stm a -> stm Natural)
-> TBQueue_ stm a
-> WithEarlyExit stm Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue_ stm a -> stm Natural
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TBQueue_ stm a -> stm Natural
lengthTBQueue
  isEmptyTBQueue :: TBQueue_ (WithEarlyExit stm) a -> WithEarlyExit stm Bool
isEmptyTBQueue  = stm Bool -> WithEarlyExit stm Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm Bool -> WithEarlyExit stm Bool)
-> (TBQueue_ stm a -> stm Bool)
-> TBQueue_ stm a
-> WithEarlyExit stm Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue_ stm a -> stm Bool
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TBQueue_ stm a -> stm Bool
isEmptyTBQueue
  isFullTBQueue :: TBQueue_ (WithEarlyExit stm) a -> WithEarlyExit stm Bool
isFullTBQueue   = stm Bool -> WithEarlyExit stm Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (stm Bool -> WithEarlyExit stm Bool)
-> (TBQueue_ stm a -> stm Bool)
-> TBQueue_ stm a
-> WithEarlyExit stm Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue_ stm a -> stm Bool
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TBQueue_ stm a -> stm Bool
isFullTBQueue

instance MonadSTM m => MonadSTM (WithEarlyExit m) where
  type STM (WithEarlyExit m) = WithEarlyExit (STM m)

  atomically :: STM (WithEarlyExit m) a -> WithEarlyExit m a
atomically      = m (Maybe a) -> WithEarlyExit m a
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Maybe a) -> WithEarlyExit m a)
-> (WithEarlyExit (STM m) a -> m (Maybe a))
-> WithEarlyExit (STM m) a
-> WithEarlyExit m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Maybe a) -> m (Maybe a))
-> (WithEarlyExit (STM m) a -> STM m (Maybe a))
-> WithEarlyExit (STM m) a
-> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithEarlyExit (STM m) a -> STM m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit
  newTMVarIO :: a -> WithEarlyExit m (TMVar (WithEarlyExit m) a)
newTMVarIO      = m (TMVar_ (STM m) a) -> WithEarlyExit m (TMVar_ (STM m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TMVar_ (STM m) a) -> WithEarlyExit m (TMVar_ (STM m) a))
-> (a -> m (TMVar_ (STM m) a))
-> a
-> WithEarlyExit m (TMVar_ (STM m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (TMVar_ (STM m) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TMVar m a)
newTMVarIO
  newEmptyTMVarIO :: WithEarlyExit m (TMVar (WithEarlyExit m) a)
newEmptyTMVarIO = m (TMVar_ (STM m) a) -> WithEarlyExit m (TMVar_ (STM m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift   m (TMVar_ (STM m) a)
forall (m :: * -> *) a. MonadSTM m => m (TMVar m a)
newEmptyTMVarIO

instance MonadCatch m => MonadThrow (WithEarlyExit m) where
  throwIO :: e -> WithEarlyExit m a
throwIO = m a -> WithEarlyExit m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WithEarlyExit m a) -> (e -> m a) -> e -> WithEarlyExit m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO

instance MonadCatch m => MonadCatch (WithEarlyExit m) where
  catch :: WithEarlyExit m a -> (e -> WithEarlyExit m a) -> WithEarlyExit m a
catch WithEarlyExit m a
act e -> WithEarlyExit m a
handler = m (Maybe a) -> WithEarlyExit m a
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Maybe a) -> WithEarlyExit m a)
-> m (Maybe a) -> WithEarlyExit m a
forall a b. (a -> b) -> a -> b
$
      m (Maybe a) -> (e -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (WithEarlyExit m a -> m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit WithEarlyExit m a
act) (WithEarlyExit m a -> m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit (WithEarlyExit m a -> m (Maybe a))
-> (e -> WithEarlyExit m a) -> e -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> WithEarlyExit m a
handler)

  generalBracket :: WithEarlyExit m a
-> (a -> ExitCase b -> WithEarlyExit m c)
-> (a -> WithEarlyExit m b)
-> WithEarlyExit m (b, c)
generalBracket WithEarlyExit m a
acquire a -> ExitCase b -> WithEarlyExit m c
release a -> WithEarlyExit m b
use = m (Maybe (b, c)) -> WithEarlyExit m (b, c)
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Maybe (b, c)) -> WithEarlyExit m (b, c))
-> m (Maybe (b, c)) -> WithEarlyExit m (b, c)
forall a b. (a -> b) -> a -> b
$ do
      -- This is modelled on the case for ErrorT, except that we don't have
      -- to worry about reporting the right error, since we only have @Nothing@
      (Maybe b
mb, Maybe c
mc) <- m (Maybe a)
-> (Maybe a -> ExitCase (Maybe b) -> m (Maybe c))
-> (Maybe a -> m (Maybe b))
-> m (Maybe b, Maybe c)
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
                    (WithEarlyExit m a -> m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit WithEarlyExit m a
acquire)
                    (\Maybe a
mResource ExitCase (Maybe b)
exitCase ->
                        case (Maybe a
mResource, ExitCase (Maybe b)
exitCase) of
                          (Maybe a
Nothing, ExitCase (Maybe b)
_) ->
                            -- resource not acquired
                            Maybe c -> m (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe c
forall a. Maybe a
Nothing
                          (Just a
resource, ExitCaseSuccess (Just b
b)) ->
                            WithEarlyExit m c -> m (Maybe c)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit (WithEarlyExit m c -> m (Maybe c))
-> WithEarlyExit m c -> m (Maybe c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> WithEarlyExit m c
release a
resource (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b)
                          (Just a
resource, ExitCaseException SomeException
e) ->
                            WithEarlyExit m c -> m (Maybe c)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit (WithEarlyExit m c -> m (Maybe c))
-> WithEarlyExit m c -> m (Maybe c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> WithEarlyExit m c
release a
resource (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e)
                          (Just a
resource, ExitCase (Maybe b)
_otherwise) ->
                            WithEarlyExit m c -> m (Maybe c)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit (WithEarlyExit m c -> m (Maybe c))
-> WithEarlyExit m c -> m (Maybe c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> WithEarlyExit m c
release a
resource ExitCase b
forall a. ExitCase a
ExitCaseAbort
                    )
                    (m (Maybe b) -> (a -> m (Maybe b)) -> Maybe a -> m (Maybe b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing) (WithEarlyExit m b -> m (Maybe b)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit (WithEarlyExit m b -> m (Maybe b))
-> (a -> WithEarlyExit m b) -> a -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> WithEarlyExit m b
use))
      Maybe (b, c) -> m (Maybe (b, c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (b, c) -> m (Maybe (b, c)))
-> Maybe (b, c) -> m (Maybe (b, c))
forall a b. (a -> b) -> a -> b
$ (,) (b -> c -> (b, c)) -> Maybe b -> Maybe (c -> (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe b
mb Maybe (c -> (b, c)) -> Maybe c -> Maybe (b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe c
mc

instance MonadMask m => MonadMask (WithEarlyExit m) where
  mask :: ((forall a. WithEarlyExit m a -> WithEarlyExit m a)
 -> WithEarlyExit m b)
-> WithEarlyExit m b
mask (forall a. WithEarlyExit m a -> WithEarlyExit m a)
-> WithEarlyExit m b
f = m (Maybe b) -> WithEarlyExit m b
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Maybe b) -> WithEarlyExit m b)
-> m (Maybe b) -> WithEarlyExit m b
forall a b. (a -> b) -> a -> b
$
    ((forall a. m a -> m a) -> m (Maybe b)) -> m (Maybe b)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (Maybe b)) -> m (Maybe b))
-> ((forall a. m a -> m a) -> m (Maybe b)) -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask ->
      WithEarlyExit m b -> m (Maybe b)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit ((forall a. WithEarlyExit m a -> WithEarlyExit m a)
-> WithEarlyExit m b
f (m (Maybe a) -> WithEarlyExit m a
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Maybe a) -> WithEarlyExit m a)
-> (WithEarlyExit m a -> m (Maybe a))
-> WithEarlyExit m a
-> WithEarlyExit m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe a) -> m (Maybe a)
forall a. m a -> m a
unmask (m (Maybe a) -> m (Maybe a))
-> (WithEarlyExit m a -> m (Maybe a))
-> WithEarlyExit m a
-> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithEarlyExit m a -> m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit))

  uninterruptibleMask :: ((forall a. WithEarlyExit m a -> WithEarlyExit m a)
 -> WithEarlyExit m b)
-> WithEarlyExit m b
uninterruptibleMask (forall a. WithEarlyExit m a -> WithEarlyExit m a)
-> WithEarlyExit m b
f = m (Maybe b) -> WithEarlyExit m b
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Maybe b) -> WithEarlyExit m b)
-> m (Maybe b) -> WithEarlyExit m b
forall a b. (a -> b) -> a -> b
$
    ((forall a. m a -> m a) -> m (Maybe b)) -> m (Maybe b)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. m a -> m a) -> m (Maybe b)) -> m (Maybe b))
-> ((forall a. m a -> m a) -> m (Maybe b)) -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask ->
      let unmask' :: forall a. WithEarlyExit m a -> WithEarlyExit m a
          unmask' :: WithEarlyExit m a -> WithEarlyExit m a
unmask' = m (Maybe a) -> WithEarlyExit m a
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Maybe a) -> WithEarlyExit m a)
-> (WithEarlyExit m a -> m (Maybe a))
-> WithEarlyExit m a
-> WithEarlyExit m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe a) -> m (Maybe a)
forall a. m a -> m a
unmask (m (Maybe a) -> m (Maybe a))
-> (WithEarlyExit m a -> m (Maybe a))
-> WithEarlyExit m a
-> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithEarlyExit m a -> m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit
      in WithEarlyExit m b -> m (Maybe b)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit ((forall a. WithEarlyExit m a -> WithEarlyExit m a)
-> WithEarlyExit m b
f forall a. WithEarlyExit m a -> WithEarlyExit m a
unmask')

instance MonadThread m => MonadThread (WithEarlyExit m) where
  type ThreadId (WithEarlyExit m) = ThreadId m

  myThreadId :: WithEarlyExit m (ThreadId (WithEarlyExit m))
myThreadId  = m (ThreadId m) -> WithEarlyExit m (ThreadId m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    m (ThreadId m)
forall (m :: * -> *). MonadThread m => m (ThreadId m)
myThreadId
  labelThread :: ThreadId (WithEarlyExit m) -> String -> WithEarlyExit m ()
labelThread = m () -> WithEarlyExit m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithEarlyExit m ())
-> (ThreadId m -> String -> m ())
-> ThreadId m
-> String
-> WithEarlyExit m ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: ThreadId m -> String -> m ()
forall (m :: * -> *). MonadThread m => ThreadId m -> String -> m ()
labelThread

instance (MonadAsyncSTM async stm, MonadCatch stm)
      => MonadAsyncSTM (WithEarlyExit async) (WithEarlyExit stm) where
  waitCatchSTM :: WithEarlyExit async a -> WithEarlyExit stm (Either SomeException a)
waitCatchSTM WithEarlyExit async a
a = stm (Maybe (Either SomeException a))
-> WithEarlyExit stm (Either SomeException a)
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (Either SomeException (Maybe a) -> Maybe (Either SomeException a)
forall a.
Either SomeException (Maybe a) -> Maybe (Either SomeException a)
commute      (Either SomeException (Maybe a) -> Maybe (Either SomeException a))
-> stm (Either SomeException (Maybe a))
-> stm (Maybe (Either SomeException a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> async (Maybe a) -> stm (Either SomeException (Maybe a))
forall (async :: * -> *) (stm :: * -> *) a.
MonadAsyncSTM async stm =>
async a -> stm (Either SomeException a)
waitCatchSTM (WithEarlyExit async a -> async (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit WithEarlyExit async a
a))
  pollSTM :: WithEarlyExit async a
-> WithEarlyExit stm (Maybe (Either SomeException a))
pollSTM      WithEarlyExit async a
a = stm (Maybe (Maybe (Either SomeException a)))
-> WithEarlyExit stm (Maybe (Either SomeException a))
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit ((Either SomeException (Maybe a) -> Maybe (Either SomeException a))
-> Maybe (Either SomeException (Maybe a))
-> Maybe (Maybe (Either SomeException a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either SomeException (Maybe a) -> Maybe (Either SomeException a)
forall a.
Either SomeException (Maybe a) -> Maybe (Either SomeException a)
commute (Maybe (Either SomeException (Maybe a))
 -> Maybe (Maybe (Either SomeException a)))
-> stm (Maybe (Either SomeException (Maybe a)))
-> stm (Maybe (Maybe (Either SomeException a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> async (Maybe a) -> stm (Maybe (Either SomeException (Maybe a)))
forall (async :: * -> *) (stm :: * -> *) a.
MonadAsyncSTM async stm =>
async a -> stm (Maybe (Either SomeException a))
pollSTM      (WithEarlyExit async a -> async (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit WithEarlyExit async a
a))

instance (MonadMask m, MonadAsync m, MonadCatch (STM m))
      => MonadAsync (WithEarlyExit m) where
  type Async (WithEarlyExit m) = WithEarlyExit (Async m)

  async :: WithEarlyExit m a -> WithEarlyExit m (Async (WithEarlyExit m) a)
async            = m (WithEarlyExit (Async m) a)
-> WithEarlyExit m (WithEarlyExit (Async m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (WithEarlyExit (Async m) a)
 -> WithEarlyExit m (WithEarlyExit (Async m) a))
-> (WithEarlyExit m a -> m (WithEarlyExit (Async m) a))
-> WithEarlyExit m a
-> WithEarlyExit m (WithEarlyExit (Async m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Async m (Maybe a) -> WithEarlyExit (Async m) a)
-> m (Async m (Maybe a)) -> m (WithEarlyExit (Async m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Async m (Maybe a) -> WithEarlyExit (Async m) a
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Async m (Maybe a)) -> m (WithEarlyExit (Async m) a))
-> (m (Maybe a) -> m (Async m (Maybe a)))
-> m (Maybe a)
-> m (WithEarlyExit (Async m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe a) -> m (Async m (Maybe a))
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async) (m (Maybe a) -> m (WithEarlyExit (Async m) a))
-> (WithEarlyExit m a -> m (Maybe a))
-> WithEarlyExit m a
-> m (WithEarlyExit (Async m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithEarlyExit m a -> m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit
  asyncThreadId :: Proxy (WithEarlyExit m)
-> Async (WithEarlyExit m) a -> ThreadId (WithEarlyExit m)
asyncThreadId Proxy (WithEarlyExit m)
_p = Proxy (WithEarlyExit m)
-> Async (WithEarlyExit m) a -> ThreadId (WithEarlyExit m)
forall (m :: * -> *) a.
MonadAsync m =>
Proxy m -> Async m a -> ThreadId m
asyncThreadId (Proxy (WithEarlyExit m)
forall k (t :: k). Proxy t
Proxy @(WithEarlyExit m))
  cancel :: Async (WithEarlyExit m) a -> WithEarlyExit m ()
cancel        Async (WithEarlyExit m) a
a  = m () -> WithEarlyExit m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithEarlyExit m ()) -> m () -> WithEarlyExit m ()
forall a b. (a -> b) -> a -> b
$ Async m (Maybe a) -> m ()
forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel     (WithEarlyExit (Async m) a -> Async m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit Async (WithEarlyExit m) a
WithEarlyExit (Async m) a
a)
  cancelWith :: Async (WithEarlyExit m) a -> e -> WithEarlyExit m ()
cancelWith    Async (WithEarlyExit m) a
a  = m () -> WithEarlyExit m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithEarlyExit m ())
-> (e -> m ()) -> e -> WithEarlyExit m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async m (Maybe a) -> e -> m ()
forall (m :: * -> *) e a.
(MonadAsync m, Exception e) =>
Async m a -> e -> m ()
cancelWith (WithEarlyExit (Async m) a -> Async m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit Async (WithEarlyExit m) a
WithEarlyExit (Async m) a
a)

  asyncWithUnmask :: ((forall b. WithEarlyExit m b -> WithEarlyExit m b)
 -> WithEarlyExit m a)
-> WithEarlyExit m (Async (WithEarlyExit m) a)
asyncWithUnmask (forall b. WithEarlyExit m b -> WithEarlyExit m b)
-> WithEarlyExit m a
f = m (Maybe (WithEarlyExit (Async m) a))
-> WithEarlyExit m (WithEarlyExit (Async m) a)
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Maybe (WithEarlyExit (Async m) a))
 -> WithEarlyExit m (WithEarlyExit (Async m) a))
-> m (Maybe (WithEarlyExit (Async m) a))
-> WithEarlyExit m (WithEarlyExit (Async m) a)
forall a b. (a -> b) -> a -> b
$ (Async m (Maybe a) -> Maybe (WithEarlyExit (Async m) a))
-> m (Async m (Maybe a)) -> m (Maybe (WithEarlyExit (Async m) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WithEarlyExit (Async m) a -> Maybe (WithEarlyExit (Async m) a)
forall a. a -> Maybe a
Just (WithEarlyExit (Async m) a -> Maybe (WithEarlyExit (Async m) a))
-> (Async m (Maybe a) -> WithEarlyExit (Async m) a)
-> Async m (Maybe a)
-> Maybe (WithEarlyExit (Async m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async m (Maybe a) -> WithEarlyExit (Async m) a
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit) (m (Async m (Maybe a)) -> m (Maybe (WithEarlyExit (Async m) a)))
-> m (Async m (Maybe a)) -> m (Maybe (WithEarlyExit (Async m) a))
forall a b. (a -> b) -> a -> b
$
    ((forall b. m b -> m b) -> m (Maybe a)) -> m (Async m (Maybe a))
forall (m :: * -> *) a.
MonadAsync m =>
((forall b. m b -> m b) -> m a) -> m (Async m a)
asyncWithUnmask (((forall b. m b -> m b) -> m (Maybe a)) -> m (Async m (Maybe a)))
-> ((forall b. m b -> m b) -> m (Maybe a)) -> m (Async m (Maybe a))
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
unmask ->
      WithEarlyExit m a -> m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit ((forall b. WithEarlyExit m b -> WithEarlyExit m b)
-> WithEarlyExit m a
f (m (Maybe b) -> WithEarlyExit m b
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Maybe b) -> WithEarlyExit m b)
-> (WithEarlyExit m b -> m (Maybe b))
-> WithEarlyExit m b
-> WithEarlyExit m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe b) -> m (Maybe b)
forall b. m b -> m b
unmask (m (Maybe b) -> m (Maybe b))
-> (WithEarlyExit m b -> m (Maybe b))
-> WithEarlyExit m b
-> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithEarlyExit m b -> m (Maybe b)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit))

commute :: Either SomeException (Maybe a) -> Maybe (Either SomeException a)
commute :: Either SomeException (Maybe a) -> Maybe (Either SomeException a)
commute (Left SomeException
e)         = Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
Just (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
e)
commute (Right Maybe a
Nothing)  = Maybe (Either SomeException a)
forall a. Maybe a
Nothing
commute (Right (Just a
a)) = Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
Just (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a)

instance MonadFork m => MonadFork (WithEarlyExit m) where
  forkIO :: WithEarlyExit m () -> WithEarlyExit m (ThreadId (WithEarlyExit m))
forkIO           WithEarlyExit m ()
f = m (ThreadId m) -> WithEarlyExit m (ThreadId m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ThreadId m) -> WithEarlyExit m (ThreadId m))
-> m (ThreadId m) -> WithEarlyExit m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ m () -> m (ThreadId m)
forall (m :: * -> *). MonadFork m => m () -> m (ThreadId m)
forkIO (Maybe () -> ()
collapse (Maybe () -> ()) -> m (Maybe ()) -> m ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithEarlyExit m () -> m (Maybe ())
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit WithEarlyExit m ()
f)
  forkIOWithUnmask :: ((forall a. WithEarlyExit m a -> WithEarlyExit m a)
 -> WithEarlyExit m ())
-> WithEarlyExit m (ThreadId (WithEarlyExit m))
forkIOWithUnmask (forall a. WithEarlyExit m a -> WithEarlyExit m a)
-> WithEarlyExit m ()
f = m (ThreadId m) -> WithEarlyExit m (ThreadId m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ThreadId m) -> WithEarlyExit m (ThreadId m))
-> m (ThreadId m) -> WithEarlyExit m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall (m :: * -> *).
MonadFork m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkIOWithUnmask (((forall a. m a -> m a) -> m ()) -> m (ThreadId m))
-> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask ->
                         let unmask' :: forall a. WithEarlyExit m a -> WithEarlyExit m a
                             unmask' :: WithEarlyExit m a -> WithEarlyExit m a
unmask' = m (Maybe a) -> WithEarlyExit m a
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (m (Maybe a) -> WithEarlyExit m a)
-> (WithEarlyExit m a -> m (Maybe a))
-> WithEarlyExit m a
-> WithEarlyExit m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe a) -> m (Maybe a)
forall a. m a -> m a
unmask (m (Maybe a) -> m (Maybe a))
-> (WithEarlyExit m a -> m (Maybe a))
-> WithEarlyExit m a
-> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithEarlyExit m a -> m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit
                         in Maybe () -> ()
collapse (Maybe () -> ()) -> m (Maybe ()) -> m ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithEarlyExit m () -> m (Maybe ())
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit ((forall a. WithEarlyExit m a -> WithEarlyExit m a)
-> WithEarlyExit m ()
f forall a. WithEarlyExit m a -> WithEarlyExit m a
unmask')
  throwTo :: ThreadId (WithEarlyExit m) -> e -> WithEarlyExit m ()
throwTo            = m () -> WithEarlyExit m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithEarlyExit m ())
-> (ThreadId m -> e -> m ())
-> ThreadId m
-> e
-> WithEarlyExit m ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: ThreadId m -> e -> m ()
forall (m :: * -> *) e.
(MonadFork m, Exception e) =>
ThreadId m -> e -> m ()
throwTo

instance MonadST m => MonadST (WithEarlyExit m) where
  withLiftST :: (forall s. (forall a. ST s a -> WithEarlyExit m a) -> b) -> b
withLiftST forall s. (forall a. ST s a -> WithEarlyExit m a) -> b
f = (forall s. Proxy s -> (forall a. ST s a -> m a) -> b) -> b
forall b.
(forall s. Proxy s -> (forall a. ST s a -> m a) -> b) -> b
lowerLiftST ((forall s. Proxy s -> (forall a. ST s a -> m a) -> b) -> b)
-> (forall s. Proxy s -> (forall a. ST s a -> m a) -> b) -> b
forall a b. (a -> b) -> a -> b
$ \(Proxy s
_proxy :: Proxy s) forall a. ST s a -> m a
liftST ->
     let liftST' :: forall a. ST s a -> WithEarlyExit m a
         liftST' :: ST s a -> WithEarlyExit m a
liftST' = m a -> WithEarlyExit m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WithEarlyExit m a)
-> (ST s a -> m a) -> ST s a -> WithEarlyExit m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST s a -> m a
forall a. ST s a -> m a
liftST
     in (forall a. ST s a -> WithEarlyExit m a) -> b
forall s. (forall a. ST s a -> WithEarlyExit m a) -> b
f forall a. ST s a -> WithEarlyExit m a
liftST'
    where
      lowerLiftST :: (forall s. Proxy s -> (forall a. ST s a -> m a) -> b) -> b
      lowerLiftST :: (forall s. Proxy s -> (forall a. ST s a -> m a) -> b) -> b
lowerLiftST forall s. Proxy s -> (forall a. ST s a -> m a) -> b
g = (forall s. (forall a. ST s a -> m a) -> b) -> b
forall (m :: * -> *) b.
MonadST m =>
(forall s. (forall a. ST s a -> m a) -> b) -> b
withLiftST ((forall s. (forall a. ST s a -> m a) -> b) -> b)
-> (forall s. (forall a. ST s a -> m a) -> b) -> b
forall a b. (a -> b) -> a -> b
$ Proxy s -> (forall a. ST s a -> m a) -> b
forall s. Proxy s -> (forall a. ST s a -> m a) -> b
g Proxy s
forall k (t :: k). Proxy t
Proxy

instance MonadMonotonicTime m => MonadMonotonicTime (WithEarlyExit m) where
  getMonotonicTime :: WithEarlyExit m Time
getMonotonicTime = m Time -> WithEarlyExit m Time
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime

instance MonadDelay m => MonadDelay (WithEarlyExit m) where
  threadDelay :: DiffTime -> WithEarlyExit m ()
threadDelay = m () -> WithEarlyExit m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithEarlyExit m ())
-> (DiffTime -> m ()) -> DiffTime -> WithEarlyExit m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay

instance (MonadEvaluate m, MonadCatch m) => MonadEvaluate (WithEarlyExit m) where
  evaluate :: a -> WithEarlyExit m a
evaluate  = m a -> WithEarlyExit m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WithEarlyExit m a) -> (a -> m a) -> a -> WithEarlyExit m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. MonadEvaluate m => a -> m a
evaluate

instance MonadEventlog m => MonadEventlog (WithEarlyExit m) where
  traceEventIO :: String -> WithEarlyExit m ()
traceEventIO  = m () -> WithEarlyExit m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithEarlyExit m ())
-> (String -> m ()) -> String -> WithEarlyExit m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ()
forall (m :: * -> *). MonadEventlog m => String -> m ()
traceEventIO
  traceMarkerIO :: String -> WithEarlyExit m ()
traceMarkerIO = m () -> WithEarlyExit m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithEarlyExit m ())
-> (String -> m ()) -> String -> WithEarlyExit m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ()
forall (m :: * -> *). MonadEventlog m => String -> m ()
traceMarkerIO

{-------------------------------------------------------------------------------
  Finally, the consensus IOLike wrapper
-------------------------------------------------------------------------------}

instance ( IOLike m
         , forall a. NoThunks (StrictTVar (WithEarlyExit m) a)
         , forall a. NoThunks (StrictMVar (WithEarlyExit m) a)
           -- The simulator does not currently support @MonadCatch (STM m)@,
           -- making this @IOLike@ instance applicable to @IO@ only. Once that
           -- missing @MonadCatch@ instance is added, @IOLike@ should require
           -- @MonadCatch (STM m)@ intsead of @MonadThrow (STM m)@.
           -- <https://github.com/input-output-hk/ouroboros-network/issues/1461>
         , MonadCatch (STM m)
         ) => IOLike (WithEarlyExit m) where
  forgetSignKeyKES :: SignKeyKES v -> WithEarlyExit m ()
forgetSignKeyKES = m () -> WithEarlyExit m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithEarlyExit m ())
-> (SignKeyKES v -> m ()) -> SignKeyKES v -> WithEarlyExit m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyKES v -> m ()
forall (m :: * -> *) v.
(IOLike m, KESAlgorithm v) =>
SignKeyKES v -> m ()
forgetSignKeyKES