-- | Exception handling utilities.
module Test.Mutagen.Exception
  ( -- * Exception handling utilities
    AnException
  , tryEvaluate
  , tryEvaluateIO
  , evaluate
  , finally
  , discard
  , isDiscard
  )
where

import qualified Control.Exception as Exception

{-------------------------------------------------------------------------------
-- * Exception handling utilities
-------------------------------------------------------------------------------}

-- | A general exception type.
type AnException = Exception.SomeException

-- | Evaluate a value to weak head normal form, catching any exceptions.
tryEvaluate :: a -> IO (Either AnException a)
tryEvaluate :: forall a. a -> IO (Either AnException a)
tryEvaluate a
x = IO a -> IO (Either AnException a)
forall a. IO a -> IO (Either AnException a)
tryEvaluateIO (a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)

-- | Evaluate an IO action to weak head normal form, catching any exceptions.
tryEvaluateIO :: IO a -> IO (Either AnException a)
tryEvaluateIO :: forall a. IO a -> IO (Either AnException a)
tryEvaluateIO IO a
m =
  (AnException -> Maybe AnException)
-> IO a -> IO (Either AnException a)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
Exception.tryJust AnException -> Maybe AnException
notAsync (IO a
m IO a -> (a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall a. a -> IO a
Exception.evaluate)
  where
    notAsync :: AnException -> Maybe AnException
    notAsync :: AnException -> Maybe AnException
notAsync AnException
e = case AnException -> Maybe SomeAsyncException
forall e. Exception e => AnException -> Maybe e
Exception.fromException AnException
e of
      Just (Exception.SomeAsyncException e
_) -> Maybe AnException
forall a. Maybe a
Nothing
      Maybe SomeAsyncException
Nothing -> AnException -> Maybe AnException
forall a. a -> Maybe a
Just AnException
e

-- | Evaluate a value to weak head normal form.
evaluate :: a -> IO a
evaluate :: forall a. a -> IO a
evaluate = a -> IO a
forall a. a -> IO a
Exception.evaluate

-- | Ensure that a cleanup action is run after an IO action, even if
-- an exception is thrown.
finally :: IO a -> IO b -> IO a
finally :: forall a b. IO a -> IO b -> IO a
finally = IO a -> IO b -> IO a
forall a b. IO a -> IO b -> IO a
Exception.finally

-- | A special error value. If a property evaluates 'discard', it causes
-- Mutagen to discard the current test case. This can be useful if you want
-- to discard the current test case, but are somewhere you can't use
-- 'Test.Mutagen.==>', such as inside a generator.
discard :: a
discard :: forall a. a
discard = String -> a
forall a. HasCallStack => String -> a
error String
discardMsg

-- | Predicate to check whether an exception is our special 'discard'.
isDiscard :: AnException -> Bool
isDiscard :: AnException -> Bool
isDiscard AnException
e =
  case AnException -> Maybe ErrorCall
forall e. Exception e => AnException -> Maybe e
Exception.fromException AnException
e of
    Just (Exception.ErrorCall String
msg) -> String
msg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
discardMsg
    Maybe ErrorCall
_ -> Bool
False

discardMsg :: String
discardMsg :: String
discardMsg = String
"DISCARD. You should not see this exception, it is internal to Mutagen."