{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Test.DejaFu.Types
-- Copyright   : (c) 2017--2021 Michael Walker
-- License     : MIT
-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
-- Stability   : experimental
-- Portability : DeriveGeneric, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, RankNTypes, StandaloneDeriving, TypeFamilies
--
-- Common types and functions used throughout DejaFu.
module Test.DejaFu.Types where

import qualified Control.Concurrent                   as IO
import           Control.DeepSeq                      (NFData(..))
import           Control.Exception                    (Exception(..),
                                                       MaskingState(..),
                                                       SomeException)
import           Control.Monad                        (forever)
import           Control.Monad.Catch                  (MonadThrow)
import           Control.Monad.Catch.Pure             (CatchT)
import qualified Control.Monad.ST                     as ST
import           Control.Monad.Trans.Class            (lift)
import           Data.Function                        (on)
import           Data.Functor.Contravariant           (Contravariant(..))
import           Data.Functor.Contravariant.Divisible (Divisible(..))
import qualified Data.IORef                           as IO
import           Data.Kind                            (Type)
import           Data.Map.Strict                      (Map)
import qualified Data.Map.Strict                      as M
import           Data.Semigroup                       (Semigroup(..))
import           Data.Set                             (Set)
import qualified Data.Set                             as S
import qualified Data.STRef                           as ST
import           GHC.Generics                         (Generic, V1)

-------------------------------------------------------------------------------
-- * The @MonadDejaFu@ typeclass

-- | The @MonadDejaFu@ class captures the two things needed to run a
-- concurrent program which we can't implement in normal Haskell:
-- mutable references, and the ability to create a bound thread in
-- @IO@.
--
-- In addition to needing the operations in this class, dejafu also
-- needs the ability to throw exceptions, as these are used to
-- communicate 'Error's, so there is a 'MonadThrow' constraint.
--
-- @since 2.1.0.0
class MonadThrow m => MonadDejaFu m where
  -- | The type of mutable references.  These references will always
  -- contain a value, and so don't need to handle emptiness (like
  -- @MVar@ does).
  --
  -- These references are always used from the same Haskell thread, so
  -- it's safe to implement these using unsynchronised primitives with
  -- relaxed-memory behaviours (like @IORef@s).
  type Ref m :: Type -> Type

  -- | Create a new reference holding a given initial value.
  newRef :: a -> m (Ref m a)

  -- | Read the current value in the reference.
  readRef :: Ref m a -> m a

  -- | Replace the value in the reference.
  writeRef :: Ref m a -> a -> m ()

  -- | A handle to a bound thread.  If the monad doesn't support bound
  -- threads (for example, if it's not based on @IO@), then this
  -- should be some type which can't be constructed, like 'V1'.
  type BoundThread m :: Type -> Type

  -- | Fork a new bound thread, if the monad supports them.
  forkBoundThread :: Maybe (m (BoundThread m a))

  -- | Run an action in a previously created bound thread.
  runInBoundThread :: BoundThread m a -> m a -> m a

  -- | Terminate a previously created bound thread.
  --
  -- After termination, 'runInBoundThread' and 'killBoundThread' will
  -- never be called on this @BoundThread m a@ value again.
  killBoundThread :: BoundThread m a -> m ()

-- | A bound thread in @IO@.
--
-- @since 2.1.0.0
data IOBoundThread a = IOBoundThread
  { forall a. IOBoundThread a -> IO a -> IO a
iobtRunInBoundThread :: IO a -> IO a
    -- ^ Pass an action to the bound thread, run it, and return the
    -- result to this thread.
  , forall a. IOBoundThread a -> IO ()
iobtKillBoundThread  :: IO ()
    -- ^ Terminate the bound thread.
  }

-- | @since 2.1.0.0
instance MonadDejaFu IO where
  type Ref IO = IO.IORef

  newRef :: forall a. a -> IO (Ref IO a)
newRef   = a -> IO (IORef a)
a -> IO (Ref IO a)
forall a. a -> IO (IORef a)
IO.newIORef
  readRef :: forall a. Ref IO a -> IO a
readRef  = IORef a -> IO a
Ref IO a -> IO a
forall a. IORef a -> IO a
IO.readIORef
  writeRef :: forall a. Ref IO a -> a -> IO ()
writeRef = IORef a -> a -> IO ()
Ref IO a -> a -> IO ()
forall a. IORef a -> a -> IO ()
IO.writeIORef

  type BoundThread IO = IOBoundThread

  forkBoundThread :: forall a. Maybe (IO (BoundThread IO a))
forkBoundThread = IO (BoundThread IO a) -> Maybe (IO (BoundThread IO a))
forall a. a -> Maybe a
Just (IO (BoundThread IO a) -> Maybe (IO (BoundThread IO a)))
-> IO (BoundThread IO a) -> Maybe (IO (BoundThread IO a))
forall a b. (a -> b) -> a -> b
$ do
      MVar (IO a)
runboundIO <- IO (MVar (IO a))
forall a. IO (MVar a)
IO.newEmptyMVar
      MVar a
getboundIO <- IO (MVar a)
forall a. IO (MVar a)
IO.newEmptyMVar
      ThreadId
tid <- IO () -> IO ThreadId
IO.forkOS (MVar (IO a) -> MVar a -> IO ()
forall {a} {b}. MVar (IO a) -> MVar a -> IO b
go MVar (IO a)
runboundIO MVar a
getboundIO)
      IOBoundThread a -> IO (IOBoundThread a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IOBoundThread
        { iobtRunInBoundThread :: IO a -> IO a
iobtRunInBoundThread = MVar (IO a) -> MVar a -> IO a -> IO a
forall {a} {b}. MVar a -> MVar b -> a -> IO b
run MVar (IO a)
runboundIO MVar a
getboundIO
        , iobtKillBoundThread :: IO ()
iobtKillBoundThread  = ThreadId -> IO ()
IO.killThread ThreadId
tid
        }
    where
      go :: MVar (IO a) -> MVar a -> IO b
go MVar (IO a)
runboundIO MVar a
getboundIO = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ do
        IO a
na <- MVar (IO a) -> IO (IO a)
forall a. MVar a -> IO a
IO.takeMVar MVar (IO a)
runboundIO
        MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
IO.putMVar MVar a
getboundIO (a -> IO ()) -> IO a -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO a
na

      run :: MVar a -> MVar b -> a -> IO b
run MVar a
runboundIO MVar b
getboundIO a
ma = do
        MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
IO.putMVar MVar a
runboundIO a
ma
        MVar b -> IO b
forall a. MVar a -> IO a
IO.takeMVar MVar b
getboundIO

  runInBoundThread :: forall a. BoundThread IO a -> IO a -> IO a
runInBoundThread = IOBoundThread a -> IO a -> IO a
BoundThread IO a -> IO a -> IO a
forall a. IOBoundThread a -> IO a -> IO a
iobtRunInBoundThread
  killBoundThread :: forall a. BoundThread IO a -> IO ()
killBoundThread  = IOBoundThread a -> IO ()
BoundThread IO a -> IO ()
forall a. IOBoundThread a -> IO ()
iobtKillBoundThread

-- | This instance does not support bound threads.
--
-- @since 2.1.0.0
instance MonadDejaFu (CatchT (ST.ST t)) where
  type Ref (CatchT (ST.ST t)) = ST.STRef t

  newRef :: forall a. a -> CatchT (ST t) (Ref (CatchT (ST t)) a)
newRef     = ST t (STRef t a) -> CatchT (ST t) (STRef t a)
forall (m :: * -> *) a. Monad m => m a -> CatchT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST t (STRef t a) -> CatchT (ST t) (STRef t a))
-> (a -> ST t (STRef t a)) -> a -> CatchT (ST t) (STRef t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ST t (STRef t a)
forall a s. a -> ST s (STRef s a)
ST.newSTRef
  readRef :: forall a. Ref (CatchT (ST t)) a -> CatchT (ST t) a
readRef    = ST t a -> CatchT (ST t) a
forall (m :: * -> *) a. Monad m => m a -> CatchT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST t a -> CatchT (ST t) a)
-> (STRef t a -> ST t a) -> STRef t a -> CatchT (ST t) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STRef t a -> ST t a
forall s a. STRef s a -> ST s a
ST.readSTRef
  writeRef :: forall a. Ref (CatchT (ST t)) a -> a -> CatchT (ST t) ()
writeRef Ref (CatchT (ST t)) a
r = ST t () -> CatchT (ST t) ()
forall (m :: * -> *) a. Monad m => m a -> CatchT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST t () -> CatchT (ST t) ())
-> (a -> ST t ()) -> a -> CatchT (ST t) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STRef t a -> a -> ST t ()
forall s a. STRef s a -> a -> ST s ()
ST.writeSTRef STRef t a
Ref (CatchT (ST t)) a
r

  -- V1 has no constructors
  type BoundThread (CatchT (ST.ST t)) = V1

  forkBoundThread :: forall a. Maybe (CatchT (ST t) (BoundThread (CatchT (ST t)) a))
forkBoundThread  = Maybe (CatchT (ST t) (V1 a))
Maybe (CatchT (ST t) (BoundThread (CatchT (ST t)) a))
forall a. Maybe a
Nothing
  runInBoundThread :: forall a.
BoundThread (CatchT (ST t)) a -> CatchT (ST t) a -> CatchT (ST t) a
runInBoundThread = V1 a -> CatchT (ST t) a -> CatchT (ST t) a
BoundThread (CatchT (ST t)) a -> CatchT (ST t) a -> CatchT (ST t) a
forall a. HasCallStack => a
undefined
  killBoundThread :: forall a. BoundThread (CatchT (ST t)) a -> CatchT (ST t) ()
killBoundThread  = V1 a -> CatchT (ST t) ()
BoundThread (CatchT (ST t)) a -> CatchT (ST t) ()
forall a. HasCallStack => a
undefined

-------------------------------------------------------------------------------
-- * Identifiers

-- | Every thread has a unique identitifer.
--
-- @since 1.0.0.0
newtype ThreadId = ThreadId Id
  deriving (ThreadId -> ThreadId -> Bool
(ThreadId -> ThreadId -> Bool)
-> (ThreadId -> ThreadId -> Bool) -> Eq ThreadId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ThreadId -> ThreadId -> Bool
== :: ThreadId -> ThreadId -> Bool
$c/= :: ThreadId -> ThreadId -> Bool
/= :: ThreadId -> ThreadId -> Bool
Eq, Eq ThreadId
Eq ThreadId =>
(ThreadId -> ThreadId -> Ordering)
-> (ThreadId -> ThreadId -> Bool)
-> (ThreadId -> ThreadId -> Bool)
-> (ThreadId -> ThreadId -> Bool)
-> (ThreadId -> ThreadId -> Bool)
-> (ThreadId -> ThreadId -> ThreadId)
-> (ThreadId -> ThreadId -> ThreadId)
-> Ord ThreadId
ThreadId -> ThreadId -> Bool
ThreadId -> ThreadId -> Ordering
ThreadId -> ThreadId -> ThreadId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ThreadId -> ThreadId -> Ordering
compare :: ThreadId -> ThreadId -> Ordering
$c< :: ThreadId -> ThreadId -> Bool
< :: ThreadId -> ThreadId -> Bool
$c<= :: ThreadId -> ThreadId -> Bool
<= :: ThreadId -> ThreadId -> Bool
$c> :: ThreadId -> ThreadId -> Bool
> :: ThreadId -> ThreadId -> Bool
$c>= :: ThreadId -> ThreadId -> Bool
>= :: ThreadId -> ThreadId -> Bool
$cmax :: ThreadId -> ThreadId -> ThreadId
max :: ThreadId -> ThreadId -> ThreadId
$cmin :: ThreadId -> ThreadId -> ThreadId
min :: ThreadId -> ThreadId -> ThreadId
Ord, ThreadId -> ()
(ThreadId -> ()) -> NFData ThreadId
forall a. (a -> ()) -> NFData a
$crnf :: ThreadId -> ()
rnf :: ThreadId -> ()
NFData)

instance Show ThreadId where
  show :: ThreadId -> String
show (ThreadId Id
id_) = Id -> String
forall a. Show a => a -> String
show Id
id_

-- | @since 1.3.1.0
deriving instance Generic ThreadId

