{-# 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 (
    exitEarly
  , withEarlyExit
  , withEarlyExit_
    -- * Re-exports
  , lift
    -- * opaque
  , WithEarlyExit
  ) 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 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

  type TVar    (WithEarlyExit m) = TVar    m
  type TMVar   (WithEarlyExit m) = TMVar   m
  type TQueue  (WithEarlyExit m) = TQueue  m
  type TBQueue (WithEarlyExit m) = TBQueue m

  newTVar :: a -> STM (WithEarlyExit m) (TVar (WithEarlyExit m) a)
newTVar         = STM m (TVar m a) -> WithEarlyExit (STM m) (TVar m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (TVar m a) -> WithEarlyExit (STM m) (TVar m a))
-> (a -> STM m (TVar m a)) -> a -> WithEarlyExit (STM m) (TVar m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar
  readTVar :: TVar (WithEarlyExit m) a -> STM (WithEarlyExit m) a
readTVar        = STM m a -> WithEarlyExit (STM m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> WithEarlyExit (STM m) a)
-> (TVar m a -> STM m a) -> TVar m a -> WithEarlyExit (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar
  writeTVar :: TVar (WithEarlyExit m) a -> a -> STM (WithEarlyExit m) ()
writeTVar       = STM m () -> WithEarlyExit (STM m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> WithEarlyExit (STM m) ())
-> (TVar m a -> a -> STM m ())
-> TVar m a
-> a
-> WithEarlyExit (STM m) ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar
  retry :: STM (WithEarlyExit m) a
retry           = STM m a -> WithEarlyExit (STM m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
  orElse :: STM (WithEarlyExit m) a
-> STM (WithEarlyExit m) a -> STM (WithEarlyExit m) a
orElse          = (STM m (Maybe a) -> WithEarlyExit (STM m) a
forall (m :: * -> *) a. m (Maybe a) -> WithEarlyExit m a
earlyExit (STM m (Maybe a) -> WithEarlyExit (STM m) a)
-> (STM m (Maybe a) -> STM m (Maybe a) -> STM m (Maybe a))
-> STM m (Maybe a)
-> STM m (Maybe a)
-> WithEarlyExit (STM m) a
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: STM m (Maybe a) -> STM m (Maybe a) -> STM m (Maybe a)
forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
orElse) (STM m (Maybe a) -> STM m (Maybe a) -> WithEarlyExit (STM m) a)
-> (WithEarlyExit (STM m) a -> STM m (Maybe a))
-> WithEarlyExit (STM m) a
-> WithEarlyExit (STM m) a
-> WithEarlyExit (STM m) a
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` WithEarlyExit (STM m) a -> STM m (Maybe a)
forall (m :: * -> *) a. WithEarlyExit m a -> m (Maybe a)
withEarlyExit
  newTMVar :: a -> STM (WithEarlyExit m) (TMVar (WithEarlyExit m) a)
newTMVar        = STM m (TMVar m a) -> WithEarlyExit (STM m) (TMVar m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (TMVar m a) -> WithEarlyExit (STM m) (TMVar m a))
-> (a -> STM m (TMVar m a))
-> a
-> WithEarlyExit (STM m) (TMVar m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  a -> STM m (TMVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TMVar m a)
newTMVar
  newEmptyTMVar :: STM (WithEarlyExit m) (TMVar (WithEarlyExit m) a)
newEmptyTMVar   = STM m (TMVar m a) -> WithEarlyExit (STM m) (TMVar m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    STM m (TMVar m a)
forall (m :: * -> *) a. MonadSTM m => STM m (TMVar m a)
newEmptyTMVar
  takeTMVar :: TMVar (WithEarlyExit m) a -> STM (WithEarlyExit m) a
takeTMVar       = STM m a -> WithEarlyExit (STM m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> WithEarlyExit (STM m) a)
-> (TMVar m a -> STM m a) -> TMVar m a -> WithEarlyExit (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
takeTMVar
  tryTakeTMVar :: TMVar (WithEarlyExit m) a -> STM (WithEarlyExit m) (Maybe a)
tryTakeTMVar    = STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a))
-> (TMVar m a -> STM m (Maybe a))
-> TMVar m a
-> WithEarlyExit (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar m a -> STM m (Maybe a)
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m (Maybe a)
tryTakeTMVar
  putTMVar :: TMVar (WithEarlyExit m) a -> a -> STM (WithEarlyExit m) ()
putTMVar        = STM m () -> WithEarlyExit (STM m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> WithEarlyExit (STM m) ())
-> (TMVar m a -> a -> STM m ())
-> TMVar m a
-> a
-> WithEarlyExit (STM m) ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TMVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m ()
putTMVar
  tryPutTMVar :: TMVar (WithEarlyExit m) a -> a -> STM (WithEarlyExit m) Bool
tryPutTMVar     = STM m Bool -> WithEarlyExit (STM m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Bool -> WithEarlyExit (STM m) Bool)
-> (TMVar m a -> a -> STM m Bool)
-> TMVar m a
-> a
-> WithEarlyExit (STM m) Bool
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TMVar m a -> a -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m Bool
tryPutTMVar
  readTMVar :: TMVar (WithEarlyExit m) a -> STM (WithEarlyExit m) a
readTMVar       = STM m a -> WithEarlyExit (STM m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> WithEarlyExit (STM m) a)
-> (TMVar m a -> STM m a) -> TMVar m a -> WithEarlyExit (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
readTMVar
  tryReadTMVar :: TMVar (WithEarlyExit m) a -> STM (WithEarlyExit m) (Maybe a)
tryReadTMVar    = STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a))
-> (TMVar m a -> STM m (Maybe a))
-> TMVar m a
-> WithEarlyExit (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar m a -> STM m (Maybe a)
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m (Maybe a)
tryReadTMVar
  swapTMVar :: TMVar (WithEarlyExit m) a -> a -> STM (WithEarlyExit m) a
swapTMVar       = STM m a -> WithEarlyExit (STM m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> WithEarlyExit (STM m) a)
-> (TMVar m a -> a -> STM m a)
-> TMVar m a
-> a
-> WithEarlyExit (STM m) a
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TMVar m a -> a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m a
swapTMVar
  isEmptyTMVar :: TMVar (WithEarlyExit m) a -> STM (WithEarlyExit m) Bool
isEmptyTMVar    = STM m Bool -> WithEarlyExit (STM m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Bool -> WithEarlyExit (STM m) Bool)
-> (TMVar m a -> STM m Bool)
-> TMVar m a
-> WithEarlyExit (STM m) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar m a -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m Bool
isEmptyTMVar
  newTQueue :: STM (WithEarlyExit m) (TQueue (WithEarlyExit m) a)
newTQueue       = STM m (TQueue m a) -> WithEarlyExit (STM m) (TQueue m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    STM m (TQueue m a)
forall (m :: * -> *) a. MonadSTM m => STM m (TQueue m a)
newTQueue
  readTQueue :: TQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) a
readTQueue      = STM m a -> WithEarlyExit (STM m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> WithEarlyExit (STM m) a)
-> (TQueue m a -> STM m a) -> TQueue m a -> WithEarlyExit (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m a
readTQueue
  tryReadTQueue :: TQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) (Maybe a)
tryReadTQueue   = STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a))
-> (TQueue m a -> STM m (Maybe a))
-> TQueue m a
-> WithEarlyExit (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> STM m (Maybe a)
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m (Maybe a)
tryReadTQueue
  peekTQueue :: TQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) a
peekTQueue      = STM m a -> WithEarlyExit (STM m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> WithEarlyExit (STM m) a)
-> (TQueue m a -> STM m a) -> TQueue m a -> WithEarlyExit (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m a
peekTQueue
  tryPeekTQueue :: TQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) (Maybe a)
tryPeekTQueue   = STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a))
-> (TQueue m a -> STM m (Maybe a))
-> TQueue m a
-> WithEarlyExit (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> STM m (Maybe a)
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m (Maybe a)
tryPeekTQueue
  writeTQueue :: TQueue (WithEarlyExit m) a -> a -> STM (WithEarlyExit m) ()
writeTQueue     = STM m () -> WithEarlyExit (STM m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> WithEarlyExit (STM m) ())
-> (TQueue m a -> a -> STM m ())
-> TQueue m a
-> a
-> WithEarlyExit (STM m) ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TQueue m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> a -> STM m ()
writeTQueue
  isEmptyTQueue :: TQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) Bool
isEmptyTQueue   = STM m Bool -> WithEarlyExit (STM m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Bool -> WithEarlyExit (STM m) Bool)
-> (TQueue m a -> STM m Bool)
-> TQueue m a
-> WithEarlyExit (STM m) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m Bool
isEmptyTQueue
  newTBQueue :: Natural -> STM (WithEarlyExit m) (TBQueue (WithEarlyExit m) a)
newTBQueue      = STM m (TBQueue m a) -> WithEarlyExit (STM m) (TBQueue m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (TBQueue m a) -> WithEarlyExit (STM m) (TBQueue m a))
-> (Natural -> STM m (TBQueue m a))
-> Natural
-> WithEarlyExit (STM m) (TBQueue m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Natural -> STM m (TBQueue m a)
forall (m :: * -> *) a.
MonadSTM m =>
Natural -> STM m (TBQueue m a)
newTBQueue
  readTBQueue :: TBQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) a
readTBQueue     = STM m a -> WithEarlyExit (STM m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> WithEarlyExit (STM m) a)
-> (TBQueue m a -> STM m a)
-> TBQueue m a
-> WithEarlyExit (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m a
readTBQueue
  tryReadTBQueue :: TBQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) (Maybe a)
tryReadTBQueue  = STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a))
-> (TBQueue m a -> STM m (Maybe a))
-> TBQueue m a
-> WithEarlyExit (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m (Maybe a)
forall (m :: * -> *) a.
MonadSTM m =>
TBQueue m a -> STM m (Maybe a)
tryReadTBQueue
  peekTBQueue :: TBQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) a
peekTBQueue     = STM m a -> WithEarlyExit (STM m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> WithEarlyExit (STM m) a)
-> (TBQueue m a -> STM m a)
-> TBQueue m a
-> WithEarlyExit (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m a
peekTBQueue
  tryPeekTBQueue :: TBQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) (Maybe a)
tryPeekTBQueue  = STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> WithEarlyExit (STM m) (Maybe a))
-> (TBQueue m a -> STM m (Maybe a))
-> TBQueue m a
-> WithEarlyExit (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m (Maybe a)
forall (m :: * -> *) a.
MonadSTM m =>
TBQueue m a -> STM m (Maybe a)
tryPeekTBQueue
  flushTBQueue :: TBQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) [a]
flushTBQueue    = STM m [a] -> WithEarlyExit (STM m) [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m [a] -> WithEarlyExit (STM m) [a])
-> (TBQueue m a -> STM m [a])
-> TBQueue m a
-> WithEarlyExit (STM m) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m [a]
forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m [a]
flushTBQueue
  writeTBQueue :: TBQueue (WithEarlyExit m) a -> a -> STM (WithEarlyExit m) ()
writeTBQueue    = STM m () -> WithEarlyExit (STM m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> WithEarlyExit (STM m) ())
-> (TBQueue m a -> a -> STM m ())
-> TBQueue m a
-> a
-> WithEarlyExit (STM m) ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TBQueue m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> a -> STM m ()
writeTBQueue
  lengthTBQueue :: TBQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) Natural
lengthTBQueue   = STM m Natural -> WithEarlyExit (STM m) Natural
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Natural -> WithEarlyExit (STM m) Natural)
-> (TBQueue m a -> STM m Natural)
-> TBQueue m a
-> WithEarlyExit (STM m) Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m Natural
forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m Natural
lengthTBQueue
  isEmptyTBQueue :: TBQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) Bool
isEmptyTBQueue  = STM m Bool -> WithEarlyExit (STM m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Bool -> WithEarlyExit (STM m) Bool)
-> (TBQueue m a -> STM m Bool)
-> TBQueue m a
-> WithEarlyExit (STM m) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m Bool
isEmptyTBQueue
  isFullTBQueue :: TBQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) Bool
isFullTBQueue   = STM m Bool -> WithEarlyExit (STM m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Bool -> WithEarlyExit (STM m) Bool)
-> (TBQueue m a -> STM m Bool)
-> TBQueue m a
-> WithEarlyExit (STM m) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m Bool
isFullTBQueue

  newTMVarIO :: a -> WithEarlyExit m (TMVar (WithEarlyExit m) a)
newTMVarIO      = m (TMVar m a) -> WithEarlyExit m (TMVar m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TMVar m a) -> WithEarlyExit m (TMVar m a))
-> (a -> m (TMVar m a)) -> a -> WithEarlyExit m (TMVar m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (TMVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TMVar m a)
newTMVarIO
  newEmptyTMVarIO :: WithEarlyExit m (TMVar (WithEarlyExit m) a)
newEmptyTMVarIO = m (TMVar m a) -> WithEarlyExit m (TMVar m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift   m (TMVar 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 (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 :: Async (WithEarlyExit m) a -> ThreadId (WithEarlyExit m)
asyncThreadId    = Async (WithEarlyExit m) a -> ThreadId (WithEarlyExit m)
forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId
  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)

  waitCatchSTM :: Async (WithEarlyExit m) a
-> STM (WithEarlyExit m) (Either SomeException a)
waitCatchSTM Async (WithEarlyExit m) a
a = STM m (Maybe (Either SomeException a))
-> WithEarlyExit (STM m) (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 m (Either SomeException (Maybe a))
-> STM m (Maybe (Either SomeException a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Async m (Maybe a) -> STM m (Either SomeException (Maybe a))
forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Either SomeException a)
waitCatchSTM (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))
  pollSTM :: Async (WithEarlyExit m) a
-> STM (WithEarlyExit m) (Maybe (Either SomeException a))
pollSTM      Async (WithEarlyExit m) a
a = STM m (Maybe (Maybe (Either SomeException a)))
-> WithEarlyExit (STM m) (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 m (Maybe (Either SomeException (Maybe a)))
-> STM m (Maybe (Maybe (Either SomeException a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Async m (Maybe a) -> STM m (Maybe (Either SomeException (Maybe a)))
forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Maybe (Either SomeException a))
pollSTM      (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
  yield :: WithEarlyExit m ()
yield              = m () -> WithEarlyExit m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). MonadFork m => m ()
yield

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