{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
#endif
-- | When you've caught all the exceptions that can be handled safely,
--   this is what you're left with.
--
-- > runEitherIO . fromIO ≡ id
--
-- It is intended that you use qualified imports with this library.
--
-- > import UnexceptionalIO (UIO)
-- > import qualified UnexceptionalIO as UIO
module UnexceptionalIO (
	UIO,
	Unexceptional(..),
	fromIO,
#ifdef __GLASGOW_HASKELL__
	fromIO',
#endif
	run,
	runEitherIO,
	-- * Unsafe entry points
	unsafeFromIO,
	-- * Pseudo exceptions
	SomeNonPseudoException,
#ifdef __GLASGOW_HASKELL__
	PseudoException(..),
	ProgrammerError(..),
	ExternalError(..),
	-- * Pseudo exception helpers
	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

-- | Not everything handled by the exception system is a run-time error
-- you can handle.  This is the class of unrecoverable pseudo-exceptions.
--
-- Additionally, except for 'ExitCode' any of these pseudo-exceptions
-- you could never guarantee to have caught.  Since they can come
-- from anywhere at any time, we could never guarentee that 'UIO' does
-- not contain them.
data PseudoException =
	ProgrammerError ProgrammerError | -- ^ Mistakes programmers make
	ExternalError   ExternalError   | -- ^ Errors thrown by the runtime
	Exit ExitCode                     -- ^ Process exit requests
	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 e :: ProgrammerError
e) = ProgrammerError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ProgrammerError
e
	toException (ExternalError e :: ExternalError
e)   = ExternalError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ExternalError
e
	toException (Exit e :: ExitCode
e)            = ExitCode -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ExitCode
e

	fromException :: SomeException -> Maybe PseudoException
fromException e :: 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

-- | Pseudo-exceptions caused by a programming error
--
-- Partial functions, 'error', 'undefined', etc
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 e :: TypeError
e)           = TypeError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException TypeError
e
#endif
	toException (ArithException e :: ArithException
e)      = ArithException -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ArithException
e
	toException (ArrayException e :: ArrayException
e)      = ArrayException -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ArrayException
e
	toException (AssertionFailed e :: AssertionFailed
e)     = AssertionFailed -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException AssertionFailed
e
	toException (ErrorCall e :: ErrorCall
e)           = ErrorCall -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException ErrorCall
e
	toException (NestedAtomically e :: NestedAtomically
e)    = NestedAtomically -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException NestedAtomically
e
	toException (NoMethodError e :: NoMethodError
e)       = NoMethodError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException NoMethodError
e
	toException (PatternMatchFail e :: PatternMatchFail
e)    = PatternMatchFail -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException PatternMatchFail
e
	toException (RecConError e :: RecConError
e)         = RecConError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException RecConError
e
	toException (RecSelError e :: RecSelError
e)         = RecSelError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException RecSelError
e
	toException (RecUpdError e :: RecSelError
e)         = RecSelError -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException RecSelError
e

	fromException :: SomeException -> Maybe ProgrammerError
fromException e :: 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

-- | Pseudo-exceptions thrown by the runtime environment
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 e :: CompactionFailed
e)          = CompactionFailed -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException CompactionFailed
e
#endif
#if MIN_VERSION_base(4,11,0)
	toException (FixIOException e :: FixIOException
e)            = FixIOException -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException FixIOException
e
#endif
	toException (AsyncException e :: SomeAsyncException
e)            = SomeAsyncException -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException SomeAsyncException
e
	toException (BlockedIndefinitelyOnMVar e :: BlockedIndefinitelyOnMVar
e) = BlockedIndefinitelyOnMVar -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException BlockedIndefinitelyOnMVar
e
	toException (BlockedIndefinitelyOnSTM e :: BlockedIndefinitelyOnSTM
e)  = BlockedIndefinitelyOnSTM -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException BlockedIndefinitelyOnSTM
e
	toException (Deadlock e :: Deadlock
e)                  = Deadlock -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException Deadlock
e
	toException (NonTermination e :: NonTermination
e)            = NonTermination -> SomeException
forall e. Exception e => e -> SomeException
Ex.toException NonTermination
e

	fromException :: SomeException -> Maybe ExternalError
fromException e :: 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

-- | Every 'Ex.SomeException' but 'PseudoException'
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 e :: SomeException
e) = SomeException
e

	fromException :: SomeException -> Maybe SomeNonPseudoException
fromException e :: SomeException
e = case SomeException -> Maybe PseudoException
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e of
		Just pseudo :: PseudoException
pseudo -> Maybe SomeNonPseudoException
-> PseudoException -> Maybe SomeNonPseudoException
forall a b. a -> b -> a
const Maybe SomeNonPseudoException
forall a. Maybe a
Nothing (PseudoException
pseudo :: PseudoException)
		Nothing -> SomeNonPseudoException -> Maybe SomeNonPseudoException
