{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# 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.Class.MonadAsync import Control.Monad.Class.MonadEventlog import Control.Monad.Class.MonadFork import Control.Monad.Class.MonadST import Control.Monad.Class.MonadSTM.Internal import Control.Monad.Class.MonadThrow import Control.Monad.Class.MonadTimer 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 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 type TArray (WithEarlyExit m) = TArray m type TSem (WithEarlyExit m) = TSem m type TChan (WithEarlyExit m) = TChan 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 flushTQueue :: TQueue (WithEarlyExit m) a -> STM (WithEarlyExit m) [a] flushTQueue = 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] flushTQueue 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 unGetTQueue :: TQueue (WithEarlyExit m) a -> a -> STM (WithEarlyExit m) () unGetTQueue = 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 () unGetTQueue 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 unGetTBQueue :: TBQueue (WithEarlyExit m) a -> a -> STM (WithEarlyExit m) () unGetTBQueue = 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 () unGetTBQueue newTSem :: Integer -> STM (WithEarlyExit m) (TSem (WithEarlyExit m)) newTSem = STM m (TSem m) -> WithEarlyExit (STM m) (TSem m) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (STM m (TSem m) -> WithEarlyExit (STM m) (TSem m)) -> (Integer -> STM m (TSem m)) -> Integer -> WithEarlyExit (STM m) (TSem m) forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> STM m (TSem m) forall (m :: * -> *). MonadSTM m => Integer -> STM m (TSem m) newTSem waitTSem :: TSem (WithEarlyExit m) -> STM (WithEarlyExit m) () waitTSem = STM m () -> WithEarlyExit (STM m) () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (STM m () -> WithEarlyExit (STM m) ()) -> (TSem m -> STM m ()) -> TSem m -> WithEarlyExit (STM m) () forall b c a. (b -> c) -> (a -> b) -> a -> c . TSem m -> STM m () forall (m :: * -> *). MonadSTM m => TSem m -> STM m () waitTSem signalTSem :: TSem (WithEarlyExit m) -> STM (WithEarlyExit m) () signalTSem = STM m () -> WithEarlyExit (STM m) () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (STM m () -> WithEarlyExit (STM m) ()) -> (TSem m -> STM m ()) -> TSem m -> WithEarlyExit (STM m) () forall b c a. (b -> c) -> (a -> b) -> a -> c . TSem m -> STM m () forall (m :: * -> *). MonadSTM m => TSem m -> STM m () signalTSem signalTSemN :: Natural -> TSem (WithEarlyExit m) -> STM (WithEarlyExit m) () signalTSemN = STM m () -> WithEarlyExit (STM m) () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (STM m () -> WithEarlyExit (STM m) ()) -> (Natural -> TSem m -> STM m ()) -> Natural -> TSem m -> WithEarlyExit (STM m) () forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z .: Natural -> TSem m -> STM m () forall (m :: * -> *). MonadSTM m => Natural -> TSem m -> STM m () signalTSemN newTChan :: STM (WithEarlyExit m) (TChan (WithEarlyExit m) a) newTChan = STM m (TChan m a) -> WithEarlyExit (STM m) (TChan m a) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift STM m (TChan m a) forall (m :: * -> *) a. MonadSTM m => STM m (TChan m a) newTChan newBroadcastTChan :: STM (WithEarlyExit m) (TChan (WithEarlyExit m) a) newBroadcastTChan = STM m (TChan m a) -> WithEarlyExit (STM m) (TChan m a) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift STM m (TChan m a) forall (m :: * -> *) a. MonadSTM m => STM m (TChan m a) newBroadcastTChan dupTChan :: TChan (WithEarlyExit m) a -> STM (WithEarlyExit m) (TChan (WithEarlyExit m) a) dupTChan = STM m (TChan m a) -> WithEarlyExit (STM m) (TChan m a) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (STM m (TChan m a) -> WithEarlyExit (STM m) (TChan m a)) -> (TChan m a -> STM m (TChan m a)) -> TChan m a -> WithEarlyExit (STM m) (TChan m a) forall b c a. (b -> c) -> (a -> b) -> a -> c . TChan m a -> STM m (TChan m a) forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m (TChan m a) dupTChan cloneTChan :: TChan (WithEarlyExit m) a -> STM (WithEarlyExit m) (TChan (WithEarlyExit m) a) cloneTChan = STM m (TChan m a) -> WithEarlyExit (STM m) (TChan m a) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (STM m (TChan m a) -> WithEarlyExit (STM m) (TChan m a)) -> (TChan m a -> STM m (TChan m a)) -> TChan m a -> WithEarlyExit (STM m) (TChan m a) forall b c a. (b -> c) -> (a -> b) -> a -> c . TChan m a -> STM m (TChan m a) forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m (TChan m a) cloneTChan readTChan :: TChan (WithEarlyExit m) a -> STM (WithEarlyExit m) a readTChan = 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) -> (TChan m a -> STM m a) -> TChan m a -> WithEarlyExit (STM m) a forall b c a. (b -> c) -> (a -> b) -> a -> c . TChan m a -> STM m a forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m a readTChan tryReadTChan :: TChan (WithEarlyExit m) a -> STM (WithEarlyExit m) (Maybe a) tryReadTChan = 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)) -> (TChan m a -> STM m (Maybe a)) -> TChan m a -> WithEarlyExit (STM m) (Maybe a) forall b c a. (b -> c) -> (a -> b) -> a -> c . TChan m a -> STM m (Maybe a) forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m (Maybe a) tryReadTChan peekTChan :: TChan (WithEarlyExit m) a -> STM (WithEarlyExit m) a peekTChan = 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) -> (TChan m a -> STM m a) -> TChan m a -> WithEarlyExit (STM m) a forall b c a. (b -> c) -> (a -> b) -> a -> c . TChan m a -> STM m a forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m a peekTChan tryPeekTChan :: TChan (WithEarlyExit m) a -> STM (WithEarlyExit m) (Maybe a) tryPeekTChan = 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)) -> (TChan m a -> STM m (Maybe a)) -> TChan m a -> WithEarlyExit (STM m) (Maybe a) forall b c a. (b -> c) -> (a -> b) -> a -> c . TChan m a -> STM m (Maybe a) forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m (Maybe a) tryPeekTChan writeTChan :: TChan (WithEarlyExit m) a -> a -> STM (WithEarlyExit m) () writeTChan = STM m () -> WithEarlyExit (STM m) () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (STM m () -> WithEarlyExit (STM m) ()) -> (TChan m a -> a -> STM m ()) -> TChan m a -> a -> WithEarlyExit (STM m) () forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z .: TChan m a -> a -> STM m () forall (m :: * -> *) a. MonadSTM m => TChan m a -> a -> STM m () writeTChan unGetTChan :: TChan (WithEarlyExit m) a -> a -> STM (WithEarlyExit m) () unGetTChan = STM m () -> WithEarlyExit (STM m) () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (STM m () -> WithEarlyExit (STM m) ()) -> (TChan m a -> a -> STM m ()) -> TChan m a -> a -> WithEarlyExit (STM m) () forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z .: TChan m a -> a -> STM m () forall (m :: * -> *) a. MonadSTM m => TChan m a -> a -> STM m () unGetTChan isEmptyTChan :: TChan (WithEarlyExit m) a -> STM (WithEarlyExit m) Bool isEmptyTChan = 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) -> (TChan m a -> STM m Bool) -> TChan m a -> WithEarlyExit (STM m) Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . TChan m a -> STM m Bool forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m Bool isEmptyTChan 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 threadStatus :: ThreadId (WithEarlyExit m) -> WithEarlyExit m ThreadStatus threadStatus = m ThreadStatus -> WithEarlyExit m ThreadStatus forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m ThreadStatus -> WithEarlyExit m ThreadStatus) -> (ThreadId m -> m ThreadStatus) -> ThreadId m -> WithEarlyExit m ThreadStatus forall b c a. (b -> c) -> (a -> b) -> a -> c . ThreadId m -> m ThreadStatus forall (m :: * -> *). MonadThread m => ThreadId m -> m ThreadStatus threadStatus 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 asyncBound :: WithEarlyExit m a -> WithEarlyExit m (Async (WithEarlyExit m) a) asyncBound = 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 asyncOn :: Int -> WithEarlyExit m a -> WithEarlyExit m (Async (WithEarlyExit m) a) asyncOn Int n = 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 . Int -> m (Maybe a) -> m (Async m (Maybe a)) forall (m :: * -> *) a. MonadAsync m => Int -> m a -> m (Async m a) asyncOn Int n) (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)) asyncOnWithUnmask :: Int -> ((forall b. WithEarlyExit m b -> WithEarlyExit m b) -> WithEarlyExit m a) -> WithEarlyExit m (Async (WithEarlyExit m) a) asyncOnWithUnmask Int n (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 $ Int -> ((forall b. m b -> m b) -> m (Maybe a)) -> m (Async m (Maybe a)) forall (m :: * -> *) a. MonadAsync m => Int -> ((forall b. m b -> m b) -> m a) -> m (Async m a) asyncOnWithUnmask Int n (((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) forkOn :: Int -> WithEarlyExit m () -> WithEarlyExit m (ThreadId (WithEarlyExit m)) forkOn Int n 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 $ Int -> m () -> m (ThreadId m) forall (m :: * -> *). MonadFork m => Int -> m () -> m (ThreadId m) forkOn Int n (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