-- | Every @IORef@ has a unique identifier.
--
-- @since 1.11.0.0
newtype IORefId = IORefId Id
  deriving (IORefId -> IORefId -> Bool
(IORefId -> IORefId -> Bool)
-> (IORefId -> IORefId -> Bool) -> Eq IORefId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IORefId -> IORefId -> Bool
== :: IORefId -> IORefId -> Bool
$c/= :: IORefId -> IORefId -> Bool
/= :: IORefId -> IORefId -> Bool
Eq, Eq IORefId
Eq IORefId =>
(IORefId -> IORefId -> Ordering)
-> (IORefId -> IORefId -> Bool)
-> (IORefId -> IORefId -> Bool)
-> (IORefId -> IORefId -> Bool)
-> (IORefId -> IORefId -> Bool)
-> (IORefId -> IORefId -> IORefId)
-> (IORefId -> IORefId -> IORefId)
-> Ord IORefId
IORefId -> IORefId -> Bool
IORefId -> IORefId -> Ordering
IORefId -> IORefId -> IORefId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IORefId -> IORefId -> Ordering
compare :: IORefId -> IORefId -> Ordering
$c< :: IORefId -> IORefId -> Bool
< :: IORefId -> IORefId -> Bool
$c<= :: IORefId -> IORefId -> Bool
<= :: IORefId -> IORefId -> Bool
$c> :: IORefId -> IORefId -> Bool
> :: IORefId -> IORefId -> Bool
$c>= :: IORefId -> IORefId -> Bool
>= :: IORefId -> IORefId -> Bool
$cmax :: IORefId -> IORefId -> IORefId
max :: IORefId -> IORefId -> IORefId
$cmin :: IORefId -> IORefId -> IORefId
min :: IORefId -> IORefId -> IORefId
Ord, IORefId -> ()
(IORefId -> ()) -> NFData IORefId
forall a. (a -> ()) -> NFData a
$crnf :: IORefId -> ()
rnf :: IORefId -> ()
NFData, (forall x. IORefId -> Rep IORefId x)
-> (forall x. Rep IORefId x -> IORefId) -> Generic IORefId
forall x. Rep IORefId x -> IORefId
forall x. IORefId -> Rep IORefId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IORefId -> Rep IORefId x
from :: forall x. IORefId -> Rep IORefId x
$cto :: forall x. Rep IORefId x -> IORefId
to :: forall x. Rep IORefId x -> IORefId
Generic)

instance Show IORefId where
  show :: IORefId -> String
show (IORefId Id
id_) = Id -> String
forall a. Show a => a -> String
show Id
id_

-- | Every @MVar@ has a unique identifier.
--
-- @since 1.0.0.0
newtype MVarId = MVarId Id
  deriving (MVarId -> MVarId -> Bool
(MVarId -> MVarId -> Bool)
-> (MVarId -> MVarId -> Bool) -> Eq MVarId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MVarId -> MVarId -> Bool
== :: MVarId -> MVarId -> Bool
$c/= :: MVarId -> MVarId -> Bool
/= :: MVarId -> MVarId -> Bool
Eq, Eq MVarId
Eq MVarId =>
(MVarId -> MVarId -> Ordering)
-> (MVarId -> MVarId -> Bool)
-> (MVarId -> MVarId -> Bool)
-> (MVarId -> MVarId -> Bool)
-> (MVarId -> MVarId -> Bool)
-> (MVarId -> MVarId -> MVarId)
-> (MVarId -> MVarId -> MVarId)
-> Ord MVarId
MVarId -> MVarId -> Bool
MVarId -> MVarId -> Ordering
MVarId -> MVarId -> MVarId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MVarId -> MVarId -> Ordering
compare :: MVarId -> MVarId -> Ordering
$c< :: MVarId -> MVarId -> Bool
< :: MVarId -> MVarId -> Bool
$c<= :: MVarId -> MVarId -> Bool
<= :: MVarId -> MVarId -> Bool
$c> :: MVarId -> MVarId -> Bool
> :: MVarId -> MVarId -> Bool
$c>= :: MVarId -> MVarId -> Bool
>= :: MVarId -> MVarId -> Bool
$cmax :: MVarId -> MVarId -> MVarId
max :: MVarId -> MVarId -> MVarId
$cmin :: MVarId -> MVarId -> MVarId
min :: MVarId -> MVarId -> MVarId
Ord, MVarId -> ()
(MVarId -> ()) -> NFData MVarId
forall a. (a -> ()) -> NFData a
$crnf :: MVarId -> ()
rnf :: MVarId -> ()
NFData)

instance Show MVarId where
  show :: MVarId -> String
show (MVarId Id
id_) = Id -> String
forall a. Show a => a -> String
show Id
id_

-- | @since 1.3.1.0
deriving instance Generic MVarId

-- | Every @TVar@ has a unique identifier.
--
-- @since 1.0.0.0
newtype TVarId = TVarId Id
  deriving (TVarId -> TVarId -> Bool
(TVarId -> TVarId -> Bool)
-> (TVarId -> TVarId -> Bool) -> Eq TVarId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TVarId -> TVarId -> Bool
== :: TVarId -> TVarId -> Bool
$c/= :: TVarId -> TVarId -> Bool
/= :: TVarId -> TVarId -> Bool
Eq, Eq TVarId
Eq TVarId =>
(TVarId -> TVarId -> Ordering)
-> (TVarId -> TVarId -> Bool)
-> (TVarId -> TVarId -> Bool)
-> (TVarId -> TVarId -> Bool)
-> (TVarId -> TVarId -> Bool)
-> (TVarId -> TVarId -> TVarId)
-> (TVarId -> TVarId -> TVarId)
-> Ord TVarId
TVarId -> TVarId -> Bool
TVarId -> TVarId -> Ordering
TVarId -> TVarId -> TVarId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TVarId -> TVarId -> Ordering
compare :: TVarId -> TVarId -> Ordering
$c< :: TVarId -> TVarId -> Bool
< :: TVarId -> TVarId -> Bool
$c<= :: TVarId -> TVarId -> Bool
<= :: TVarId -> TVarId -> Bool
$c> :: TVarId -> TVarId -> Bool
> :: TVarId -> TVarId -> Bool
$c>= :: TVarId -> TVarId -> Bool
>= :: TVarId -> TVarId -> Bool
$cmax :: TVarId -> TVarId -> TVarId
max :: TVarId -> TVarId -> TVarId
$cmin :: TVarId -> TVarId -> TVarId
min :: TVarId -> TVarId -> TVarId
Ord, TVarId -> ()
(TVarId -> ()) -> NFData TVarId
forall a. (a -> ()) -> NFData a
$crnf :: TVarId -> ()
rnf :: TVarId -> ()
NFData)

instance Show TVarId where
  show :: TVarId -> String
show (TVarId Id
id_) = Id -> String
forall a. Show a => a -> String
show Id
id_

-- | @since 1.3.1.0
deriving instance Generic TVarId

