{-# LANGUAGE CPP #-}
-- | 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,
run,
runEitherIO,
-- * Unsafe entry points
#ifdef __GLASGOW_HASKELL__
fromIO',
#endif
unsafeFromIO,
-- * Pseudo exceptions
SomeNonPseudoException,
#ifdef __GLASGOW_HASKELL__
PseudoException(..),
ProgrammerError(..),
ExternalError(..),
-- * Pseudo exception helpers
bracket,
#if MIN_VERSION_base(4,6,0)
forkFinally,
fork
#endif
#endif
) where
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 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 pseudo-exceptions you usually
-- can do nothing about, just log or exit.
--
-- Additionally, except for 'ExitCode' any of these psuedo-exceptions
-- you could never guarentee 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 (Show)
instance Ex.Exception PseudoException where
toException (ProgrammerError e) = Ex.toException e
toException (ExternalError e) = Ex.toException e
toException (Exit e) = Ex.toException e
fromException e =
ProgrammerError <$> Ex.fromException e <|>
ExternalError <$> Ex.fromException e <|>
Exit <$> Ex.fromException 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 (Show)
instance Ex.Exception ProgrammerError where
#if MIN_VERSION_base(4,9,0)
toException (TypeError e) = Ex.toException e
#endif
toException (ArithException e) = Ex.toException e
toException (ArrayException e) = Ex.toException e
toException (AssertionFailed e) = Ex.toException e
toException (ErrorCall e) = Ex.toException e
toException (NestedAtomically e) = Ex.toException e
toException (NoMethodError e) = Ex.toException e
toException (PatternMatchFail e) = Ex.toException e
toException (RecConError e) = Ex.toException e
toException (RecSelError e) = Ex.toException e
toException (RecUpdError e) = Ex.toException e
fromException e =
#if MIN_VERSION_base(4,9,0)
TypeError <$> Ex.fromException e <|>
#endif
ArithException <$> Ex.fromException e <|>
ArrayException <$> Ex.fromException e <|>
AssertionFailed <$> Ex.fromException e <|>
ErrorCall <$> Ex.fromException e <|>
NestedAtomically <$> Ex.fromException e <|>
NoMethodError <$> Ex.fromException e <|>
PatternMatchFail <$> Ex.fromException e <|>
RecConError <$> Ex.fromException e <|>
RecSelError <$> Ex.fromException e <|>
RecUpdError <$> Ex.fromException 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 (Show)
instance Ex.Exception ExternalError where
#if MIN_VERSION_base(4,10,0)
toException (CompactionFailed e) = Ex.toException e
#endif
#if MIN_VERSION_base(4,11,0)
toException (FixIOException e) = Ex.toException e
#endif
toException (AsyncException e) = Ex.toException e
toException (BlockedIndefinitelyOnMVar e) = Ex.toException e
toException (BlockedIndefinitelyOnSTM e) = Ex.toException e
toException (Deadlock e) = Ex.toException e
toException (NonTermination e) = Ex.toException e
fromException e =
#if MIN_VERSION_base(4,10,0)
CompactionFailed <$> Ex.fromException e <|>
#endif
#if MIN_VERSION_base(4,11,0)
FixIOException <$> Ex.fromException e <|>
#endif
AsyncException <$> Ex.fromException e <|>
BlockedIndefinitelyOnSTM <$> Ex.fromException e <|>
BlockedIndefinitelyOnMVar <$> Ex.fromException e <|>
Deadlock <$> Ex.fromException e <|>
NonTermination <$> Ex.fromException e
-- | Every 'Ex.SomeException' but 'PseudoException'
newtype SomeNonPseudoException = SomeNonPseudoException Ex.SomeException deriving (Show)
instance Ex.Exception SomeNonPseudoException where
toException (SomeNonPseudoException e) = e
fromException e = case Ex.fromException e of
Just pseudo -> const Nothing (pseudo :: PseudoException)
Nothing -> Just (SomeNonPseudoException e)
throwIO :: (Ex.Exception e) => e -> IO a
throwIO = Ex.throwIO
#else
-- Haskell98 import 'IO' instead
import System.IO.Error (IOError, ioError, try)
type SomeNonPseudoException = IOError
throwIO :: SomeNonPseudoException -> IO a
throwIO = ioError
#endif
-- | IO without any 'PseudoException'
newtype UIO a = UIO (IO a)
instance Functor UIO where
fmap = liftM
instance Applicative UIO where
pure = return
(<*>) = ap
instance Monad UIO where
return = UIO . return
(UIO x) >>= f = UIO (x >>= run . f)
fail s = error $ "UnexceptionalIO cannot fail (" ++ s ++ ")"
instance MonadFix UIO where
mfix f = UIO (mfix $ run . f)
-- | Polymorphic base without any 'PseudoException'
class (Monad m) => Unexceptional m where
lift :: UIO a -> m a
instance Unexceptional UIO where
lift = id
instance Unexceptional IO where
lift = run
-- | Catch any exception but 'PseudoException' in an 'IO' action
fromIO :: (Unexceptional m) => IO a -> m (Either SomeNonPseudoException a)
fromIO = unsafeFromIO . try
-- | Re-embed 'UIO' into 'IO'
run :: UIO a -> IO a
run (UIO io) = 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 = either throwIO return <=< run
#ifdef __GLASGOW_HASKELL__
-- | You promise that 'e' covers all exceptions but 'PseudoException'
-- thrown by this 'IO' action
--
-- This function is partial if you lie
fromIO' :: (Ex.Exception e, Unexceptional m) => IO a -> m (Either e a)
fromIO' =
(return . either (Left . maybePartial . Ex.fromException . Ex.toException) Right) <=< fromIO
where
maybePartial (Just x) = x
maybePartial Nothing = error "UnexceptionalIO.fromIO' exception of unspecified type"
#endif
-- | You promise there are no exceptions but 'PseudoException' thrown by this 'IO' action
unsafeFromIO :: (Unexceptional m) => IO a -> m a
unsafeFromIO = lift . 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 acquire release body =
unsafeFromIO $ Ex.bracket (run acquire) (run . release) (run . body)
#if MIN_VERSION_base(4,6,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 body handler = unsafeFromIO $ Concurrent.forkFinally (run body) $ \result ->
case result of
Left e -> case Ex.fromException e of
Just pseudo -> run $ handler $ Left pseudo
Nothing -> error $ "Bug in UnexceptionalIO: forkFinally caught a non-PseudoException: " ++ show e
Right x -> run $ handler $ Right x
-- | Mirrors 'Concurrent.forkIO', but re-throws any 'PseudoException'
-- to the parent thread
fork :: (Unexceptional m) => UIO () -> m Concurrent.ThreadId
fork body = do
parent <- unsafeFromIO Concurrent.myThreadId
forkFinally body $
either (unsafeFromIO . Concurrent.throwTo parent) (const $ return ())
#endif
#endif