forall a. a -> Maybe a
Just (SomeException -> SomeNonPseudoException
SomeNonPseudoException SomeException
e)

throwIO :: (Ex.Exception e) => e -> IO a
throwIO :: e -> IO a
throwIO = e -> IO a
forall e a. Exception e => e -> IO a
Ex.throwIO
#else
-- Haskell98 import 'IO' instead
import System.IO.Error (IOError, ioError, try)

type SomeNonPseudoException = IOError

throwIO :: SomeNonPseudoException -> IO a
throwIO = ioError
#endif

-- | Like IO, but throws only 'PseudoException'
newtype UIO a = UIO (IO a)

instance Functor UIO where
	fmap :: (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 :: a -> UIO a
pure = a -> UIO a
forall (m :: * -> *) a. Monad m => a -> m a
return
	<*> :: 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 :: 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 x :: IO a
x) >>= :: UIO a -> (a -> UIO b) -> UIO b
>>= f :: 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 :: (a -> UIO a) -> UIO a
mfix f :: 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)

-- | Monads in which 'UIO' computations may be embedded
class (Monad m) => Unexceptional m where
	lift :: UIO a -> m a

instance Unexceptional UIO where
	lift :: UIO a -> UIO a
lift = UIO a -> UIO a
forall a. a -> a
id

instance Unexceptional IO where
	lift :: UIO a -> IO a
lift = UIO a -> IO a
forall a. UIO a -> IO a
run

-- | Catch any exception but 'PseudoException' in an 'IO' action
fromIO :: (Unexceptional m) => IO a -> m (Either SomeNonPseudoException a)
fromIO :: 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__
-- | Catch any 'e' in an 'IO' action, with a default mapping for
--   unexpected cases
fromIO' :: (Ex.Exception e, Unexceptional m) =>
	(SomeNonPseudoException -> e) -- ^ Default if an unexpected exception occurs
	-> IO a
	-> m (Either e a)
fromIO' :: (SomeNonPseudoException -> e) -> IO a -> m (Either e a)
fromIO' f :: 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

-- | Re-embed 'UIO' into 'IO'
run :: UIO a -> IO a
run :: UIO a -> IO a
run (UIO io :: IO a
io) = IO a
io

-- | Re-embed 'UIO' and possible exception back into 'IO'
#ifdef __GLASGOW_HASKELL__
runEitherIO :: (Ex.Exception e) => UIO (Either e a) -> IO a
#else
runEitherIO :: UIO (Either SomeNonPseudoException a) -> IO a
#endif
runEitherIO :: 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

-- | You promise there are no exceptions but 'PseudoException' thrown by this 'IO' action
unsafeFromIO :: (Unexceptional m) => IO a -> m a
unsafeFromIO :: 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__
-- | When you're doing resource handling, 'PseudoException' matters.
--   You still need to use the 'Ex.bracket' pattern to handle cleanup.
bracket :: (Unexceptional m) => UIO a -> (a -> UIO ()) -> (a -> UIO c) -> m c
bracket :: UIO a -> (a -> UIO ()) -> (a -> UIO c) -> m c
bracket acquire :: UIO a
acquire release :: a -> UIO ()
release body :: 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)
-- | Mirrors 'Concurrent.forkFinally', but since the body is 'UIO',
--   the thread must terminate successfully or because of 'PseudoException'
forkFinally :: (Unexceptional m) => UIO a -> (Either PseudoException a -> UIO ()) -> m Concurrent.ThreadId
forkFinally :: UIO a -> (Either PseudoException a -> UIO ()) -> m ThreadId
forkFinally body :: UIO a
body handler :: 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
$ \result :: Either SomeException a
result ->
	case Either SomeException a
result of
		Left e :: SomeException
e -> case SomeException -> Maybe PseudoException
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
e of
			Just pseudo :: 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
			Nothing -> String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "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 x :: 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

-- | Mirrors 'Concurrent.forkIO', but re-throws errors to the parent thread
--
-- * Ignores manual thread kills, since those are on purpose.
-- * Re-throws async exceptions ('SomeAsyncException') as is.
-- * Re-throws 'ExitCode' as is in an attempt to exit with the requested code.
-- * Wraps synchronous 'PseudoException' in async 'ChildThreadError'.
fork :: (Unexceptional m) => UIO () -> m Concurrent.ThreadId
fork :: UIO () -> m ThreadId
fork body :: 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 parent :: ThreadId
parent e :: PseudoException
e
		-- Thread manually killed. I assume on purpose
		| Just 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 ()
		-- Async exception, nothing to do with this thread, propogate directly
		| Just (Ex.SomeAsyncException _) <- 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
		-- Attempt to manually end the process,
		-- not an async exception, so a bit dangerous to throw async'ly, but
		-- you really do want this to reach the top as-is for the exit code to
		-- work.
		| Just e :: 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)
		-- Non-async PseudoException, so wrap in an async wrapper before
		-- throwing async'ly
		| 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 :: 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

-- | Async signal that a child thread ended due to non-async PseudoException
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