Add is* functions for failure types

dejafu/CHANGELOG.markdown

@@ -7,6 +7,18 @@ This project is versioned according to the [Package Versioning Policy](https://p
 *de facto* standard Haskell versioning scheme.
 
 
+unreleased
+----------
+
+### Test.DejaFu.Common
+
+- New `isInternalError`, `isAbort`, `isDeadlock`, `isUncaughtException`, and
+  `isIllegalSubconcurrency` functions for matching failure types.  Also exported from Test.DejaFu.
+
+
+---------------------------------------------------------------------------------------------------
+
+
 0.8.0.0
 -------
 

dejafu/Test/DejaFu.hs

@@ -251,6 +251,14 @@ module Test.DejaFu
   , gives
   , gives'
 
+  -- ** Failures
+
+  , isInternalError
+  , isAbort
+  , isDeadlock
+  , isUncaughtException
+  , isIllegalSubconcurrency
+
   -- * Refinement property testing
 
   -- | Consider this statement about @MVar@s: \"using @readMVar@ is
@@ -614,37 +622,37 @@ abortsSometimes = somewhereTrue $ either (==Abort) (const False)
 --
 -- @since 0.1.0.0
 deadlocksNever :: Predicate a
-deadlocksNever = alwaysTrue (not . either (`elem` [Deadlock, STMDeadlock]) (const False))
+deadlocksNever = alwaysTrue (not . either isDeadlock (const False))
 
 -- | Check that a computation always deadlocks.
 --
 -- @since 0.1.0.0
 deadlocksAlways :: Predicate a
-deadlocksAlways = alwaysTrue $ either (`elem` [Deadlock, STMDeadlock]) (const False)
+deadlocksAlways = alwaysTrue $ either isDeadlock (const False)
 
 -- | Check that a computation deadlocks at least once.
 --
 -- @since 0.1.0.0
 deadlocksSometimes :: Predicate a
-deadlocksSometimes = somewhereTrue $ either (`elem` [Deadlock, STMDeadlock]) (const False)
+deadlocksSometimes = somewhereTrue $ either isDeadlock (const False)
 
 -- | Check that a computation never fails with an uncaught exception.
 --
 -- @since 0.1.0.0
 exceptionsNever :: Predicate a
-exceptionsNever = alwaysTrue (not . either (==UncaughtException) (const False))
+exceptionsNever = alwaysTrue (not . either isUncaughtException (const False))
 
 -- | Check that a computation always fails with an uncaught exception.
 --
 -- @since 0.1.0.0
 exceptionsAlways :: Predicate a
-exceptionsAlways = alwaysTrue $ either (==UncaughtException) (const False)
+exceptionsAlways = alwaysTrue $ either isUncaughtException (const False)
 
 -- | Check that a computation fails with an uncaught exception at least once.
 --
 -- @since 0.1.0.0
 exceptionsSometimes :: Predicate a
-exceptionsSometimes = somewhereTrue $ either (==UncaughtException) (const False)
+exceptionsSometimes = somewhereTrue $ either isUncaughtException (const False)
 
 -- | Check that the result of a computation is always the same. In
 -- particular this means either: (a) it always fails in the same way,

dejafu/Test/DejaFu/Common.hs

@@ -53,6 +53,11 @@ module Test.DejaFu.Common
 
   -- * Failures
   , Failure(..)
+  , isInternalError
+  , isAbort
+  , isDeadlock
+  , isUncaughtException
+  , isIllegalSubconcurrency
   , showFail
 
   -- * Memory models
@@ -868,6 +873,42 @@ showFail InternalError = "[internal-error]"
 showFail UncaughtException = "[exception]"
 showFail IllegalSubconcurrency = "[illegal-subconcurrency]"
 
+-- | Check if a failure is an @InternalError@.
+--
+-- @since undefined
+isInternalError :: Failure -> Bool
+isInternalError InternalError = True
+isInternalError _ = False
+
+-- | Check if a failure is an @Abort@.
+--
+-- @since undefined
+isAbort :: Failure -> Bool
+isAbort Abort = True
+isAbort _ = False
+
+-- | Check if a failure is a @Deadlock@ or an @STMDeadlock@.
+--
+-- @since undefined
+isDeadlock :: Failure -> Bool
+isDeadlock Deadlock = True
+isDeadlock STMDeadlock = True
+isDeadlock _ = False
+
+-- | Check if a failure is an @UncaughtException@
+--
+-- @since undefined
+isUncaughtException :: Failure -> Bool
+isUncaughtException UncaughtException = True
+isUncaughtException _ = False
+
+-- | Check if a failure is an @IllegalSubconcurrency@
+--
+-- @since undefined
+isIllegalSubconcurrency :: Failure -> Bool
+isIllegalSubconcurrency IllegalSubconcurrency = True
+isIllegalSubconcurrency _ = False
+
 -------------------------------------------------------------------------------
 -- Memory Models