module Hedgehog.Internal.Exception (
TypedException(..)
, tryAll
) where
import Control.Exception (Exception(..), AsyncException, SomeException(..))
import Control.Monad.Catch (MonadCatch(..), throwM)
import Data.Typeable (typeOf)
newtype TypedException =
TypedException SomeException
instance Show TypedException where
showsPrec p (TypedException (SomeException x)) =
showParen (p > 10) $
showsPrec 11 (typeOf x) .
showChar ' ' .
showsPrec 11 (displayException x)
tryAll :: MonadCatch m => m a -> m (Either TypedException a)
tryAll m =
catch (fmap Right m) $ \exception ->
case fromException exception :: Maybe AsyncException of
Nothing ->
pure . Left $ TypedException exception
Just async ->
throwM async