-- | An identifier for a thread, @MVar@, @IORef@, or @TVar@.
--
-- The number is the important bit.  The string is to make execution
-- traces easier to read, but is meaningless.
--
-- @since 1.0.0.0
data Id = Id (Maybe String) {-# UNPACK #-} !Int

instance Eq Id where
  (Id Maybe String
_ Int
i) == :: Id -> Id -> Bool
== (Id Maybe String
_ Int
j) = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j

instance Ord Id where
  compare :: Id -> Id -> Ordering
compare (Id Maybe String
_ Int
i) (Id Maybe String
_ Int
j) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j

instance Show Id where
  show :: Id -> String
show (Id (Just String
n) Int
_) = String
n
  show (Id Maybe String
_ Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i

-- | @since 1.3.1.0
deriving instance Generic Id

instance NFData Id

-- | The ID of the initial thread.
--
-- @since 0.4.0.0
initialThread :: ThreadId
initialThread :: ThreadId
initialThread = Id -> ThreadId
ThreadId (Maybe String -> Int -> Id
Id (String -> Maybe String
forall a. a -> Maybe a
Just String
"main") Int
0)

-------------------------------------------------------------------------------
-- * Actions

-- | All the actions that a thread can perform.
--
-- @since 2.2.0.0
data ThreadAction =
    Fork ThreadId
  -- ^ Start a new thread.
  | ForkOS ThreadId
  -- ^ Start a new bound thread.
  | SupportsBoundThreads Bool
  -- ^ Check if bound threads are supported.
  | IsCurrentThreadBound Bool
  -- ^ Check if the current thread is bound.
  | MyThreadId
  -- ^ Get the 'ThreadId' of the current thread.
  | GetNumCapabilities Int
  -- ^ Get the number of Haskell threads that can run simultaneously.
  | SetNumCapabilities Int
  -- ^ Set the number of Haskell threads that can run simultaneously.
  | Yield
  -- ^ Yield the current thread.
  | ThreadDelay Int
  -- ^ Yield/delay the current thread.
  | NewMVar MVarId
  -- ^ Create a new 'MVar'.
  | PutMVar MVarId [ThreadId]
  -- ^ Put into a 'MVar', possibly waking up some threads.
  | BlockedPutMVar MVarId
  -- ^ Get blocked on a put.
  | TryPutMVar MVarId Bool [ThreadId]
  -- ^ Try to put into a 'MVar', possibly waking up some threads.
  | ReadMVar MVarId
  -- ^ Read from a 'MVar'.
  | TryReadMVar MVarId Bool
  -- ^ Try to read from a 'MVar'.
  | BlockedReadMVar MVarId
  -- ^ Get blocked on a read.
  | TakeMVar MVarId [ThreadId]
  -- ^ Take from a 'MVar', possibly waking up some threads.
  | BlockedTakeMVar MVarId
  -- ^ Get blocked on a take.
  | TryTakeMVar MVarId Bool [ThreadId]
  -- ^ Try to take from a 'MVar', possibly waking up some threads.
  | NewIORef IORefId
  -- ^ Create a new 'IORef'.
  | ReadIORef IORefId
  -- ^ Read from a 'IORef'.
  | ReadIORefCas IORefId
  -- ^ Read from a 'IORef' for a future compare-and-swap.
  | ModIORef IORefId
  -- ^ Modify a 'IORef'.
  | ModIORefCas IORefId
  -- ^ Modify a 'IORef' using a compare-and-swap.
  | WriteIORef IORefId
  -- ^ Write to a 'IORef' without synchronising.
  | CasIORef IORefId Bool
  -- ^ Attempt to to a 'IORef' using a compare-and-swap, synchronising
  -- it.
  | CommitIORef ThreadId IORefId
  -- ^ Commit the last write to the given 'IORef' by the given thread,
  -- so that all threads can see the updated value.
  | STM [TAction] [ThreadId]
  -- ^ An STM transaction was executed, possibly waking up some
  -- threads.
  | ThrownSTM [TAction] (Maybe MaskingState)
  -- ^ An STM transaction threw an exception.  Give the resultant
  -- masking state after jumping to the exception handler (if the
  -- thread is still alive).
  | BlockedSTM [TAction]
  -- ^ Got blocked in an STM transaction.
  | Catching
  -- ^ Register a new exception handler
  | PopCatching
  -- ^ Pop the innermost exception handler from the stack.
  | Throw (Maybe MaskingState)
  -- ^ Throw an exception, and give the resultant masking state after
  -- jumping to the exception handler (if the thread is still alive).
  | ThrowTo ThreadId (Maybe MaskingState)
  -- ^ Throw an exception to a thread, and give the resultant masking
  -- state after jumping to the exception handler (if the thread is
  -- still alive).
  | BlockedThrowTo ThreadId
  -- ^ Get blocked on a 'throwTo'.
  | SetMasking Bool MaskingState
  -- ^ Set the masking state. If 'True', this is being used to set the
  -- masking state to the original state in the argument passed to a
  -- 'mask'ed function.
  | ResetMasking Bool MaskingState
  -- ^ Return to an earlier masking state.  If 'True', this is being
  -- used to return to the state of the masked block in the argument
  -- passed to a 'mask'ed function.
  | GetMaskingState MaskingState
  -- ^ Get the current masking state.
  | LiftIO
  -- ^ Lift an IO action. Note that this can only happen with
  -- 'ConcIO'.
  | Return
  -- ^ A 'return' or 'pure' action was executed.
  | Stop
  -- ^ Cease execution and terminate.
  | RegisterInvariant
  -- ^ Register an invariant.
  deriving (ThreadAction -> ThreadAction -> Bool
(ThreadAction -> ThreadAction -> Bool)
-> (ThreadAction -> ThreadAction -> Bool) -> Eq ThreadAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ThreadAction -> ThreadAction -> Bool
== :: ThreadAction -> ThreadAction -> Bool
$c/= :: ThreadAction -> ThreadAction -> Bool
/= :: ThreadAction -> ThreadAction -> Bool
Eq, (forall x. ThreadAction -> Rep ThreadAction x)
-> (forall x. Rep ThreadAction x -> ThreadAction)
-> Generic ThreadAction
forall x. Rep ThreadAction x -> ThreadAction
forall x. ThreadAction -> Rep ThreadAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ThreadAction -> Rep ThreadAction x
from :: forall x. ThreadAction -> Rep ThreadAction x
$cto :: forall x. Rep ThreadAction x -> ThreadAction
to :: forall x. Rep ThreadAction x -> ThreadAction
Generic, Int -> ThreadAction -> ShowS
[ThreadAction] -> ShowS
ThreadAction -> String
(Int -> ThreadAction -> ShowS)
-> (ThreadAction -> String)
-> ([ThreadAction] -> ShowS)
-> Show ThreadAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ThreadAction -> ShowS
showsPrec :: Int -> ThreadAction -> ShowS
$cshow :: ThreadAction -> String
show :: ThreadAction -> String
$cshowList :: [ThreadAction] -> ShowS
showList :: [ThreadAction] -> ShowS
Show)

-- this makes me sad
instance NFData ThreadAction where
  rnf :: ThreadAction -> ()
rnf (Fork ThreadId
t) = ThreadId -> ()
forall a. NFData a => a -> ()
rnf ThreadId
t
  rnf (ForkOS ThreadId
t) = ThreadId -> ()
forall a. NFData a => a -> ()
rnf ThreadId
t
  rnf (SupportsBoundThreads Bool
b) = Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
b
  rnf (IsCurrentThreadBound Bool
b) = Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
b
  rnf ThreadAction
MyThreadId = ()
  rnf (GetNumCapabilities Int
i) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
i
  rnf (SetNumCapabilities Int
i) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
i
  rnf ThreadAction
Yield = ()
  rnf (ThreadDelay Int
i) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
i
  rnf (NewMVar MVarId
m) = MVarId -> ()
forall a. NFData a => a -> ()
rnf MVarId
m
  rnf (PutMVar MVarId
m [ThreadId]
ts) = (MVarId, [ThreadId]) -> ()
forall a. NFData a => a -> ()
rnf (MVarId
m, [ThreadId]
ts)
  rnf (BlockedPutMVar MVarId
m) = MVarId -> ()
forall a. NFData a => a -> ()
rnf MVarId
m
  rnf (TryPutMVar MVarId
m Bool
b [ThreadId]
ts) = (MVarId, Bool, [ThreadId]) -> ()
forall a. NFData a => a -> ()
rnf (MVarId
m, Bool
b, [ThreadId]
ts)
  rnf (ReadMVar MVarId
m) = MVarId -> ()
forall a. NFData a => a -> ()
rnf MVarId
m
  rnf (TryReadMVar MVarId
m Bool
b) = (MVarId, Bool) -> ()
forall a. NFData a => a -> ()
rnf (MVarId
m, Bool
b)
  rnf (BlockedReadMVar MVarId
m) = MVarId -> ()
forall a. NFData a => a -> ()
rnf MVarId
m
  rnf (TakeMVar MVarId
m [ThreadId]
ts) = (MVarId, [ThreadId]) -> ()
forall a. NFData a => a -> ()
rnf (MVarId
m, [ThreadId]
ts)
  rnf (BlockedTakeMVar MVarId
m) = MVarId -> ()
forall a. NFData a => a -> ()
rnf MVarId
m
  rnf (TryTakeMVar MVarId
m Bool
b [ThreadId]
ts) = (MVarId, Bool, [ThreadId]) -> ()
forall a. NFData a => a -> ()
rnf (MVarId
m, Bool
b, [ThreadId]
ts)
  rnf (NewIORef IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (ReadIORef IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (ReadIORefCas IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (ModIORef IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (ModIORefCas IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (WriteIORef IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (CasIORef IORefId
c Bool
b) = (IORefId, Bool) -> ()
forall a. NFData a => a -> ()
rnf (IORefId
c, Bool
b)
  rnf (CommitIORef ThreadId
t IORefId
c) = (ThreadId, IORefId) -> ()
forall a. NFData a => a -> ()
rnf (ThreadId
t, IORefId
c)
  rnf (STM [TAction]
as [ThreadId]
ts) = ([TAction], [ThreadId]) -> ()
forall a. NFData a => a -> ()
rnf ([TAction]
as, [ThreadId]
ts)
  rnf (ThrownSTM [TAction]
as (Just MaskingState
m)) = MaskingState
m MaskingState -> () -> ()
forall a b. a -> b -> b
`seq` [TAction] -> ()
forall a. NFData a => a -> ()
rnf [TAction]
as
  rnf (ThrownSTM [TAction]
as Maybe MaskingState
Nothing) = [TAction] -> ()
forall a. NFData a => a -> ()
rnf [TAction]
as
  rnf (BlockedSTM [TAction]
as) = [TAction] -> ()
forall a. NFData a => a -> ()
rnf [TAction]
as
  rnf ThreadAction
Catching = ()
  rnf ThreadAction
PopCatching = ()
  rnf (Throw (Just MaskingState
m)) = MaskingState
m MaskingState -> () -> ()
forall a b. a -> b -> b
`seq` ()
  rnf (Throw Maybe MaskingState
Nothing) = ()
  rnf (ThrowTo ThreadId
t (Just MaskingState
m)) = MaskingState
m MaskingState -> () -> ()
forall a b. a -> b -> b
`seq` ThreadId -> ()
forall a. NFData a => a -> ()
rnf ThreadId
t
  rnf (ThrowTo ThreadId
t Maybe MaskingState
Nothing) = ThreadId -> ()
forall a. NFData a => a -> ()
rnf ThreadId
t
  rnf (BlockedThrowTo ThreadId
t) = ThreadId -> ()
forall a. NFData a => a -> ()
rnf ThreadId
t
  rnf (SetMasking Bool
b MaskingState
m) = (Bool, String) -> ()
forall a. NFData a => a -> ()
rnf (Bool
b, MaskingState -> String
forall a. Show a => a -> String
show MaskingState
m)
  rnf (ResetMasking Bool
b MaskingState
m) = (Bool, String) -> ()
forall a. NFData a => a -> ()
rnf (Bool
b, MaskingState -> String
forall a. Show a => a -> String
show MaskingState
m)
  -- deepseq<1.4.4.0 doesn't have an instance for MaskingState
  rnf (GetMaskingState MaskingState
m) = MaskingState
m MaskingState -> () -> ()
forall a b. a -> b -> b
`seq` ()
  rnf ThreadAction
LiftIO = ()
  rnf ThreadAction
Return = ()
  rnf ThreadAction
Stop = ()
  rnf ThreadAction
RegisterInvariant = ()

-- | A one-step look-ahead at what a thread will do next.
--
-- @since 2.2.0.0
data Lookahead =
    WillFork
  -- ^ Will start a new thread.
  | WillForkOS
  -- ^ Will start a new bound thread.
  | WillSupportsBoundThreads
  -- ^ Will check if bound threads are supported.
  | WillIsCurrentThreadBound
  -- ^ Will check if the current thread is bound.
  | WillMyThreadId
  -- ^ Will get the 'ThreadId'.
  | WillGetNumCapabilities
  -- ^ Will get the number of Haskell threads that can run
  -- simultaneously.
  | WillSetNumCapabilities Int
  -- ^ Will set the number of Haskell threads that can run
  -- simultaneously.
  | WillYield
  -- ^ Will yield the current thread.
  | WillThreadDelay Int
  -- ^ Will yield/delay the current thread.
  | WillNewMVar
  -- ^ Will create a new 'MVar'.
  | WillPutMVar MVarId
  -- ^ Will put into a 'MVar', possibly waking up some threads.
  | WillTryPutMVar MVarId
  -- ^ Will try to put into a 'MVar', possibly waking up some threads.
  | WillReadMVar MVarId
  -- ^ Will read from a 'MVar'.
  | WillTryReadMVar MVarId
  -- ^ Will try to read from a 'MVar'.
  | WillTakeMVar MVarId
  -- ^ Will take from a 'MVar', possibly waking up some threads.
  | WillTryTakeMVar MVarId
  -- ^ Will try to take from a 'MVar', possibly waking up some threads.
  | WillNewIORef
  -- ^ Will create a new 'IORef'.
  | WillReadIORef IORefId
  -- ^ Will read from a 'IORef'.
  | WillReadIORefCas IORefId
  -- ^ Will read from a 'IORef' for a future compare-and-swap.
  | WillModIORef IORefId
  -- ^ Will modify a 'IORef'.
  | WillModIORefCas IORefId
  -- ^ Will modify a 'IORef' using a compare-and-swap.
  | WillWriteIORef IORefId
  -- ^ Will write to a 'IORef' without synchronising.
  | WillCasIORef IORefId
  -- ^ Will attempt to to a 'IORef' using a compare-and-swap,
  -- synchronising it.
  | WillCommitIORef ThreadId IORefId
  -- ^ Will commit the last write by the given thread to the 'IORef'.
  | WillSTM
  -- ^ Will execute an STM transaction, possibly waking up some
  -- threads.
  | WillCatching
  -- ^ Will register a new exception handler
  | WillPopCatching
  -- ^ Will pop the innermost exception handler from the stack.
  | WillThrow
  -- ^ Will throw an exception.
  | WillThrowTo ThreadId
  -- ^ Will throw an exception to a thread.
  | WillSetMasking Bool MaskingState
  -- ^ Will set the masking state. If 'True', this is being used to
  -- set the masking state to the original state in the argument
  -- passed to a 'mask'ed function.
  | WillResetMasking Bool MaskingState
  -- ^ Will return to an earlier masking state.  If 'True', this is
  -- being used to return to the state of the masked block in the
  -- argument passed to a 'mask'ed function.
  | WillGetMaskingState
  -- ^ Will get the masking state.
  | WillLiftIO
  -- ^ Will lift an IO action. Note that this can only happen with
  -- 'ConcIO'.
  | WillReturn
  -- ^ Will execute a 'return' or 'pure' action.
  | WillStop
  -- ^ Will cease execution and terminate.
  | WillRegisterInvariant
  -- ^ Will register an invariant
  deriving (Lookahead -> Lookahead -> Bool
(Lookahead -> Lookahead -> Bool)
-> (Lookahead -> Lookahead -> Bool) -> Eq Lookahead
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lookahead -> Lookahead -> Bool
== :: Lookahead -> Lookahead -> Bool
$c/= :: Lookahead -> Lookahead -> Bool
/= :: Lookahead -> Lookahead -> Bool
Eq, (forall x. Lookahead -> Rep Lookahead x)
-> (forall x. Rep Lookahead x -> Lookahead) -> Generic Lookahead
forall x. Rep Lookahead x -> Lookahead
forall x. Lookahead -> Rep Lookahead x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Lookahead -> Rep Lookahead x
from :: forall x. Lookahead -> Rep Lookahead x
$cto :: forall x. Rep Lookahead x -> Lookahead
to :: forall x. Rep Lookahead x -> Lookahead
Generic, Int -> Lookahead -> ShowS
[Lookahead] -> ShowS
Lookahead -> String
(Int -> Lookahead -> ShowS)
-> (Lookahead -> String)
-> ([Lookahead] -> ShowS)
-> Show Lookahead
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lookahead -> ShowS
showsPrec :: Int -> Lookahead -> ShowS
$cshow :: Lookahead -> String
show :: Lookahead -> String
$cshowList :: [Lookahead] -> ShowS
showList :: [Lookahead] -> ShowS
Show)

-- this also makes me sad
instance NFData Lookahead where
  rnf :: Lookahead -> ()
rnf Lookahead
WillFork = ()
  rnf Lookahead
WillForkOS = ()
  rnf Lookahead
WillSupportsBoundThreads = ()
  rnf Lookahead
WillIsCurrentThreadBound = ()
  rnf Lookahead
WillMyThreadId = ()
  rnf Lookahead
WillGetNumCapabilities = ()
  rnf (WillSetNumCapabilities Int
i) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
i
  rnf Lookahead
WillYield = ()
  rnf (WillThreadDelay Int
i) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
i
  rnf Lookahead
WillNewMVar = ()
  rnf (WillPutMVar MVarId
m) = MVarId -> ()
forall a. NFData a => a -> ()
rnf MVarId
m
  rnf (WillTryPutMVar MVarId
m) = MVarId -> ()
forall a. NFData a => a -> ()
rnf MVarId
m
  rnf (WillReadMVar MVarId
m) = MVarId -> ()
forall a. NFData a => a -> ()
rnf MVarId
m
  rnf (WillTryReadMVar MVarId
m) = MVarId -> ()
forall a. NFData a => a -> ()
rnf MVarId
m
  rnf (WillTakeMVar MVarId
m) = MVarId -> ()
forall a. NFData a => a -> ()
rnf MVarId
m
  rnf (WillTryTakeMVar MVarId
m) = MVarId -> ()
forall a. NFData a => a -> ()
rnf MVarId
m
  rnf Lookahead
WillNewIORef = ()
  rnf (WillReadIORef IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (WillReadIORefCas IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (WillModIORef IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (WillModIORefCas IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (WillWriteIORef IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (WillCasIORef IORefId
c) = IORefId -> ()
forall a. NFData a => a -> ()
rnf IORefId
c
  rnf (WillCommitIORef ThreadId
t IORefId
c) = (ThreadId, IORefId) -> ()
forall a. NFData a => a -> ()
rnf (ThreadId
t, IORefId
c)
  rnf Lookahead
WillSTM = ()
  rnf Lookahead
WillCatching = ()
  rnf Lookahead
WillPopCatching = ()
  rnf Lookahead
WillThrow = ()
  rnf (WillThrowTo ThreadId
t) = ThreadId -> ()
forall a. NFData a => a -> ()
rnf ThreadId
t
  rnf (WillSetMasking Bool
b MaskingState
m) = (Bool, String) -> ()
forall a. NFData a => a -> ()
rnf (Bool
b, MaskingState -> String
forall a. Show a => a -> String
show MaskingState
m)
  rnf (WillResetMasking Bool
b MaskingState
m) = (Bool, String) -> ()
forall a. NFData a => a -> ()
rnf (Bool
b, MaskingState -> String
forall a. Show a => a -> String
show MaskingState
m)
  rnf Lookahead
WillGetMaskingState = ()
  rnf Lookahead
WillLiftIO = ()
  rnf Lookahead
WillReturn = ()
  rnf Lookahead
WillStop = ()
  rnf Lookahead
WillRegisterInvariant = ()

-- | All the actions that an STM transaction can perform.
--
-- @since 0.8.0.0
data TAction =
    TNew TVarId
  -- ^ Create a new @TVar@
  | TRead  TVarId
  -- ^ Read from a @TVar@.
  | TWrite TVarId
  -- ^ Write to a @TVar@.
  | TRetry
  -- ^ Abort and discard effects.
  | TOrElse [TAction] (Maybe [TAction])
  -- ^ Execute a transaction.  If the transaction aborts by calling
  -- @retry@, execute the other transaction.
  | TThrow
  -- ^ Throw an exception, abort, and discard effects.
  | TCatch [TAction] (Maybe [TAction])
  -- ^ Execute a transaction.  If the transaction aborts by throwing
  -- an exception of the appropriate type, it is handled and execution
  -- continues; otherwise aborts, propagating the exception upwards.
  | TStop
  -- ^ Terminate successfully and commit effects.
  deriving (TAction -> TAction -> Bool
(TAction -> TAction -> Bool)
-> (TAction -> TAction -> Bool) -> Eq TAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TAction -> TAction -> Bool
== :: TAction -> TAction -> Bool
$c/= :: TAction -> TAction -> Bool
/= :: TAction -> TAction -> Bool
Eq, Int -> TAction -> ShowS
[TAction] -> ShowS
TAction -> String
(Int -> TAction -> ShowS)
-> (TAction -> String) -> ([TAction] -> ShowS) -> Show TAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TAction -> ShowS
showsPrec :: Int -> TAction -> ShowS
$cshow :: TAction -> String
show :: TAction -> String
$cshowList :: [TAction] -> ShowS
showList :: [TAction] -> ShowS
Show)

-- | @since 1.3.1.0
deriving instance Generic TAction

-- | @since 0.5.1.0
instance NFData TAction

-------------------------------------------------------------------------------
-- * Traces

-- | One of the outputs of the runner is a @Trace@, which is a log of
-- decisions made, all the alternative unblocked threads and what they
-- would do, and the action a thread took in its step.
--
-- @since 0.8.0.0
type Trace
  = [(Decision, [(ThreadId, Lookahead)], ThreadAction)]

-- | Scheduling decisions are based on the state of the running
-- program, and so we can capture some of that state in recording what
-- specific decision we made.
--
-- @since 0.5.0.0
data Decision =
    Start ThreadId
  -- ^ Start a new thread, because the last was blocked (or it's the
  -- start of computation).
  | Continue
  -- ^ Continue running the last thread for another step.
  | SwitchTo ThreadId
  -- ^ Pre-empt the running thread, and switch to another.
  deriving (Decision -> Decision -> Bool
(Decision -> Decision -> Bool)
-> (Decision -> Decision -> Bool) -> Eq Decision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Decision -> Decision -> Bool
== :: Decision -> Decision -> Bool
$c/= :: Decision -> Decision -> Bool
/= :: Decision -> Decision -> Bool
Eq, Int -> Decision -> ShowS
[Decision] -> ShowS
Decision -> String
(Int -> Decision -> ShowS)
-> (Decision -> String) -> ([Decision] -> ShowS) -> Show Decision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Decision -> ShowS
showsPrec :: Int -> Decision -> ShowS
$cshow :: Decision -> String
show :: Decision -> String
$cshowList :: [Decision] -> ShowS
showList :: [Decision] -> ShowS
Show)

-- | @since 1.3.1.0
deriving instance Generic Decision

-- | @since 0.5.1.0
instance NFData Decision

-------------------------------------------------------------------------------
-- * Conditions

-- | An indication of how a concurrent computation terminated, if it
-- didn't produce a value.
--
-- The @Eq@, @Ord@, and @NFData@ instances compare/evaluate the
-- exception with @show@ in the @UncaughtException@ and
-- @InvariantFailure@ cases.
--
-- @since 2.0.0.0
data Condition
  = Abort
  -- ^ The scheduler chose to abort execution. This will be produced
  -- if, for example, all possible decisions exceed the specified
  -- bounds (there have been too many pre-emptions, the computation
  -- has executed for too long, or there have been too many yields).
  | Deadlock
  -- ^ Every thread is blocked
  | UncaughtException SomeException
  -- ^ An uncaught exception bubbled to the top of the computation.
  | InvariantFailure SomeException
  -- ^ An uncaught exception caused an invariant to fail.
  deriving (Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
(Int -> Condition -> ShowS)
-> (Condition -> String)
-> ([Condition] -> ShowS)
-> Show Condition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Condition -> ShowS
showsPrec :: Int -> Condition -> ShowS
$cshow :: Condition -> String
show :: Condition -> String
$cshowList :: [Condition] -> ShowS
showList :: [Condition] -> ShowS
Show, (forall x. Condition -> Rep Condition x)
-> (forall x. Rep Condition x -> Condition) -> Generic Condition
forall x. Rep Condition x -> Condition
forall x. Condition -> Rep Condition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Condition -> Rep Condition x
from :: forall x. Condition -> Rep Condition x
$cto :: forall x. Rep Condition x -> Condition
to :: forall x. Rep Condition x -> Condition
Generic)

instance Eq Condition where
  Condition
Abort                  == :: Condition -> Condition -> Bool
== Condition
Abort                  = Bool
True
  Condition
Deadlock               == Condition
Deadlock               = Bool
True
  (UncaughtException SomeException
e1) == (UncaughtException SomeException
e2) = SomeException -> String
forall a. Show a => a -> String
show SomeException
e1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== SomeException -> String
forall a. Show a => a -> String
show SomeException
e2
  (InvariantFailure  SomeException
e1) == (InvariantFailure  SomeException
e2) = SomeException -> String
forall a. Show a => a -> String
show SomeException
e1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== SomeException -> String
forall a. Show a => a -> String
show SomeException
e2
  Condition
_ == Condition
_ = Bool
False

instance Ord Condition where
  compare :: Condition -> Condition -> Ordering
compare = (Int, Maybe String) -> (Int, Maybe String) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int, Maybe String) -> (Int, Maybe String) -> Ordering)
-> (Condition -> (Int, Maybe String))
-> Condition
-> Condition
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Condition -> (Int, Maybe String)
transform where
    transform :: Condition -> (Int, Maybe String)
    transform :: Condition -> (Int, Maybe String)
transform Condition
Abort = (Int
1, Maybe String
forall a. Maybe a
Nothing)
    transform Condition
Deadlock = (Int
2, Maybe String
forall a. Maybe a
Nothing)
    transform (UncaughtException SomeException
e) = (Int
3, String -> Maybe String
forall a. a -> Maybe a
Just (SomeException -> String
forall a. Show a => a -> String
show SomeException
e))
    transform (InvariantFailure  SomeException
e) = (Int
4, String -> Maybe String
forall a. a -> Maybe a
Just (SomeException -> String
forall a. Show a => a -> String
show SomeException
e))

instance NFData Condition where
  rnf :: Condition -> ()
rnf (UncaughtException SomeException
e) = String -> ()
forall a. NFData a => a -> ()
rnf (SomeException -> String
forall a. Show a => a -> String
show SomeException
e)
  rnf (InvariantFailure  SomeException
e) = String -> ()
forall a. NFData a => a -> ()
rnf (SomeException -> String
forall a. Show a => a -> String
show SomeException
e)
  rnf Condition
f = Condition
f Condition -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | Check if a condition is an @Abort@.
--
-- @since 0.9.0.0
isAbort :: Condition -> Bool
isAbort :: Condition -> Bool
isAbort Condition
Abort = Bool
True
isAbort Condition
_ = Bool
False

-- | Check if a condition is a @Deadlock@.
--
-- @since 0.9.0.0
isDeadlock :: Condition -> Bool
isDeadlock :: Condition -> Bool
isDeadlock Condition
Deadlock = Bool
True
isDeadlock Condition
_ = Bool
False

-- | Check if a condition is an @UncaughtException@
--
-- @since 0.9.0.0
isUncaughtException :: Condition -> Bool
isUncaughtException :: Condition -> Bool
isUncaughtException (UncaughtException SomeException
_) = Bool
True
isUncaughtException Condition
_ = Bool
False

-- | Check if a condition is an @InvariantFailure@
--
-- @since 2.0.0.0
isInvariantFailure :: Condition -> Bool
isInvariantFailure :: Condition -> Bool
isInvariantFailure (InvariantFailure SomeException
_) = Bool
True
isInvariantFailure Condition
_ = Bool
False

-------------------------------------------------------------------------------
-- * Errors

-- | An indication that there is a bug in dejafu or you are using it
-- incorrectly.
--
-- @since 2.0.0.0
data Error
  = ScheduledBlockedThread
  -- ^ Raised as an exception if the scheduler attempts to schedule a
  -- blocked thread.
  | ScheduledMissingThread
  -- ^ Raised as an exception if the scheduler attempts to schedule a
  -- nonexistent thread.
  deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq, Eq Error
Eq Error =>
(Error -> Error -> Ordering)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Error)
-> (Error -> Error -> Error)
-> Ord Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Error -> Error -> Ordering
compare :: Error -> Error -> Ordering
$c< :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
>= :: Error -> Error -> Bool
$cmax :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
min :: Error -> Error -> Error
Ord, Error
Error -> Error -> Bounded Error
forall a. a -> a -> Bounded a
$cminBound :: Error
minBound :: Error
$cmaxBound :: Error
maxBound :: Error
Bounded, Int -> Error
Error -> Int
Error -> [Error]
Error -> Error
Error -> Error -> [Error]
Error -> Error -> Error -> [Error]
(Error -> Error)
-> (Error -> Error)
-> (Int -> Error)
-> (Error -> Int)
-> (Error -> [Error])
-> (Error -> Error -> [Error])
-> (Error -> Error -> [Error])
-> (Error -> Error -> Error -> [Error])
-> Enum Error
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Error -> Error
succ :: Error -> Error
$cpred :: Error -> Error
pred :: Error -> Error
$ctoEnum :: Int -> Error
toEnum :: Int -> Error
$cfromEnum :: Error -> Int
fromEnum :: Error -> Int
$cenumFrom :: Error -> [Error]
enumFrom :: Error -> [Error]
$cenumFromThen :: Error -> Error -> [Error]
enumFromThen :: Error -> Error -> [Error]
$cenumFromTo :: Error -> Error -> [Error]
enumFromTo :: Error -> Error -> [Error]
$cenumFromThenTo :: Error -> Error -> Error -> [Error]
enumFromThenTo :: Error -> Error -> Error -> [Error]
Enum, (forall x. Error -> Rep Error x)
-> (forall x. Rep Error x -> Error) -> Generic Error
forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Error -> Rep Error x
from :: forall x. Error -> Rep Error x
$cto :: forall x. Rep Error x -> Error
to :: forall x. Rep Error x -> Error
Generic)

instance Exception Error

-- | Check if an error is a scheduler error.
--
-- @since 1.12.0.0
isSchedulerError :: Error -> Bool
isSchedulerError :: Error -> Bool
isSchedulerError Error
_ = Bool
True

-------------------------------------------------------------------------------
-- * Schedule bounding

-- | @since 2.0.0.0
data Bounds = Bounds
  { Bounds -> Maybe PreemptionBound
boundPreemp :: Maybe PreemptionBound
  , Bounds -> Maybe FairBound
boundFair   :: Maybe FairBound
  } deriving (Bounds -> Bounds -> Bool
(Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool) -> Eq Bounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bounds -> Bounds -> Bool
== :: Bounds -> Bounds -> Bool
$c/= :: Bounds -> Bounds -> Bool
/= :: Bounds -> Bounds -> Bool
Eq, Eq Bounds
Eq Bounds =>
(Bounds -> Bounds -> Ordering)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bounds)
-> (Bounds -> Bounds -> Bounds)
-> Ord Bounds
Bounds -> Bounds -> Bool
Bounds -> Bounds -> Ordering
Bounds -> Bounds -> Bounds
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Bounds -> Bounds -> Ordering
compare :: Bounds -> Bounds -> Ordering
$c< :: Bounds -> Bounds -> Bool
< :: Bounds -> Bounds -> Bool
$c<= :: Bounds -> Bounds -> Bool
<= :: Bounds -> Bounds -> Bool
$c> :: Bounds -> Bounds -> Bool
> :: Bounds -> Bounds -> Bool
$c>= :: Bounds -> Bounds -> Bool
>= :: Bounds -> Bounds -> Bool
$cmax :: Bounds -> Bounds -> Bounds
max :: Bounds -> Bounds -> Bounds
$cmin :: Bounds -> Bounds -> Bounds
min :: Bounds -> Bounds -> Bounds
Ord, ReadPrec [Bounds]
ReadPrec Bounds
Int -> ReadS Bounds
ReadS [Bounds]
(Int -> ReadS Bounds)
-> ReadS [Bounds]
-> ReadPrec Bounds
-> ReadPrec [Bounds]
-> Read Bounds
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Bounds
readsPrec :: Int -> ReadS Bounds
$creadList :: ReadS [Bounds]
readList :: ReadS [Bounds]
$creadPrec :: ReadPrec Bounds
readPrec :: ReadPrec Bounds
$creadListPrec :: ReadPrec [Bounds]
readListPrec :: ReadPrec [Bounds]
Read, Int -> Bounds -> ShowS
[Bounds] -> ShowS
Bounds -> String
(Int -> Bounds -> ShowS)
-> (Bounds -> String) -> ([Bounds] -> ShowS) -> Show Bounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bounds -> ShowS
showsPrec :: Int -> Bounds -> ShowS
$cshow :: Bounds -> String
show :: Bounds -> String
$cshowList :: [Bounds] -> ShowS
showList :: [Bounds] -> ShowS
Show, (forall x. Bounds -> Rep Bounds x)
-> (forall x. Rep Bounds x -> Bounds) -> Generic Bounds
forall x. Rep Bounds x -> Bounds
forall x. Bounds -> Rep Bounds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bounds -> Rep Bounds x
from :: forall x. Bounds -> Rep Bounds x
$cto :: forall x. Rep Bounds x -> Bounds
to :: forall x. Rep Bounds x -> Bounds
Generic)

instance NFData Bounds

-- | Restrict the number of pre-emptive context switches allowed in an
-- execution.
--
-- A pre-emption bound of zero disables pre-emptions entirely.
--
-- @since 0.2.0.0
newtype PreemptionBound = PreemptionBound Int
  deriving (Int -> PreemptionBound
PreemptionBound -> Int
PreemptionBound -> [PreemptionBound]
PreemptionBound -> PreemptionBound
PreemptionBound -> PreemptionBound -> [PreemptionBound]
PreemptionBound
-> PreemptionBound -> PreemptionBound -> [PreemptionBound]
(PreemptionBound -> PreemptionBound)
-> (PreemptionBound -> PreemptionBound)
-> (Int -> PreemptionBound)
-> (PreemptionBound -> Int)
-> (PreemptionBound -> [PreemptionBound])
-> (PreemptionBound -> PreemptionBound -> [PreemptionBound])
-> (PreemptionBound -> PreemptionBound -> [PreemptionBound])
-> (PreemptionBound
    -> PreemptionBound -> PreemptionBound -> [PreemptionBound])
-> Enum PreemptionBound
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PreemptionBound -> PreemptionBound
succ :: PreemptionBound -> PreemptionBound
$cpred :: PreemptionBound -> PreemptionBound
pred :: PreemptionBound -> PreemptionBound
$ctoEnum :: Int -> PreemptionBound
toEnum :: Int -> PreemptionBound
$cfromEnum :: PreemptionBound -> Int
fromEnum :: PreemptionBound -> Int
$cenumFrom :: PreemptionBound -> [PreemptionBound]
enumFrom :: PreemptionBound -> [PreemptionBound]
$cenumFromThen :: PreemptionBound -> PreemptionBound -> [PreemptionBound]
enumFromThen :: PreemptionBound -> PreemptionBound -> [PreemptionBound]
$cenumFromTo :: PreemptionBound -> PreemptionBound -> [PreemptionBound]
enumFromTo :: PreemptionBound -> PreemptionBound -> [PreemptionBound]
$cenumFromThenTo :: PreemptionBound
-> PreemptionBound -> PreemptionBound -> [PreemptionBound]
enumFromThenTo :: PreemptionBound
-> PreemptionBound -> PreemptionBound -> [PreemptionBound]
Enum, PreemptionBound -> PreemptionBound -> Bool
(PreemptionBound -> PreemptionBound -> Bool)
-> (PreemptionBound -> PreemptionBound -> Bool)
-> Eq PreemptionBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PreemptionBound -> PreemptionBound -> Bool
== :: PreemptionBound -> PreemptionBound -> Bool
$c/= :: PreemptionBound -> PreemptionBound -> Bool
/= :: PreemptionBound -> PreemptionBound -> Bool
Eq, Eq PreemptionBound
Eq PreemptionBound =>
(PreemptionBound -> PreemptionBound -> Ordering)
-> (PreemptionBound -> PreemptionBound -> Bool)
-> (PreemptionBound -> PreemptionBound -> Bool)
-> (PreemptionBound -> PreemptionBound -> Bool)
-> (PreemptionBound -> PreemptionBound -> Bool)
-> (PreemptionBound -> PreemptionBound -> PreemptionBound)
-> (PreemptionBound -> PreemptionBound -> PreemptionBound)
-> Ord PreemptionBound
PreemptionBound -> PreemptionBound -> Bool
PreemptionBound -> PreemptionBound -> Ordering
PreemptionBound -> PreemptionBound -> PreemptionBound
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PreemptionBound -> PreemptionBound -> Ordering
compare :: PreemptionBound -> PreemptionBound -> Ordering
$c< :: PreemptionBound -> PreemptionBound -> Bool
< :: PreemptionBound -> PreemptionBound -> Bool
$c<= :: PreemptionBound -> PreemptionBound -> Bool
<= :: PreemptionBound -> PreemptionBound -> Bool
$c> :: PreemptionBound -> PreemptionBound -> Bool
> :: PreemptionBound -> PreemptionBound -> Bool
$c>= :: PreemptionBound -> PreemptionBound -> Bool
>= :: PreemptionBound -> PreemptionBound -> Bool
$cmax :: PreemptionBound -> PreemptionBound -> PreemptionBound
max :: PreemptionBound -> PreemptionBound -> PreemptionBound
$cmin :: PreemptionBound -> PreemptionBound -> PreemptionBound
min :: PreemptionBound -> PreemptionBound -> PreemptionBound
Ord, Integer -> PreemptionBound
PreemptionBound -> PreemptionBound
PreemptionBound -> PreemptionBound -> PreemptionBound
(PreemptionBound -> PreemptionBound -> PreemptionBound)
-> (PreemptionBound -> PreemptionBound -> PreemptionBound)
-> (PreemptionBound -> PreemptionBound -> PreemptionBound)
-> (PreemptionBound -> PreemptionBound)
-> (PreemptionBound -> PreemptionBound)
-> (PreemptionBound -> PreemptionBound)
-> (Integer -> PreemptionBound)
-> Num PreemptionBound
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: PreemptionBound -> PreemptionBound -> PreemptionBound
+ :: PreemptionBound -> PreemptionBound -> PreemptionBound
$c- :: PreemptionBound -> PreemptionBound -> PreemptionBound
- :: PreemptionBound -> PreemptionBound -> PreemptionBound
$c* :: PreemptionBound -> PreemptionBound -> PreemptionBound
* :: PreemptionBound -> PreemptionBound -> PreemptionBound
$cnegate :: PreemptionBound -> PreemptionBound
negate :: PreemptionBound -> PreemptionBound
$cabs :: PreemptionBound -> PreemptionBound
abs :: PreemptionBound -> PreemptionBound
$csignum :: PreemptionBound -> PreemptionBound
signum :: PreemptionBound -> PreemptionBound
$cfromInteger :: Integer -> PreemptionBound
fromInteger :: Integer -> PreemptionBound
Num, Num PreemptionBound
Ord PreemptionBound
(Num PreemptionBound, Ord PreemptionBound) =>
(PreemptionBound -> Rational) -> Real PreemptionBound
PreemptionBound -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: PreemptionBound -> Rational
toRational :: PreemptionBound -> Rational
Real, Enum PreemptionBound
Real PreemptionBound
(Real PreemptionBound, Enum PreemptionBound) =>
(PreemptionBound -> PreemptionBound -> PreemptionBound)
-> (PreemptionBound -> PreemptionBound -> PreemptionBound)
-> (PreemptionBound -> PreemptionBound -> PreemptionBound)
-> (PreemptionBound -> PreemptionBound -> PreemptionBound)
-> (PreemptionBound
    -> PreemptionBound -> (PreemptionBound, PreemptionBound))
-> (PreemptionBound
    -> PreemptionBound -> (PreemptionBound, PreemptionBound))
-> (PreemptionBound -> Integer)
-> Integral PreemptionBound
PreemptionBound -> Integer
PreemptionBound
-> PreemptionBound -> (PreemptionBound, PreemptionBound)
PreemptionBound -> PreemptionBound -> PreemptionBound
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: PreemptionBound -> PreemptionBound -> PreemptionBound
quot :: PreemptionBound -> PreemptionBound -> PreemptionBound
$crem :: PreemptionBound -> PreemptionBound -> PreemptionBound
rem :: PreemptionBound -> PreemptionBound -> PreemptionBound
$cdiv :: PreemptionBound -> PreemptionBound -> PreemptionBound
div :: PreemptionBound -> PreemptionBound -> PreemptionBound
$cmod :: PreemptionBound -> PreemptionBound -> PreemptionBound
mod :: PreemptionBound -> PreemptionBound -> PreemptionBound
$cquotRem :: PreemptionBound
-> PreemptionBound -> (PreemptionBound, PreemptionBound)
quotRem :: PreemptionBound
-> PreemptionBound -> (PreemptionBound, PreemptionBound)
$cdivMod :: PreemptionBound
-> PreemptionBound -> (PreemptionBound, PreemptionBound)
divMod :: PreemptionBound
-> PreemptionBound -> (PreemptionBound, PreemptionBound)
$ctoInteger :: PreemptionBound -> Integer
toInteger :: PreemptionBound -> Integer
Integral, ReadPrec [PreemptionBound]
ReadPrec PreemptionBound
Int -> ReadS PreemptionBound
ReadS [PreemptionBound]
(Int -> ReadS PreemptionBound)
-> ReadS [PreemptionBound]
-> ReadPrec PreemptionBound
-> ReadPrec [PreemptionBound]
-> Read PreemptionBound
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PreemptionBound
readsPrec :: Int -> ReadS PreemptionBound
$creadList :: ReadS [PreemptionBound]
readList :: ReadS [PreemptionBound]
$creadPrec :: ReadPrec PreemptionBound
readPrec :: ReadPrec PreemptionBound
$creadListPrec :: ReadPrec [PreemptionBound]
readListPrec :: ReadPrec [PreemptionBound]
Read, Int -> PreemptionBound -> ShowS
[PreemptionBound] -> ShowS
PreemptionBound -> String
(Int -> PreemptionBound -> ShowS)
-> (PreemptionBound -> String)
-> ([PreemptionBound] -> ShowS)
-> Show PreemptionBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PreemptionBound -> ShowS
showsPrec :: Int -> PreemptionBound -> ShowS
$cshow :: PreemptionBound -> String
show :: PreemptionBound -> String
$cshowList :: [PreemptionBound] -> ShowS
showList :: [PreemptionBound] -> ShowS
Show)

-- | @since 1.3.1.0
deriving instance Generic PreemptionBound

-- | @since 0.5.1.0
instance NFData PreemptionBound

-- | Restrict the maximum difference between the number of yield or
-- delay operations different threads have performed.
--
-- A fair bound of zero disables yields and delays entirely.
--
-- @since 0.2.0.0
newtype FairBound = FairBound Int
  deriving (Int -> FairBound
FairBound -> Int
FairBound -> [FairBound]
FairBound -> FairBound
FairBound -> FairBound -> [FairBound]
FairBound -> FairBound -> FairBound -> [FairBound]
(FairBound -> FairBound)
-> (FairBound -> FairBound)
-> (Int -> FairBound)
-> (FairBound -> Int)
-> (FairBound -> [FairBound])
-> (FairBound -> FairBound -> [FairBound])
-> (FairBound -> FairBound -> [FairBound])
-> (FairBound -> FairBound -> FairBound -> [FairBound])
-> Enum FairBound
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: FairBound -> FairBound
succ :: FairBound -> FairBound
$cpred :: FairBound -> FairBound
pred :: FairBound -> FairBound
$ctoEnum :: Int -> FairBound
toEnum :: Int -> FairBound
$cfromEnum :: FairBound -> Int
fromEnum :: FairBound -> Int
$cenumFrom :: FairBound -> [FairBound]
enumFrom :: FairBound -> [FairBound]
$cenumFromThen :: FairBound -> FairBound -> [FairBound]
enumFromThen :: FairBound -> FairBound -> [FairBound]
$cenumFromTo :: FairBound -> FairBound -> [FairBound]
enumFromTo :: FairBound -> FairBound -> [FairBound]
$cenumFromThenTo :: FairBound -> FairBound -> FairBound -> [FairBound]
enumFromThenTo :: FairBound -> FairBound -> FairBound -> [FairBound]
Enum, FairBound -> FairBound -> Bool
(FairBound -> FairBound -> Bool)
-> (FairBound -> FairBound -> Bool) -> Eq FairBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FairBound -> FairBound -> Bool
== :: FairBound -> FairBound -> Bool
$c/= :: FairBound -> FairBound -> Bool
/= :: FairBound -> FairBound -> Bool
Eq, Eq FairBound
Eq FairBound =>
(FairBound -> FairBound -> Ordering)
-> (FairBound -> FairBound -> Bool)
-> (FairBound -> FairBound -> Bool)
-> (FairBound -> FairBound -> Bool)
-> (FairBound -> FairBound -> Bool)
-> (FairBound -> FairBound -> FairBound)
-> (FairBound -> FairBound -> FairBound)
-> Ord FairBound
FairBound -> FairBound -> Bool
FairBound -> FairBound -> Ordering
FairBound -> FairBound -> FairBound
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FairBound -> FairBound -> Ordering
compare :: FairBound -> FairBound -> Ordering
$c< :: FairBound -> FairBound -> Bool
< :: FairBound -> FairBound -> Bool
$c<= :: FairBound -> FairBound -> Bool
<= :: FairBound -> FairBound -> Bool
$c> :: FairBound -> FairBound -> Bool
> :: FairBound -> FairBound -> Bool
$c>= :: FairBound -> FairBound -> Bool
>= :: FairBound -> FairBound -> Bool
$cmax :: FairBound -> FairBound -> FairBound
max :: FairBound -> FairBound -> FairBound
$cmin :: FairBound -> FairBound -> FairBound
min :: FairBound -> FairBound -> FairBound
Ord, Integer -> FairBound
FairBound -> FairBound
FairBound -> FairBound -> FairBound
(FairBound -> FairBound -> FairBound)
-> (FairBound -> FairBound -> FairBound)
-> (FairBound -> FairBound -> FairBound)
-> (FairBound -> FairBound)
-> (FairBound -> FairBound)
-> (FairBound -> FairBound)
-> (Integer -> FairBound)
-> Num FairBound
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: FairBound -> FairBound -> FairBound
+ :: FairBound -> FairBound -> FairBound
$c- :: FairBound -> FairBound -> FairBound
- :: FairBound -> FairBound -> FairBound
$c* :: FairBound -> FairBound -> FairBound
* :: FairBound -> FairBound -> FairBound
$cnegate :: FairBound -> FairBound
negate :: FairBound -> FairBound
$cabs :: FairBound -> FairBound
abs :: FairBound -> FairBound
$csignum :: FairBound -> FairBound
signum :: FairBound -> FairBound
$cfromInteger :: Integer -> FairBound
fromInteger :: Integer -> FairBound
Num, Num FairBound
Ord FairBound
(Num FairBound, Ord FairBound) =>
(FairBound -> Rational) -> Real FairBound
FairBound -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: FairBound -> Rational
toRational :: FairBound -> Rational
Real, Enum FairBound
Real FairBound
(Real FairBound, Enum FairBound) =>
(FairBound -> FairBound -> FairBound)
-> (FairBound -> FairBound -> FairBound)
-> (FairBound -> FairBound -> FairBound)
-> (FairBound -> FairBound -> FairBound)
-> (FairBound -> FairBound -> (FairBound, FairBound))
-> (FairBound -> FairBound -> (FairBound, FairBound))
-> (FairBound -> Integer)
-> Integral FairBound
FairBound -> Integer
FairBound -> FairBound -> (FairBound, FairBound)
FairBound -> FairBound -> FairBound
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: FairBound -> FairBound -> FairBound
quot :: FairBound -> FairBound -> FairBound
$crem :: FairBound -> FairBound -> FairBound
rem :: FairBound -> FairBound -> FairBound
$cdiv :: FairBound -> FairBound -> FairBound
div :: FairBound -> FairBound -> FairBound
$cmod :: FairBound -> FairBound -> FairBound
mod :: FairBound -> FairBound -> FairBound
$cquotRem :: FairBound -> FairBound -> (FairBound, FairBound)
quotRem :: FairBound -> FairBound -> (FairBound, FairBound)
$cdivMod :: FairBound -> FairBound -> (FairBound, FairBound)
divMod :: FairBound -> FairBound -> (FairBound, FairBound)
$ctoInteger :: FairBound -> Integer
toInteger :: FairBound -> Integer
Integral, ReadPrec [FairBound]
ReadPrec FairBound
Int -> ReadS FairBound
ReadS [FairBound]
(Int -> ReadS FairBound)
-> ReadS [FairBound]
-> ReadPrec FairBound
-> ReadPrec [FairBound]
-> Read FairBound
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FairBound
readsPrec :: Int -> ReadS FairBound
$creadList :: ReadS [FairBound]
readList :: ReadS [FairBound]
$creadPrec :: ReadPrec FairBound
readPrec :: ReadPrec FairBound
$creadListPrec :: ReadPrec [FairBound]
readListPrec :: ReadPrec [FairBound]
Read, Int -> FairBound -> ShowS
[FairBound] -> ShowS
FairBound -> String
(Int -> FairBound -> ShowS)
-> (FairBound -> String)
-> ([FairBound] -> ShowS)
-> Show FairBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FairBound -> ShowS
showsPrec :: Int -> FairBound -> ShowS
$cshow :: FairBound -> String
show :: FairBound -> String
$cshowList :: [FairBound] -> ShowS
showList :: [FairBound] -> ShowS
Show)

-- | @since 1.3.1.0
deriving instance Generic FairBound

-- | @since 0.5.1.0
instance NFData FairBound

-- | Restrict the maximum length (in terms of primitive actions) of an
-- execution.
--
-- A length bound of zero immediately aborts the execution.
--
-- @since 0.2.0.0
newtype LengthBound = LengthBound Int
  deriving (Int -> LengthBound
LengthBound -> Int
LengthBound -> [LengthBound]
LengthBound -> LengthBound
LengthBound -> LengthBound -> [LengthBound]
LengthBound -> LengthBound -> LengthBound -> [LengthBound]
(LengthBound -> LengthBound)
-> (LengthBound -> LengthBound)
-> (Int -> LengthBound)
-> (LengthBound -> Int)
-> (LengthBound -> [LengthBound])
-> (LengthBound -> LengthBound -> [LengthBound])
-> (LengthBound -> LengthBound -> [LengthBound])
-> (LengthBound -> LengthBound -> LengthBound -> [LengthBound])
-> Enum LengthBound
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LengthBound -> LengthBound
succ :: LengthBound -> LengthBound
$cpred :: LengthBound -> LengthBound
pred :: LengthBound -> LengthBound
$ctoEnum :: Int -> LengthBound
toEnum :: Int -> LengthBound
$cfromEnum :: LengthBound -> Int
fromEnum :: LengthBound -> Int
$cenumFrom :: LengthBound -> [LengthBound]
enumFrom :: LengthBound -> [LengthBound]
$cenumFromThen :: LengthBound -> LengthBound -> [LengthBound]
enumFromThen :: LengthBound -> LengthBound -> [LengthBound]
$cenumFromTo :: LengthBound -> LengthBound -> [LengthBound]
enumFromTo :: LengthBound -> LengthBound -> [LengthBound]
$cenumFromThenTo :: LengthBound -> LengthBound -> LengthBound -> [LengthBound]
enumFromThenTo :: LengthBound -> LengthBound -> LengthBound -> [LengthBound]
Enum, LengthBound -> LengthBound -> Bool
(LengthBound -> LengthBound -> Bool)
-> (LengthBound -> LengthBound -> Bool) -> Eq LengthBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LengthBound -> LengthBound -> Bool
== :: LengthBound -> LengthBound -> Bool
$c/= :: LengthBound -> LengthBound -> Bool
/= :: LengthBound -> LengthBound -> Bool
Eq, Eq LengthBound
Eq LengthBound =>
(LengthBound -> LengthBound -> Ordering)
-> (LengthBound -> LengthBound -> Bool)
-> (LengthBound -> LengthBound -> Bool)
-> (LengthBound -> LengthBound -> Bool)
-> (LengthBound -> LengthBound -> Bool)
-> (LengthBound -> LengthBound -> LengthBound)
-> (LengthBound -> LengthBound -> LengthBound)
-> Ord LengthBound
LengthBound -> LengthBound -> Bool
LengthBound -> LengthBound -> Ordering
LengthBound -> LengthBound -> LengthBound
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LengthBound -> LengthBound -> Ordering
compare :: LengthBound -> LengthBound -> Ordering
$c< :: LengthBound -> LengthBound -> Bool
< :: LengthBound -> LengthBound -> Bool
$c<= :: LengthBound -> LengthBound -> Bool
<= :: LengthBound -> LengthBound -> Bool
$c> :: LengthBound -> LengthBound -> Bool
> :: LengthBound -> LengthBound -> Bool
$c>= :: LengthBound -> LengthBound -> Bool
>= :: LengthBound -> LengthBound -> Bool
$cmax :: LengthBound -> LengthBound -> LengthBound
max :: LengthBound -> LengthBound -> LengthBound
$cmin :: LengthBound -> LengthBound -> LengthBound
min :: LengthBound -> LengthBound -> LengthBound
Ord, Integer -> LengthBound
LengthBound -> LengthBound
LengthBound -> LengthBound -> LengthBound
(LengthBound -> LengthBound -> LengthBound)
-> (LengthBound -> LengthBound -> LengthBound)
-> (LengthBound -> LengthBound -> LengthBound)
-> (LengthBound -> LengthBound)
-> (LengthBound -> LengthBound)
-> (LengthBound -> LengthBound)
-> (Integer -> LengthBound)
-> Num LengthBound
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: LengthBound -> LengthBound -> LengthBound
+ :: LengthBound -> LengthBound -> LengthBound
$c- :: LengthBound -> LengthBound -> LengthBound
- :: LengthBound -> LengthBound -> LengthBound
$c* :: LengthBound -> LengthBound -> LengthBound
* :: LengthBound -> LengthBound -> LengthBound
$cnegate :: LengthBound -> LengthBound
negate :: LengthBound -> LengthBound
$cabs :: LengthBound -> LengthBound
abs :: LengthBound -> LengthBound
$csignum :: LengthBound -> LengthBound
signum :: LengthBound -> LengthBound
$cfromInteger :: Integer -> LengthBound
fromInteger :: Integer -> LengthBound
Num, Num LengthBound
Ord LengthBound
(Num LengthBound, Ord LengthBound) =>
(LengthBound -> Rational) -> Real LengthBound
LengthBound -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: LengthBound -> Rational
toRational :: LengthBound -> Rational
Real, Enum LengthBound
Real LengthBound
(Real LengthBound, Enum LengthBound) =>
(LengthBound -> LengthBound -> LengthBound)
-> (LengthBound -> LengthBound -> LengthBound)
-> (LengthBound -> LengthBound -> LengthBound)
-> (LengthBound -> LengthBound -> LengthBound)
-> (LengthBound -> LengthBound -> (LengthBound, LengthBound))
-> (LengthBound -> LengthBound -> (LengthBound, LengthBound))
-> (LengthBound -> Integer)
-> Integral LengthBound
LengthBound -> Integer
LengthBound -> LengthBound -> (LengthBound, LengthBound)
LengthBound -> LengthBound -> LengthBound
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: LengthBound -> LengthBound -> LengthBound
quot :: LengthBound -> LengthBound -> LengthBound
$crem :: LengthBound -> LengthBound -> LengthBound
rem :: LengthBound -> LengthBound -> LengthBound
$cdiv :: LengthBound -> LengthBound -> LengthBound
div :: LengthBound -> LengthBound -> LengthBound
$cmod :: LengthBound -> LengthBound -> LengthBound
mod :: LengthBound -> LengthBound -> LengthBound
$cquotRem :: LengthBound -> LengthBound -> (LengthBound, LengthBound)
quotRem :: LengthBound -> LengthBound -> (LengthBound, LengthBound)
$cdivMod :: LengthBound -> LengthBound -> (LengthBound, LengthBound)
divMod :: LengthBound -> LengthBound -> (LengthBound, LengthBound)
$ctoInteger :: LengthBound -> Integer
toInteger :: LengthBound -> Integer
Integral, ReadPrec [LengthBound]
ReadPrec LengthBound
Int -> ReadS LengthBound
ReadS [LengthBound]
(Int -> ReadS LengthBound)
-> ReadS [LengthBound]
-> ReadPrec LengthBound
-> ReadPrec [LengthBound]
-> Read LengthBound
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LengthBound
readsPrec :: Int -> ReadS LengthBound
$creadList :: ReadS [LengthBound]
readList :: ReadS [LengthBound]
$creadPrec :: ReadPrec LengthBound
readPrec :: ReadPrec LengthBound
$creadListPrec :: ReadPrec [LengthBound]
readListPrec :: ReadPrec [LengthBound]
Read, Int -> LengthBound -> ShowS
[LengthBound] -> ShowS
LengthBound -> String
(Int -> LengthBound -> ShowS)
-> (LengthBound -> String)
-> ([LengthBound] -> ShowS)
-> Show LengthBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LengthBound -> ShowS
showsPrec :: Int -> LengthBound -> ShowS
$cshow :: LengthBound -> String
show :: LengthBound -> String
$cshowList :: [LengthBound] -> ShowS
showList :: [LengthBound] -> ShowS
Show)

-- | @since 1.3.1.0
deriving instance Generic LengthBound

-- | @since 0.5.1.0
instance NFData LengthBound

-------------------------------------------------------------------------------
-- * Discarding results and traces

-- | An @Either Condition a -> Maybe Discard@ value can be used to
-- selectively discard results.
--
-- @since 0.7.1.0
data Discard
  = DiscardTrace
  -- ^ Discard the trace but keep the result.  The result will appear
  -- to have an empty trace.
  | DiscardResultAndTrace
  -- ^ Discard the result and the trace.  It will simply not be
  -- reported as a possible behaviour of the program.
  deriving (Discard -> Discard -> Bool
(Discard -> Discard -> Bool)
-> (Discard -> Discard -> Bool) -> Eq Discard
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Discard -> Discard -> Bool
== :: Discard -> Discard -> Bool
$c/= :: Discard -> Discard -> Bool
/= :: Discard -> Discard -> Bool
Eq, Int -> Discard -> ShowS
[Discard] -> ShowS
Discard -> String
(Int -> Discard -> ShowS)
-> (Discard -> String) -> ([Discard] -> ShowS) -> Show Discard
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Discard -> ShowS
showsPrec :: Int -> Discard -> ShowS
$cshow :: Discard -> String
show :: Discard -> String
$cshowList :: [Discard] -> ShowS
showList :: [Discard] -> ShowS
Show, ReadPrec [Discard]
ReadPrec Discard
Int -> ReadS Discard
ReadS [Discard]
(Int -> ReadS Discard)
-> ReadS [Discard]
-> ReadPrec Discard
-> ReadPrec [Discard]
-> Read Discard
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Discard
readsPrec :: Int -> ReadS Discard
$creadList :: ReadS [Discard]
readList :: ReadS [Discard]
$creadPrec :: ReadPrec Discard
readPrec :: ReadPrec Discard
$creadListPrec :: ReadPrec [Discard]
readListPrec :: ReadPrec [Discard]
Read, Eq Discard
Eq Discard =>
(Discard -> Discard -> Ordering)
-> (Discard -> Discard -> Bool)
-> (Discard -> Discard -> Bool)
-> (Discard -> Discard -> Bool)
-> (Discard -> Discard -> Bool)
-> (Discard -> Discard -> Discard)
-> (Discard -> Discard -> Discard)
-> Ord Discard
Discard -> Discard -> Bool
Discard -> Discard -> Ordering
Discard -> Discard -> Discard
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Discard -> Discard -> Ordering
compare :: Discard -> Discard -> Ordering
$c< :: Discard -> Discard -> Bool
< :: Discard -> Discard -> Bool
$c<= :: Discard -> Discard -> Bool
<= :: Discard -> Discard -> Bool
$c> :: Discard -> Discard -> Bool
> :: Discard -> Discard -> Bool
$c>= :: Discard -> Discard -> Bool
>= :: Discard -> Discard -> Bool
$cmax :: Discard -> Discard -> Discard
max :: Discard -> Discard -> Discard
$cmin :: Discard -> Discard -> Discard
min :: Discard -> Discard -> Discard
Ord, Int -> Discard
Discard -> Int
Discard -> [Discard]
Discard -> Discard
Discard -> Discard -> [Discard]
Discard -> Discard -> Discard -> [Discard]
(Discard -> Discard)
-> (Discard -> Discard)
-> (Int -> Discard)
-> (Discard -> Int)
-> (Discard -> [Discard])
-> (Discard -> Discard -> [Discard])
-> (Discard -> Discard -> [Discard])
-> (Discard -> Discard -> Discard -> [Discard])
-> Enum Discard
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Discard -> Discard
succ :: Discard -> Discard
$cpred :: Discard -> Discard
pred :: Discard -> Discard
$ctoEnum :: Int -> Discard
toEnum :: Int -> Discard
$cfromEnum :: Discard -> Int
fromEnum :: Discard -> Int
$cenumFrom :: Discard -> [Discard]
enumFrom :: Discard -> [Discard]
$cenumFromThen :: Discard -> Discard -> [Discard]
enumFromThen :: Discard -> Discard -> [Discard]
$cenumFromTo :: Discard -> Discard -> [Discard]
enumFromTo :: Discard -> Discard -> [Discard]
$cenumFromThenTo :: Discard -> Discard -> Discard -> [Discard]
enumFromThenTo :: Discard -> Discard -> Discard -> [Discard]
Enum, Discard
Discard -> Discard -> Bounded Discard
forall a. a -> a -> Bounded a
$cminBound :: Discard
minBound :: Discard
$cmaxBound :: Discard
maxBound :: Discard
Bounded)

-- | @since 1.3.1.0
deriving instance Generic Discard

instance NFData Discard

-- | A monoid for discard functions: combines two functions, keeping
-- the weaker.
--
-- @Nothing@ is weaker than @Just DiscardTrace@, which is weaker than
-- @Just DiscardResultAndTrace@.  This forms a commutative monoid
-- where the unit is @const (Just DiscardResultAndTrace)@.
--
-- @since 1.5.1.0
newtype Weaken a = Weaken
  { forall a. Weaken a -> Either Condition a -> Maybe Discard
getWeakDiscarder :: Either Condition a -> Maybe Discard }

instance Semigroup (Weaken a) where
  <> :: Weaken a -> Weaken a -> Weaken a
(<>) = (a -> (a, a)) -> Weaken a -> Weaken a -> Weaken a
forall a b c. (a -> (b, c)) -> Weaken b -> Weaken c -> Weaken a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\a
efa -> (a
efa, a
efa))

instance Monoid (Weaken a) where
  mempty :: Weaken a
mempty = Weaken a
forall a. Weaken a
forall (f :: * -> *) a. Divisible f => f a
conquer
  mappend :: Weaken a -> Weaken a -> Weaken a
mappend = Weaken a -> Weaken a -> Weaken a
forall a. Semigroup a => a -> a -> a
(<>)

instance Contravariant Weaken where
  contramap :: forall a' a. (a' -> a) -> Weaken a -> Weaken a'
contramap a' -> a
f (Weaken Either Condition a -> Maybe Discard
d) = (Either Condition a' -> Maybe Discard) -> Weaken a'
forall a. (Either Condition a -> Maybe Discard) -> Weaken a
Weaken (Either Condition a -> Maybe Discard
d (Either Condition a -> Maybe Discard)
-> (Either Condition a' -> Either Condition a)
-> Either Condition a'
-> Maybe Discard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a' -> a) -> Either Condition a' -> Either Condition a
forall a b. (a -> b) -> Either Condition a -> Either Condition b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a' -> a
f)

instance Divisible Weaken where
  divide :: forall a b c. (a -> (b, c)) -> Weaken b -> Weaken c -> Weaken a
divide a -> (b, c)
f (Weaken Either Condition b -> Maybe Discard
d1) (Weaken Either Condition c -> Maybe Discard
d2) = (Either Condition a -> Maybe Discard) -> Weaken a
forall a. (Either Condition a -> Maybe Discard) -> Weaken a
Weaken ((Either Condition a -> Maybe Discard) -> Weaken a)
-> (Either Condition a -> Maybe Discard) -> Weaken a
forall a b. (a -> b) -> a -> b
$ \case
    Right a
a ->
      let (b
b, c
c) = a -> (b, c)
f a
a
      in Maybe Discard -> Maybe Discard -> Maybe Discard
forall a. Ord a => a -> a -> a
min (Either Condition b -> Maybe Discard
d1 (b -> Either Condition b
forall a b. b -> Either a b
Right b
b)) (Either Condition c -> Maybe Discard
d2 (c -> Either Condition c
forall a b. b -> Either a b
Right c
c))
    Left Condition
e -> Maybe Discard -> Maybe Discard -> Maybe Discard
forall a. Ord a => a -> a -> a
min (Either Condition b -> Maybe Discard
d1 (Condition -> Either Condition b
forall a b. a -> Either a b
Left Condition
e)) (Either Condition c -> Maybe Discard
d2 (Condition -> Either Condition c
forall a b. a -> Either a b
Left Condition
e))

  conquer :: forall a. Weaken a
conquer = (Either Condition a -> Maybe Discard) -> Weaken a
forall a. (Either Condition a -> Maybe Discard) -> Weaken a
Weaken (Maybe Discard -> Either Condition a -> Maybe Discard
forall a b. a -> b -> a
const (Discard -> Maybe Discard
forall a. a -> Maybe a
Just Discard
DiscardResultAndTrace))

-- | Combine two discard functions, keeping the weaker.
--
-- @since 1.0.0.0
weakenDiscard ::
     (Either Condition a -> Maybe Discard)
  -> (Either Condition a -> Maybe Discard)
  -> Either Condition a -> Maybe Discard
weakenDiscard :: forall a.
(Either Condition a -> Maybe Discard)
-> (Either Condition a -> Maybe Discard)
-> Either Condition a
-> Maybe Discard
weakenDiscard Either Condition a -> Maybe Discard
d1 Either Condition a -> Maybe Discard
d2 =
  Weaken a -> Either Condition a -> Maybe Discard
forall a. Weaken a -> Either Condition a -> Maybe Discard
getWeakDiscarder ((Either Condition a -> Maybe Discard) -> Weaken a
forall a. (Either Condition a -> Maybe Discard) -> Weaken a
Weaken Either Condition a -> Maybe Discard
d1 Weaken a -> Weaken a -> Weaken a
forall a. Semigroup a => a -> a -> a
<> (Either Condition a -> Maybe Discard) -> Weaken a
forall a. (Either Condition a -> Maybe Discard) -> Weaken a
Weaken Either Condition a -> Maybe Discard
d2)

-- | A monoid for discard functions: combines two functions, keeping
-- the stronger.
--
-- @Just DiscardResultAndTrace@ is stronger than @Just DiscardTrace@,
-- which is stronger than @Nothing@.  This forms a commutative monoid
-- where the unit is @const Nothing@.
--
-- @since 1.5.1.0
newtype Strengthen a = Strengthen
  { forall a. Strengthen a -> Either Condition a -> Maybe Discard
getStrongDiscarder :: Either Condition a -> Maybe Discard }

instance Semigroup (Strengthen a) where
  <> :: Strengthen a -> Strengthen a -> Strengthen a
(<>) = (a -> (a, a)) -> Strengthen a -> Strengthen a -> Strengthen a
forall a b c.
(a -> (b, c)) -> Strengthen b -> Strengthen c -> Strengthen a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\a
efa -> (a
efa, a
efa))

instance Monoid (Strengthen a) where
  mempty :: Strengthen a
mempty = Strengthen a
forall a. Strengthen a
forall (f :: * -> *) a. Divisible f => f a
conquer
  mappend :: Strengthen a -> Strengthen a -> Strengthen a
mappend = Strengthen a -> Strengthen a -> Strengthen a
forall a. Semigroup a => a -> a -> a
(<>)

instance Contravariant Strengthen where
  contramap :: forall a' a. (a' -> a) -> Strengthen a -> Strengthen a'
contramap a' -> a
f (Strengthen Either Condition a -> Maybe Discard
d) = (Either Condition a' -> Maybe Discard) -> Strengthen a'
forall a. (Either Condition a -> Maybe Discard) -> Strengthen a
Strengthen (Either Condition a -> Maybe Discard
d (Either Condition a -> Maybe Discard)
-> (Either Condition a' -> Either Condition a)
-> Either Condition a'
-> Maybe Discard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a' -> a) -> Either Condition a' -> Either Condition a
forall a b. (a -> b) -> Either Condition a -> Either Condition b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a' -> a
f)

instance Divisible Strengthen where
  divide :: forall a b c.
(a -> (b, c)) -> Strengthen b -> Strengthen c -> Strengthen a
divide a -> (b, c)
f (Strengthen Either Condition b -> Maybe Discard
d1) (Strengthen Either Condition c -> Maybe Discard
d2) = (Either Condition a -> Maybe Discard) -> Strengthen a
forall a. (Either Condition a -> Maybe Discard) -> Strengthen a
Strengthen ((Either Condition a -> Maybe Discard) -> Strengthen a)
-> (Either Condition a -> Maybe Discard) -> Strengthen a
forall a b. (a -> b) -> a -> b
$ \case
    Right a
a ->
      let (b
b, c
c) = a -> (b, c)
f a
a
      in Maybe Discard -> Maybe Discard -> Maybe Discard
forall a. Ord a => a -> a -> a
max (Either Condition b -> Maybe Discard
d1 (b -> Either Condition b
forall a b. b -> Either a b
Right b
b)) (Either Condition c -> Maybe Discard
d2 (c -> Either Condition c
forall a b. b -> Either a b
Right c
c))
    Left Condition
e -> Maybe Discard -> Maybe Discard -> Maybe Discard
forall a. Ord a => a -> a -> a
max (Either Condition b -> Maybe Discard
d1 (Condition -> Either Condition b
forall a b. a -> Either a b
Left Condition
e)) (Either Condition c -> Maybe Discard
d2 (Condition -> Either Condition c
forall a b. a -> Either a b
Left Condition
e))

  conquer :: forall a. Strengthen a
conquer = (Either Condition a -> Maybe Discard) -> Strengthen a
forall a. (Either Condition a -> Maybe Discard) -> Strengthen a
Strengthen (Maybe Discard -> Either Condition a -> Maybe Discard
forall a b. a -> b -> a
const Maybe Discard
forall a. Maybe a
Nothing)

-- | Combine two discard functions, keeping the stronger.
--
-- @since 1.0.0.0
strengthenDiscard ::
     (Either Condition a -> Maybe Discard)
  -> (Either Condition a -> Maybe Discard)
  -> Either Condition a -> Maybe Discard
strengthenDiscard :: forall a.
(Either Condition a -> Maybe Discard)
-> (Either Condition a -> Maybe Discard)
-> Either Condition a
-> Maybe Discard
strengthenDiscard Either Condition a -> Maybe Discard
d1 Either Condition a -> Maybe Discard
d2 =
  Strengthen a -> Either Condition a -> Maybe Discard
forall a. Strengthen a -> Either Condition a -> Maybe Discard
getStrongDiscarder ((Either Condition a -> Maybe Discard) -> Strengthen a
forall a. (Either Condition a -> Maybe Discard) -> Strengthen a
Strengthen Either Condition a -> Maybe Discard
d1 Strengthen a -> Strengthen a -> Strengthen a
forall a. Semigroup a => a -> a -> a
<> (Either Condition a -> Maybe Discard) -> Strengthen a
forall a. (Either Condition a -> Maybe Discard) -> Strengthen a
Strengthen Either Condition a -> Maybe Discard
d2)

-------------------------------------------------------------------------------
-- * Memory Models

-- | The memory model to use for non-synchronised 'IORef' operations.
--
-- @since 0.4.0.0
data MemType =
    SequentialConsistency
  -- ^ The most intuitive model: a program behaves as a simple
  -- interleaving of the actions in different threads. When a 'IORef'
  -- is written to, that write is immediately visible to all threads.
  | TotalStoreOrder
  -- ^ Each thread has a write buffer. A thread sees its writes
  -- immediately, but other threads will only see writes when they are
  -- committed, which may happen later. Writes are committed in the
  -- same order that they are created.
  | PartialStoreOrder
  -- ^ Each 'IORef' has a write buffer. A thread sees its writes
  -- immediately, but other threads will only see writes when they are
  -- committed, which may happen later. Writes to different 'IORef's
  -- are not necessarily committed in the same order that they are
  -- created.
  deriving (MemType -> MemType -> Bool
(MemType -> MemType -> Bool)
-> (MemType -> MemType -> Bool) -> Eq MemType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemType -> MemType -> Bool
== :: MemType -> MemType -> Bool
$c/= :: MemType -> MemType -> Bool
/= :: MemType -> MemType -> Bool
Eq, Int -> MemType -> ShowS
[MemType] -> ShowS
MemType -> String
(Int -> MemType -> ShowS)
-> (MemType -> String) -> ([MemType] -> ShowS) -> Show MemType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemType -> ShowS
showsPrec :: Int -> MemType -> ShowS
$cshow :: MemType -> String
show :: MemType -> String
$cshowList :: [MemType] -> ShowS
showList :: [MemType] -> ShowS
Show, ReadPrec [MemType]
ReadPrec MemType
Int -> ReadS MemType
ReadS [MemType]
(Int -> ReadS MemType)
-> ReadS [MemType]
-> ReadPrec MemType
-> ReadPrec [MemType]
-> Read MemType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MemType
readsPrec :: Int -> ReadS MemType
$creadList :: ReadS [MemType]
readList :: ReadS [MemType]
$creadPrec :: ReadPrec MemType
readPrec :: ReadPrec MemType
$creadListPrec :: ReadPrec [MemType]
readListPrec :: ReadPrec [MemType]
Read, Eq MemType
Eq MemType =>
(MemType -> MemType -> Ordering)
-> (MemType -> MemType -> Bool)
-> (MemType -> MemType -> Bool)
-> (MemType -> MemType -> Bool)
-> (MemType -> MemType -> Bool)
-> (MemType -> MemType -> MemType)
-> (MemType -> MemType -> MemType)
-> Ord MemType
MemType -> MemType -> Bool
MemType -> MemType -> Ordering
MemType -> MemType -> MemType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MemType -> MemType -> Ordering
compare :: MemType -> MemType -> Ordering
$c< :: MemType -> MemType -> Bool
< :: MemType -> MemType -> Bool
$c<= :: MemType -> MemType -> Bool
<= :: MemType -> MemType -> Bool
$c> :: MemType -> MemType -> Bool
> :: MemType -> MemType -> Bool
$c>= :: MemType -> MemType -> Bool
>= :: MemType -> MemType -> Bool
$cmax :: MemType -> MemType -> MemType
max :: MemType -> MemType -> MemType
$cmin :: MemType -> MemType -> MemType
min :: MemType -> MemType -> MemType
Ord, Int -> MemType
MemType -> Int
MemType -> [MemType]
MemType -> MemType
MemType -> MemType -> [MemType]
MemType -> MemType -> MemType -> [MemType]
(MemType -> MemType)
-> (MemType -> MemType)
-> (Int -> MemType)
-> (MemType -> Int)
-> (MemType -> [MemType])
-> (MemType -> MemType -> [MemType])
-> (MemType -> MemType -> [MemType])
-> (MemType -> MemType -> MemType -> [MemType])
-> Enum MemType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MemType -> MemType
succ :: MemType -> MemType
$cpred :: MemType -> MemType
pred :: MemType -> MemType
$ctoEnum :: Int -> MemType
toEnum :: Int -> MemType
$cfromEnum :: MemType -> Int
fromEnum :: MemType -> Int
$cenumFrom :: MemType -> [MemType]
enumFrom :: MemType -> [MemType]
$cenumFromThen :: MemType -> MemType -> [MemType]
enumFromThen :: MemType -> MemType -> [MemType]
$cenumFromTo :: MemType -> MemType -> [MemType]
enumFromTo :: MemType -> MemType -> [MemType]
$cenumFromThenTo :: MemType -> MemType -> MemType -> [MemType]
enumFromThenTo :: MemType -> MemType -> MemType -> [MemType]
Enum, MemType
MemType -> MemType -> Bounded MemType
forall a. a -> a -> Bounded a
$cminBound :: MemType
minBound :: MemType
$cmaxBound :: MemType
maxBound :: MemType
Bounded)

-- | @since 1.3.1.0
deriving instance Generic MemType

-- | @since 0.5.1.0
instance NFData MemType

-------------------------------------------------------------------------------
-- * @MonadFail@

-- | An exception for errors in testing caused by use of 'fail'.
newtype MonadFailException = MonadFailException String
  deriving Int -> MonadFailException -> ShowS
[MonadFailException] -> ShowS
MonadFailException -> String
(Int -> MonadFailException -> ShowS)
-> (MonadFailException -> String)
-> ([MonadFailException] -> ShowS)
-> Show MonadFailException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonadFailException -> ShowS
showsPrec :: Int -> MonadFailException -> ShowS
$cshow :: MonadFailException -> String
show :: MonadFailException -> String
$cshowList :: [MonadFailException] -> ShowS
showList :: [MonadFailException] -> ShowS
Show

instance Exception MonadFailException

-- | @since 1.3.1.0
deriving instance Generic MonadFailException

-- | @since 1.3.1.0
instance NFData MonadFailException

-------------------------------------------------------------------------------
-- ** Concurrency state

-- | A summary of the concurrency state of the program.
--
-- @since 2.0.0.0
data ConcurrencyState = ConcurrencyState
  { ConcurrencyState -> Map IORefId Int
concIOState :: Map IORefId Int
  -- ^ Keep track of which @IORef@s have buffered writes.
  , ConcurrencyState -> Set MVarId
concMVState :: Set MVarId
  -- ^ Keep track of which @MVar@s are full.
  , ConcurrencyState -> Map ThreadId MaskingState
concMaskState :: Map ThreadId MaskingState
  -- ^ Keep track of thread masking states. If a thread isn't present,
  -- the masking state is assumed to be @Unmasked@. This nicely
  -- provides compatibility with dpor-0.1, where the thread IDs are
  -- not available.
  } deriving (ConcurrencyState -> ConcurrencyState -> Bool
(ConcurrencyState -> ConcurrencyState -> Bool)
-> (ConcurrencyState -> ConcurrencyState -> Bool)
-> Eq ConcurrencyState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConcurrencyState -> ConcurrencyState -> Bool
== :: ConcurrencyState -> ConcurrencyState -> Bool
$c/= :: ConcurrencyState -> ConcurrencyState -> Bool
/= :: ConcurrencyState -> ConcurrencyState -> Bool
Eq, Int -> ConcurrencyState -> ShowS
[ConcurrencyState] -> ShowS
ConcurrencyState -> String
(Int -> ConcurrencyState -> ShowS)
-> (ConcurrencyState -> String)
-> ([ConcurrencyState] -> ShowS)
-> Show ConcurrencyState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConcurrencyState -> ShowS
showsPrec :: Int -> ConcurrencyState -> ShowS
$cshow :: ConcurrencyState -> String
show :: ConcurrencyState -> String
$cshowList :: [ConcurrencyState] -> ShowS
showList :: [ConcurrencyState] -> ShowS
Show)

instance NFData ConcurrencyState where
  rnf :: ConcurrencyState -> ()
rnf ConcurrencyState
cstate = (Map IORefId Int, Set MVarId, [(ThreadId, String)]) -> ()
forall a. NFData a => a -> ()
rnf
    ( ConcurrencyState -> Map IORefId Int
concIOState ConcurrencyState
cstate
    , ConcurrencyState -> Set MVarId
concMVState ConcurrencyState
cstate
    , [(ThreadId
t, MaskingState -> String
forall a. Show a => a -> String
show MaskingState
m) | (ThreadId
t, MaskingState
m) <- Map ThreadId MaskingState -> [(ThreadId, MaskingState)]
forall k a. Map k a -> [(k, a)]
M.toList (ConcurrencyState -> Map ThreadId MaskingState
concMaskState ConcurrencyState
cstate)]
    )

-- | Check if a @IORef@ has a buffered write pending.
--
-- @since 2.0.0.0
isBuffered :: ConcurrencyState -> IORefId -> Bool
isBuffered :: ConcurrencyState -> IORefId -> Bool
isBuffered ConcurrencyState
cstate IORefId
r = ConcurrencyState -> IORefId -> Int
numBuffered ConcurrencyState
cstate IORefId
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

-- | Check how many buffered writes an @IORef@ has.
--
-- @since 2.0.0.0
numBuffered :: ConcurrencyState -> IORefId -> Int
numBuffered :: ConcurrencyState -> IORefId -> Int
numBuffered ConcurrencyState
cstate IORefId
r = Int -> IORefId -> Map IORefId Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Int
0 IORefId
r (ConcurrencyState -> Map IORefId Int
concIOState ConcurrencyState
cstate)

-- | Check if an @MVar@ is full.
--
-- @since 2.0.0.0
isFull :: ConcurrencyState -> MVarId -> Bool
isFull :: ConcurrencyState -> MVarId -> Bool
isFull ConcurrencyState
cstate MVarId
v = MVarId -> Set MVarId -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member MVarId
v (ConcurrencyState -> Set MVarId
concMVState ConcurrencyState
cstate)

-- | Check if an exception can interrupt a thread (action).
--
-- @since 2.0.0.0
canInterrupt :: ConcurrencyState -> ThreadId -> ThreadAction -> Bool
canInterrupt :: ConcurrencyState -> ThreadId -> ThreadAction -> Bool
canInterrupt ConcurrencyState
cstate ThreadId
tid ThreadAction
act
  -- If masked interruptible, blocked actions can be interrupted.
  | ConcurrencyState -> ThreadId -> Bool
isMaskedInterruptible ConcurrencyState
cstate ThreadId
tid = case ThreadAction
act of
    BlockedPutMVar  MVarId
_ -> Bool
True
    BlockedReadMVar MVarId
_ -> Bool
True
    BlockedTakeMVar MVarId
_ -> Bool
True
    BlockedSTM      [TAction]
_ -> Bool
True
    BlockedThrowTo  ThreadId
_ -> Bool
True
    ThreadAction
_ -> Bool
False
  -- If masked uninterruptible, nothing can be.
  | ConcurrencyState -> ThreadId -> Bool
isMaskedUninterruptible ConcurrencyState
cstate ThreadId
tid = Bool
False
  -- If no mask, anything can be.
  | Bool
otherwise = Bool
True

-- | Check if an exception can interrupt a thread (lookahead).
--
-- @since 2.0.0.0
canInterruptL :: ConcurrencyState -> ThreadId -> Lookahead -> Bool
canInterruptL :: ConcurrencyState -> ThreadId -> Lookahead -> Bool
canInterruptL ConcurrencyState
cstate ThreadId
tid Lookahead
lh
  -- If masked interruptible, actions which can block may be
  -- interrupted.
  | ConcurrencyState -> ThreadId -> Bool
isMaskedInterruptible ConcurrencyState
cstate ThreadId
tid = case Lookahead
lh of
    WillPutMVar  MVarId
_ -> Bool
True
    WillReadMVar MVarId
_ -> Bool
True
    WillTakeMVar MVarId
_ -> Bool
True
    Lookahead
WillSTM        -> Bool
True
    WillThrowTo  ThreadId
_ -> Bool
True
    Lookahead
_ -> Bool
False
  -- If masked uninterruptible, nothing can be.
  | ConcurrencyState -> ThreadId -> Bool
isMaskedUninterruptible ConcurrencyState
cstate ThreadId
tid = Bool
False
  -- If no mask, anything can be.
  | Bool
otherwise = Bool
True

-- | Check if a thread is masked interruptible.
--
-- @since 2.0.0.0
isMaskedInterruptible :: ConcurrencyState -> ThreadId -> Bool
isMaskedInterruptible :: ConcurrencyState -> ThreadId -> Bool
isMaskedInterruptible ConcurrencyState
cstate ThreadId
tid =
  ThreadId -> Map ThreadId MaskingState -> Maybe MaskingState
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ThreadId
tid (ConcurrencyState -> Map ThreadId MaskingState
concMaskState ConcurrencyState
cstate) Maybe MaskingState -> Maybe MaskingState -> Bool
forall a. Eq a => a -> a -> Bool
== MaskingState -> Maybe MaskingState
forall a. a -> Maybe a
Just MaskingState
MaskedInterruptible

-- | Check if a thread is masked uninterruptible.
--
-- @since 2.0.0.0
isMaskedUninterruptible :: ConcurrencyState -> ThreadId -> Bool
isMaskedUninterruptible :: ConcurrencyState -> ThreadId -> Bool
isMaskedUninterruptible ConcurrencyState
cstate ThreadId
tid =
  ThreadId -> Map ThreadId MaskingState -> Maybe MaskingState
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ThreadId
tid (ConcurrencyState -> Map ThreadId MaskingState
concMaskState ConcurrencyState
cstate) Maybe MaskingState -> Maybe MaskingState -> Bool
forall a. Eq a => a -> a -> Bool
== MaskingState -> Maybe MaskingState
forall a. a -> Maybe a
Just MaskingState
MaskedUninterruptible