{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
#ifndef NO_SAFE_HASKELL
{-# LANGUAGE Safe #-}
#endif
module Test.QuickCheck.Exception where
#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ < 700)
#define OLD_EXCEPTIONS
#endif
#if defined(NO_EXCEPTIONS)
#else
import qualified Control.Exception as E
#endif
#if defined(NO_EXCEPTIONS)
type AnException = ()
#elif defined(OLD_EXCEPTIONS)
type AnException = E.Exception
#else
type AnException = E.SomeException
#endif
#ifdef NO_EXCEPTIONS
tryEvaluate :: a -> IO (Either AnException a)
tryEvaluate x = return (Right x)
tryEvaluateIO :: IO a -> IO (Either AnException a)
tryEvaluateIO m = fmap Right m
evaluate :: a -> IO a
evaluate x = x `seq` return x
isInterrupt :: AnException -> Bool
isInterrupt _ = False
discard :: a
discard = error "'discard' not supported, since your Haskell system can't catch exceptions"
isDiscard :: AnException -> Bool
isDiscard _ = False
finally :: IO a -> IO b -> IO a
finally mx my = do
x <- mx
my
return x
#else
tryEvaluate :: a -> IO (Either AnException a)
tryEvaluate :: forall a. a -> IO (Either AnException a)
tryEvaluate a
x = forall a. IO a -> IO (Either AnException a)
tryEvaluateIO (forall (m :: * -> *) a. Monad m => a -> m a
return a
x)
tryEvaluateIO :: IO a -> IO (Either AnException a)
tryEvaluateIO :: forall a. IO a -> IO (Either AnException a)
tryEvaluateIO IO a
m = forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
E.tryJust AnException -> Maybe AnException
notAsync (IO a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO a
E.evaluate)
where
notAsync :: AnException -> Maybe AnException
#if MIN_VERSION_base(4,7,0)
notAsync :: AnException -> Maybe AnException
notAsync AnException
e = case forall e. Exception e => AnException -> Maybe e
E.fromException AnException
e of
Just (E.SomeAsyncException e
_) -> forall a. Maybe a
Nothing
Maybe SomeAsyncException
Nothing -> forall a. a -> Maybe a
Just AnException
e
#elif !defined(OLD_EXCEPTIONS)
notAsync e = case E.fromException e :: Maybe E.AsyncException of
Just _ -> Nothing
Nothing -> Just e
#else
notAsync e = Just e
#endif
evaluate :: a -> IO a
evaluate :: forall a. a -> IO a
evaluate = forall a. a -> IO a
E.evaluate
isInterrupt :: AnException -> Bool
#if defined(OLD_EXCEPTIONS)
isInterrupt _ = False
#else
isInterrupt :: AnException -> Bool
isInterrupt AnException
e = forall e. Exception e => AnException -> Maybe e
E.fromException AnException
e forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AsyncException
E.UserInterrupt
#endif
discard :: a
isDiscard :: AnException -> Bool
(a
discard, AnException -> Bool
isDiscard) = (forall a e. Exception e => e -> a
E.throw (String -> ErrorCall
E.ErrorCall String
msg), AnException -> Bool
isDiscard)
where
msg :: String
msg = String
"DISCARD. " forall a. [a] -> [a] -> [a]
++
String
"You should not see this exception, it is internal to QuickCheck."
#if defined(OLD_EXCEPTIONS)
isDiscard (E.ErrorCall msg') = msg' == msg
isDiscard _ = False
#else
isDiscard :: AnException -> Bool
isDiscard AnException
e =
case forall e. Exception e => AnException -> Maybe e
E.fromException AnException
e of
Just (E.ErrorCall String
msg') -> String
msg' forall a. Eq a => a -> a -> Bool
== String
msg
Maybe ErrorCall
_ -> Bool
False
#endif
finally :: IO a -> IO b -> IO a
finally :: forall a b. IO a -> IO b -> IO a
finally = forall a b. IO a -> IO b -> IO a
E.finally
#endif