module UnexceptionalIO (
UnexceptionalIO,
UIO,
fromIO,
runUnexceptionalIO,
runEitherIO,
#ifdef __GLASGOW_HASKELL__
fromIO',
#endif
unsafeFromIO,
syncIO
) where
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap, (<=<))
import Control.Monad.Fix (MonadFix(..))
#ifdef __GLASGOW_HASKELL__
import Data.Dynamic (Dynamic)
import System.Exit (ExitCode)
import qualified Control.Exception as Ex
type SomeException = Ex.SomeException
throwIO :: (Ex.Exception e) => e -> IO a
throwIO = Ex.throwIO
#else
import System.IO.Error (IOError, ioError, try)
type SomeException = IOError
throwIO :: SomeException -> IO a
throwIO = ioError
#endif
newtype UnexceptionalIO a = UnexceptionalIO (IO a)
type UIO = UnexceptionalIO
instance Functor UnexceptionalIO where
fmap = liftM
instance Applicative UnexceptionalIO where
pure = return
(<*>) = ap
instance Monad UnexceptionalIO where
return = UnexceptionalIO . return
(UnexceptionalIO x) >>= f = UnexceptionalIO (x >>= runUnexceptionalIO . f)
fail s = error $ "UnexceptionalIO cannot fail (" ++ s ++ ")"
instance MonadFix UnexceptionalIO where
mfix f = UnexceptionalIO (mfix $ runUnexceptionalIO . f)
fromIO :: IO a -> UnexceptionalIO (Either SomeException a)
fromIO = unsafeFromIO . syncIO
runUnexceptionalIO :: UnexceptionalIO a -> IO a
runUnexceptionalIO (UnexceptionalIO io) = io
#ifdef __GLASGOW_HASKELL__
runEitherIO :: (Ex.Exception e) => UnexceptionalIO (Either e a) -> IO a
#else
runEitherIO :: UnexceptionalIO (Either SomeException a) -> IO a
#endif
runEitherIO = either throwIO return <=< runUnexceptionalIO
#ifdef __GLASGOW_HASKELL__
fromIO' :: (Ex.Exception e) => IO a -> UnexceptionalIO (Either e a)
fromIO' =
(return . either (Left . maybePartial . Ex.fromException) Right) <=< fromIO
where
maybePartial (Just x) = x
maybePartial Nothing = error "UnexceptionalIO.fromIO' exception of unspecified type"
#endif
unsafeFromIO :: IO a -> UnexceptionalIO a
unsafeFromIO = UnexceptionalIO
syncIO :: IO a -> IO (Either SomeException a)
#ifdef __GLASGOW_HASKELL__
syncIO a = Ex.catches (fmap Right a) [
Ex.Handler (\e -> Ex.throwIO (e :: Ex.ArithException)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.ArrayException)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.AssertionFailed)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.AsyncException)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.BlockedIndefinitelyOnMVar)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.BlockedIndefinitelyOnSTM)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.Deadlock)),
Ex.Handler (\e -> Ex.throwIO (e :: Dynamic)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.ErrorCall)),
Ex.Handler (\e -> Ex.throwIO (e :: ExitCode)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.NestedAtomically)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.NoMethodError)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.NonTermination)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.PatternMatchFail)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.RecConError)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.RecSelError)),
Ex.Handler (\e -> Ex.throwIO (e :: Ex.RecUpdError)),
Ex.Handler (return . Left)
]
#else
syncIO = try
#endif