{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
#endif
module UnexceptionalIO (
UIO,
Unexceptional(..),
fromIO,
#ifdef __GLASGOW_HASKELL__
fromIO',
#endif
run,
runEitherIO,
unsafeFromIO,
SomeNonPseudoException,
#ifdef __GLASGOW_HASKELL__
PseudoException(..),
ProgrammerError(..),
ExternalError(..),
bracket,
#if MIN_VERSION_base(4,7,0)
forkFinally,
fork,
ChildThreadError(..)
#endif
#endif
) where
import Data.Maybe (fromMaybe)
import Control.Applicative (Applicative(..), (<|>), (<$>))
import Control.Monad (liftM, ap, (<=<))
import Control.Monad.Fix (MonadFix(..))
#ifdef __GLASGOW_HASKELL__
import System.Exit (ExitCode)
import Control.Exception (try)
import Data.Typeable (Typeable)
import qualified Control.Exception as Ex
import qualified Control.Concurrent as Concurrent
#if MIN_VERSION_base(4,11,0)
import qualified Control.Exception.Base as Ex
#endif
data PseudoException =
ProgrammerError ProgrammerError |
ExternalError ExternalError |
Exit ExitCode
deriving (Int -> PseudoException -> ShowS
[PseudoException] -> ShowS
PseudoException -> String
(Int -> PseudoException -> ShowS)
-> (PseudoException -> String)
-> ([PseudoException] -> ShowS)
-> Show PseudoException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PseudoException] -> ShowS
$cshowList :: [PseudoException] -> ShowS
show :: PseudoException -> String
$cshow :: PseudoException -> String
showsPrec :: Int -> PseudoException -> ShowS
$cshowsPrec :: Int -> PseudoException -> ShowS
Show, Typeable)
instance Ex.Exception PseudoException where
toException :: PseudoException -> SomeException
toException (ProgrammerError ProgrammerError
e) = ProgrammerError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ProgrammerError
e
toException (ExternalError ExternalError
e) = ExternalError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ExternalError
e
toException (Exit ExitCode
e) = ExitCode -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ExitCode
e
fromException :: SomeException -> Maybe PseudoException
fromException SomeException
e =
ProgrammerError -> PseudoException
ProgrammerError (ProgrammerError -> PseudoException)
-> Maybe ProgrammerError -> Maybe PseudoException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe ProgrammerError
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe PseudoException
-> Maybe PseudoException -> Maybe PseudoException
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
ExternalError -> PseudoException
ExternalError (ExternalError -> PseudoException)
-> Maybe ExternalError -> Maybe PseudoException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe ExternalError
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe PseudoException
-> Maybe PseudoException -> Maybe PseudoException
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
ExitCode -> PseudoException
Exit (ExitCode -> PseudoException)
-> Maybe ExitCode -> Maybe PseudoException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e
data ProgrammerError =
#if MIN_VERSION_base(4,9,0)
TypeError Ex.TypeError |
#endif
ArithException Ex.ArithException |
ArrayException Ex.ArrayException |
AssertionFailed Ex.AssertionFailed |
ErrorCall Ex.ErrorCall |
NestedAtomically Ex.NestedAtomically |
NoMethodError Ex.NoMethodError |
PatternMatchFail Ex.PatternMatchFail |
RecConError Ex.RecConError |
RecSelError Ex.RecSelError |
RecUpdError Ex.RecSelError
deriving (Int -> ProgrammerError -> ShowS
[ProgrammerError] -> ShowS
ProgrammerError -> String
(Int -> ProgrammerError -> ShowS)
-> (ProgrammerError -> String)
-> ([ProgrammerError] -> ShowS)
-> Show ProgrammerError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProgrammerError] -> ShowS
$cshowList :: [ProgrammerError] -> ShowS
show :: ProgrammerError -> String
$cshow :: ProgrammerError -> String
showsPrec :: Int -> ProgrammerError -> ShowS
$cshowsPrec :: Int -> ProgrammerError -> ShowS
Show, Typeable)
instance Ex.Exception ProgrammerError where
#if MIN_VERSION_base(4,9,0)
toException :: ProgrammerError -> SomeException
toException (TypeError TypeError
e) = TypeError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException TypeError
e
#endif
toException (ArithException ArithException
e) = ArithException -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ArithException
e
toException (ArrayException ArrayException
e) = ArrayException -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ArrayException
e
toException (AssertionFailed AssertionFailed
e) = AssertionFailed -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException AssertionFailed
e
toException (ErrorCall ErrorCall
e) = ErrorCall -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ErrorCall
e
toException (NestedAtomically NestedAtomically
e) = NestedAtomically -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException NestedAtomically
e
toException (NoMethodError NoMethodError
e) = NoMethodError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException NoMethodError
e
toException (PatternMatchFail PatternMatchFail
e) = PatternMatchFail -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException PatternMatchFail
e
toException (RecConError RecConError
e) = RecConError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException RecConError
e
toException (RecSelError RecSelError
e) = RecSelError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException RecSelError
e
toException (RecUpdError RecSelError
e) = RecSelError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException RecSelError
e
fromException :: SomeException -> Maybe ProgrammerError
fromException SomeException
e =
#if MIN_VERSION_base(4,9,0)
TypeError -> ProgrammerError
TypeError (TypeError -> ProgrammerError)
-> Maybe TypeError -> Maybe ProgrammerError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe TypeError
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ProgrammerError
-> Maybe ProgrammerError -> Maybe ProgrammerError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
#endif
ArithException -> ProgrammerError
ArithException (ArithException -> ProgrammerError)
-> Maybe ArithException -> Maybe ProgrammerError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe ArithException
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ProgrammerError
-> Maybe ProgrammerError -> Maybe ProgrammerError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
ArrayException -> ProgrammerError
ArrayException (ArrayException -> ProgrammerError)
-> Maybe ArrayException -> Maybe ProgrammerError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe ArrayException
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ProgrammerError
-> Maybe ProgrammerError -> Maybe ProgrammerError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
AssertionFailed -> ProgrammerError
AssertionFailed (AssertionFailed -> ProgrammerError)
-> Maybe AssertionFailed -> Maybe ProgrammerError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe AssertionFailed
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ProgrammerError
-> Maybe ProgrammerError -> Maybe ProgrammerError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
ErrorCall -> ProgrammerError
ErrorCall (ErrorCall -> ProgrammerError)
-> Maybe ErrorCall -> Maybe ProgrammerError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe ErrorCall
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ProgrammerError
-> Maybe ProgrammerError -> Maybe ProgrammerError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
NestedAtomically -> ProgrammerError
NestedAtomically (NestedAtomically -> ProgrammerError)
-> Maybe NestedAtomically -> Maybe ProgrammerError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe NestedAtomically
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ProgrammerError
-> Maybe ProgrammerError -> Maybe ProgrammerError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
NoMethodError -> ProgrammerError
NoMethodError (NoMethodError -> ProgrammerError)
-> Maybe NoMethodError -> Maybe ProgrammerError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe NoMethodError
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ProgrammerError
-> Maybe ProgrammerError -> Maybe ProgrammerError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
PatternMatchFail -> ProgrammerError
PatternMatchFail (PatternMatchFail -> ProgrammerError)
-> Maybe PatternMatchFail -> Maybe ProgrammerError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe PatternMatchFail
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ProgrammerError
-> Maybe ProgrammerError -> Maybe ProgrammerError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
RecConError -> ProgrammerError
RecConError (RecConError -> ProgrammerError)
-> Maybe RecConError -> Maybe ProgrammerError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe RecConError
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ProgrammerError
-> Maybe ProgrammerError -> Maybe ProgrammerError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
RecSelError -> ProgrammerError
RecSelError (RecSelError -> ProgrammerError)
-> Maybe RecSelError -> Maybe ProgrammerError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe RecSelError
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ProgrammerError
-> Maybe ProgrammerError -> Maybe ProgrammerError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
RecSelError -> ProgrammerError
RecUpdError (RecSelError -> ProgrammerError)
-> Maybe RecSelError -> Maybe ProgrammerError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe RecSelError
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e
data ExternalError =
#if MIN_VERSION_base(4,10,0)
CompactionFailed Ex.CompactionFailed |
#endif
#if MIN_VERSION_base(4,11,0)
FixIOException Ex.FixIOException |
#endif
#if MIN_VERSION_base(4,7,0)
AsyncException Ex.SomeAsyncException |
#else
AsyncException Ex.AsyncException |
#endif
BlockedIndefinitelyOnSTM Ex.BlockedIndefinitelyOnSTM |
BlockedIndefinitelyOnMVar Ex.BlockedIndefinitelyOnMVar |
Deadlock Ex.Deadlock |
NonTermination Ex.NonTermination
deriving (Int -> ExternalError -> ShowS
[ExternalError] -> ShowS
ExternalError -> String
(Int -> ExternalError -> ShowS)
-> (ExternalError -> String)
-> ([ExternalError] -> ShowS)
-> Show ExternalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternalError] -> ShowS
$cshowList :: [ExternalError] -> ShowS
show :: ExternalError -> String
$cshow :: ExternalError -> String
showsPrec :: Int -> ExternalError -> ShowS
$cshowsPrec :: Int -> ExternalError -> ShowS
Show, Typeable)
instance Ex.Exception ExternalError where
#if MIN_VERSION_base(4,10,0)
toException :: ExternalError -> SomeException
toException (CompactionFailed CompactionFailed
e) = CompactionFailed -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException CompactionFailed
e
#endif
#if MIN_VERSION_base(4,11,0)
toException (FixIOException FixIOException
e) = FixIOException -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException FixIOException
e
#endif
toException (AsyncException SomeAsyncException
e) = SomeAsyncException -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException SomeAsyncException
e
toException (BlockedIndefinitelyOnMVar BlockedIndefinitelyOnMVar
e) = BlockedIndefinitelyOnMVar -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException BlockedIndefinitelyOnMVar
e
toException (BlockedIndefinitelyOnSTM BlockedIndefinitelyOnSTM
e) = BlockedIndefinitelyOnSTM -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException BlockedIndefinitelyOnSTM
e
toException (Deadlock Deadlock
e) = Deadlock -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException Deadlock
e
toException (NonTermination NonTermination
e) = NonTermination -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException NonTermination
e
fromException :: SomeException -> Maybe ExternalError
fromException SomeException
e =
#if MIN_VERSION_base(4,10,0)
CompactionFailed -> ExternalError
CompactionFailed (CompactionFailed -> ExternalError)
-> Maybe CompactionFailed -> Maybe ExternalError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe CompactionFailed
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ExternalError -> Maybe ExternalError -> Maybe ExternalError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
#endif
#if MIN_VERSION_base(4,11,0)
FixIOException -> ExternalError
FixIOException (FixIOException -> ExternalError)
-> Maybe FixIOException -> Maybe ExternalError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe FixIOException
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ExternalError -> Maybe ExternalError -> Maybe ExternalError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
#endif
SomeAsyncException -> ExternalError
AsyncException (SomeAsyncException -> ExternalError)
-> Maybe SomeAsyncException -> Maybe ExternalError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ExternalError -> Maybe ExternalError -> Maybe ExternalError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
BlockedIndefinitelyOnSTM -> ExternalError
BlockedIndefinitelyOnSTM (BlockedIndefinitelyOnSTM -> ExternalError)
-> Maybe BlockedIndefinitelyOnSTM -> Maybe ExternalError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe BlockedIndefinitelyOnSTM
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ExternalError -> Maybe ExternalError -> Maybe ExternalError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
BlockedIndefinitelyOnMVar -> ExternalError
BlockedIndefinitelyOnMVar (BlockedIndefinitelyOnMVar -> ExternalError)
-> Maybe BlockedIndefinitelyOnMVar -> Maybe ExternalError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe BlockedIndefinitelyOnMVar
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ExternalError -> Maybe ExternalError -> Maybe ExternalError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Deadlock -> ExternalError
Deadlock (Deadlock -> ExternalError)
-> Maybe Deadlock -> Maybe ExternalError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe Deadlock
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e Maybe ExternalError -> Maybe ExternalError -> Maybe ExternalError
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
NonTermination -> ExternalError
NonTermination (NonTermination -> ExternalError)
-> Maybe NonTermination -> Maybe ExternalError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe NonTermination
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e
newtype SomeNonPseudoException = SomeNonPseudoException Ex.SomeException deriving (Int -> SomeNonPseudoException -> ShowS
[SomeNonPseudoException] -> ShowS
SomeNonPseudoException -> String
(Int -> SomeNonPseudoException -> ShowS)
-> (SomeNonPseudoException -> String)
-> ([SomeNonPseudoException] -> ShowS)
-> Show SomeNonPseudoException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SomeNonPseudoException] -> ShowS
$cshowList :: [SomeNonPseudoException] -> ShowS
show :: SomeNonPseudoException -> String
$cshow :: SomeNonPseudoException -> String
showsPrec :: Int -> SomeNonPseudoException -> ShowS
$cshowsPrec :: Int -> SomeNonPseudoException -> ShowS
Show, Typeable)
instance Ex.Exception SomeNonPseudoException where
toException :: SomeNonPseudoException -> SomeException
toException (SomeNonPseudoException SomeException
e) = SomeException
e
fromException :: SomeException -> Maybe SomeNonPseudoException
fromException SomeException
e = case SomeException -> Maybe PseudoException
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e of
Just PseudoException
pseudo -> Maybe SomeNonPseudoException
-> PseudoException -> Maybe SomeNonPseudoException
forall a b. a -> b -> a
const Maybe SomeNonPseudoException
forall a. Maybe a
Nothing (PseudoException
pseudo :: PseudoException)
Maybe PseudoException
Nothing -> SomeNonPseudoException -> Maybe SomeNonPseudoException
forall a. a -> Maybe a
Just (SomeException -> SomeNonPseudoException
SomeNonPseudoException SomeException
e)
throwIO :: (Ex.Exception e) => e -> IO a
throwIO :: forall e a. Exception e => e -> IO a
throwIO = e -> IO a
forall e a. Exception e => e -> IO a
Ex.throwIO
#else
import System.IO.Error (IOError, ioError, try)
type SomeNonPseudoException = IOError
throwIO :: SomeNonPseudoException -> IO a
throwIO = ioError
#endif
newtype UIO a = UIO (IO a)
instance Functor UIO where
fmap :: forall a b. (a -> b) -> UIO a -> UIO b
fmap = (a -> b) -> UIO a -> UIO b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative UIO where
pure :: forall a. a -> UIO a
pure = a -> UIO a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. UIO (a -> b) -> UIO a -> UIO b
(<*>) = UIO (a -> b) -> UIO a -> UIO b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad UIO where
return :: forall a. a -> UIO a
return = IO a -> UIO a
forall a. IO a -> UIO a
UIO (IO a -> UIO a) -> (a -> IO a) -> a -> UIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
(UIO IO a
x) >>= :: forall a b. UIO a -> (a -> UIO b) -> UIO b
>>= a -> UIO b
f = IO b -> UIO b
forall a. IO a -> UIO a
UIO (IO a
x IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIO b -> IO b
forall a. UIO a -> IO a
run (UIO b -> IO b) -> (a -> UIO b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UIO b
f)
#if !MIN_VERSION_base(4,13,0)
fail s = error $ "UnexceptionalIO cannot fail (" ++ s ++ ")"
#endif
instance MonadFix UIO where
mfix :: forall a. (a -> UIO a) -> UIO a
mfix a -> UIO a
f = IO a -> UIO a
forall a. IO a -> UIO a
UIO ((a -> IO a) -> IO a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((a -> IO a) -> IO a) -> (a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ UIO a -> IO a
forall a. UIO a -> IO a
run (UIO a -> IO a) -> (a -> UIO a) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UIO a
f)
class (Monad m) => Unexceptional m where
lift :: UIO a -> m a
instance Unexceptional UIO where
lift :: forall a. UIO a -> UIO a
lift = UIO a -> UIO a
forall a. a -> a
id
instance Unexceptional IO where
lift :: forall a. UIO a -> IO a
lift = UIO a -> IO a
forall a. UIO a -> IO a
run
fromIO :: (Unexceptional m) => IO a -> m (Either SomeNonPseudoException a)
fromIO :: forall (m :: * -> *) a.
Unexceptional m =>
IO a -> m (Either SomeNonPseudoException a)
fromIO = IO (Either SomeNonPseudoException a)
-> m (Either SomeNonPseudoException a)
forall (m :: * -> *) a. Unexceptional m => IO a -> m a
unsafeFromIO (IO (Either SomeNonPseudoException a)
-> m (Either SomeNonPseudoException a))
-> (IO a -> IO (Either SomeNonPseudoException a))
-> IO a
-> m (Either SomeNonPseudoException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either SomeNonPseudoException a)
forall e a. Exception e => IO a -> IO (Either e a)
try
#ifdef __GLASGOW_HASKELL__
fromIO' :: (Ex.Exception e, Unexceptional m) =>
(SomeNonPseudoException -> e)
-> IO a
-> m (Either e a)
fromIO' :: forall e (m :: * -> *) a.
(Exception e, Unexceptional m) =>
(SomeNonPseudoException -> e) -> IO a -> m (Either e a)
fromIO' SomeNonPseudoException -> e
f = (Either SomeNonPseudoException (Either e a) -> Either e a)
-> m (Either SomeNonPseudoException (Either e a)) -> m (Either e a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((SomeNonPseudoException -> Either e a)
-> (Either e a -> Either e a)
-> Either SomeNonPseudoException (Either e a)
-> Either e a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a)
-> (SomeNonPseudoException -> e)
-> SomeNonPseudoException
-> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeNonPseudoException -> e
f) Either e a -> Either e a
forall a. a -> a
id) (m (Either SomeNonPseudoException (Either e a)) -> m (Either e a))
-> (IO a -> m (Either SomeNonPseudoException (Either e a)))
-> IO a
-> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either e a) -> m (Either SomeNonPseudoException (Either e a))
forall (m :: * -> *) a.
Unexceptional m =>
IO a -> m (Either SomeNonPseudoException a)
fromIO (IO (Either e a) -> m (Either SomeNonPseudoException (Either e a)))
-> (IO a -> IO (Either e a))
-> IO a
-> m (Either SomeNonPseudoException (Either e a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either e a)
forall e a. Exception e => IO a -> IO (Either e a)
try
#endif
run :: UIO a -> IO a
run :: forall a. UIO a -> IO a
run (UIO IO a
io) = IO a
io
#ifdef __GLASGOW_HASKELL__
runEitherIO :: (Ex.Exception e) => UIO (Either e a) -> IO a
#else
runEitherIO :: UIO (Either SomeNonPseudoException a) -> IO a
#endif
runEitherIO :: forall e a. Exception e => UIO (Either e a) -> IO a
runEitherIO = (e -> IO a) -> (a -> IO a) -> Either e a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> IO a
forall e a. Exception e => e -> IO a
throwIO a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> IO a)
-> (UIO (Either e a) -> IO (Either e a))
-> UIO (Either e a)
-> IO a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< UIO (Either e a) -> IO (Either e a)
forall a. UIO a -> IO a
run
unsafeFromIO :: (Unexceptional m) => IO a -> m a
unsafeFromIO :: forall (m :: * -> *) a. Unexceptional m => IO a -> m a
unsafeFromIO = UIO a -> m a
forall (m :: * -> *) a. Unexceptional m => UIO a -> m a
lift (UIO a -> m a) -> (IO a -> UIO a) -> IO a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> UIO a
forall a. IO a -> UIO a
UIO
#ifdef __GLASGOW_HASKELL__
bracket :: (Unexceptional m) => UIO a -> (a -> UIO ()) -> (a -> UIO c) -> m c
bracket :: forall (m :: * -> *) a c.
Unexceptional m =>
UIO a -> (a -> UIO ()) -> (a -> UIO c) -> m c
bracket UIO a
acquire a -> UIO ()
release a -> UIO c
body =
IO c -> m c
forall (m :: * -> *) a. Unexceptional m => IO a -> m a
unsafeFromIO (IO c -> m c) -> IO c -> m c
forall a b. (a -> b) -> a -> b
$ IO a -> (a -> IO ()) -> (a -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Ex.bracket (UIO a -> IO a
forall a. UIO a -> IO a
run UIO a
acquire) (UIO () -> IO ()
forall a. UIO a -> IO a
run (UIO () -> IO ()) -> (a -> UIO ()) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UIO ()
release) (UIO c -> IO c
forall a. UIO a -> IO a
run (UIO c -> IO c) -> (a -> UIO c) -> a -> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UIO c
body)
#if MIN_VERSION_base(4,7,0)
forkFinally :: (Unexceptional m) => UIO a -> (Either PseudoException a -> UIO ()) -> m Concurrent.ThreadId
forkFinally :: forall (m :: * -> *) a.
Unexceptional m =>
UIO a -> (Either PseudoException a -> UIO ()) -> m ThreadId
forkFinally UIO a
body Either PseudoException a -> UIO ()
handler = IO ThreadId -> m ThreadId
forall (m :: * -> *) a. Unexceptional m => IO a -> m a
unsafeFromIO (IO ThreadId -> m ThreadId) -> IO ThreadId -> m ThreadId
forall a b. (a -> b) -> a -> b
$ IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
Concurrent.forkFinally (UIO a -> IO a
forall a. UIO a -> IO a
run UIO a
body) ((Either SomeException a -> IO ()) -> IO ThreadId)
-> (Either SomeException a -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \Either SomeException a
result ->
case Either SomeException a
result of
Left SomeException
e -> case SomeException -> Maybe PseudoException
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e of
Just PseudoException
pseudo -> UIO () -> IO ()
forall a. UIO a -> IO a
run (UIO () -> IO ()) -> UIO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Either PseudoException a -> UIO ()
handler (Either PseudoException a -> UIO ())
-> Either PseudoException a -> UIO ()
forall a b. (a -> b) -> a -> b
$ PseudoException -> Either PseudoException a
forall a b. a -> Either a b
Left PseudoException
pseudo
Maybe PseudoException
Nothing -> String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Bug in UnexceptionalIO: forkFinally caught a non-PseudoException: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
Right a
x -> UIO () -> IO ()
forall a. UIO a -> IO a
run (UIO () -> IO ()) -> UIO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Either PseudoException a -> UIO ()
handler (Either PseudoException a -> UIO ())
-> Either PseudoException a -> UIO ()
forall a b. (a -> b) -> a -> b
$ a -> Either PseudoException a
forall a b. b -> Either a b
Right a
x
fork :: (Unexceptional m) => UIO () -> m Concurrent.ThreadId
fork :: forall (m :: * -> *). Unexceptional m => UIO () -> m ThreadId
fork UIO ()
body = do
ThreadId
parent <- IO ThreadId -> m ThreadId
forall (m :: * -> *) a. Unexceptional m => IO a -> m a
unsafeFromIO IO ThreadId
Concurrent.myThreadId
UIO () -> (Either PseudoException () -> UIO ()) -> m ThreadId
forall (m :: * -> *) a.
Unexceptional m =>
UIO a -> (Either PseudoException a -> UIO ()) -> m ThreadId
forkFinally UIO ()
body ((Either PseudoException () -> UIO ()) -> m ThreadId)
-> (Either PseudoException () -> UIO ()) -> m ThreadId
forall a b. (a -> b) -> a -> b
$ (PseudoException -> UIO ())
-> (() -> UIO ()) -> Either PseudoException () -> UIO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ThreadId -> PseudoException -> UIO ()
forall {m :: * -> *}.
Unexceptional m =>
ThreadId -> PseudoException -> m ()
handler ThreadId
parent) (UIO () -> () -> UIO ()
forall a b. a -> b -> a
const (UIO () -> () -> UIO ()) -> UIO () -> () -> UIO ()
forall a b. (a -> b) -> a -> b
$ () -> UIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
where
handler :: ThreadId -> PseudoException -> m ()
handler ThreadId
parent PseudoException
e
| Just AsyncException
Ex.ThreadKilled <- PseudoException -> Maybe AsyncException
forall e1 e2. (Exception e1, Exception e2) => e1 -> Maybe e2
castException PseudoException
e = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just (Ex.SomeAsyncException e
_) <- PseudoException -> Maybe SomeAsyncException
forall e1 e2. (Exception e1, Exception e2) => e1 -> Maybe e2
castException PseudoException
e =
IO () -> m ()
forall (m :: * -> *) a. Unexceptional m => IO a -> m a
unsafeFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> PseudoException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
Concurrent.throwTo ThreadId
parent PseudoException
e
| Just ExitCode
e <- PseudoException -> Maybe ExitCode
forall e1 e2. (Exception e1, Exception e2) => e1 -> Maybe e2
castException PseudoException
e =
IO () -> m ()
forall (m :: * -> *) a. Unexceptional m => IO a -> m a
unsafeFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> ExitCode -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
Concurrent.throwTo ThreadId
parent (ExitCode
e :: ExitCode)
| Bool
otherwise = IO () -> m ()
forall (m :: * -> *) a. Unexceptional m => IO a -> m a
unsafeFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> ChildThreadError -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
Concurrent.throwTo ThreadId
parent (PseudoException -> ChildThreadError
ChildThreadError PseudoException
e)
castException :: (Ex.Exception e1, Ex.Exception e2) => e1 -> Maybe e2
castException :: forall e1 e2. (Exception e1, Exception e2) => e1 -> Maybe e2
castException = SomeException -> Maybe e2
forall e. Exception e => SomeException -> Maybe e
Ex.fromException (SomeException -> Maybe e2)
-> (e1 -> SomeException) -> e1 -> Maybe e2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException
newtype ChildThreadError = ChildThreadError PseudoException deriving (Int -> ChildThreadError -> ShowS
[ChildThreadError] -> ShowS
ChildThreadError -> String
(Int -> ChildThreadError -> ShowS)
-> (ChildThreadError -> String)
-> ([ChildThreadError] -> ShowS)
-> Show ChildThreadError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChildThreadError] -> ShowS
$cshowList :: [ChildThreadError] -> ShowS
show :: ChildThreadError -> String
$cshow :: ChildThreadError -> String
showsPrec :: Int -> ChildThreadError -> ShowS
$cshowsPrec :: Int -> ChildThreadError -> ShowS
Show, Typeable)
instance Ex.Exception ChildThreadError where
toException :: ChildThreadError -> SomeException
toException = ChildThreadError -> SomeException
forall e. Exception e => e -> SomeException
Ex.asyncExceptionToException
fromException :: SomeException -> Maybe ChildThreadError
fromException = SomeException -> Maybe ChildThreadError
forall e. Exception e => SomeException -> Maybe e
Ex.asyncExceptionFromException
#endif
#endif