{-# OPTIONS_HADDOCK not-home #-}
module Hedgehog.Internal.Exception (
    tryAll
  , tryEvaluate
  ) where

import           Control.Exception (Exception(..), AsyncException, SomeException(..), evaluate)
import           Control.Monad.Catch (MonadCatch(..), throwM)

import           System.IO.Unsafe (unsafePerformIO)


tryAll :: MonadCatch m => m a -> m (Either SomeException a)
tryAll :: m a -> m (Either SomeException a)
tryAll m a
m =
  m (Either SomeException a)
-> (SomeException -> m (Either SomeException a))
-> m (Either SomeException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ((a -> Either SomeException a) -> m a -> m (Either SomeException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either SomeException a
forall a b. b -> Either a b
Right m a
m) ((SomeException -> m (Either SomeException a))
 -> m (Either SomeException a))
-> (SomeException -> m (Either SomeException a))
-> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ \SomeException
exception ->
    case SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
exception :: Maybe AsyncException of
      Maybe AsyncException
Nothing ->
        Either SomeException a -> m (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException a -> m (Either SomeException a))
-> Either SomeException a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
exception
      Just AsyncException
async ->
        AsyncException -> m (Either SomeException a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM AsyncException
async

tryEvaluate :: a -> Either SomeException a
tryEvaluate :: a -> Either SomeException a
tryEvaluate a
x =
  IO (Either SomeException a) -> Either SomeException a
forall a. IO a -> a
unsafePerformIO (IO a -> IO (Either SomeException a)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAll (a -> IO a
forall a. a -> IO a
evaluate a
x))