module UnexceptionalIO (
UnexceptionalIO,
fromIO,
runUnexceptionalIO,
runEitherIO,
fromIO',
unsafeFromIO
) where
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap, (<=<))
import Control.Monad.Fix (MonadFix(..))
import Control.Error (syncIO, mapEitherT, EitherT(..), fmapLT)
import Control.Exception (SomeException, Exception, fromException, throwIO)
import Control.Monad.IO.Class (liftIO, MonadIO)
newtype UnexceptionalIO a = UnexceptionalIO (IO a)
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 -> EitherT SomeException UnexceptionalIO a
fromIO = mapEitherT unsafeFromIO . syncIO
runUnexceptionalIO :: (MonadIO m) => UnexceptionalIO a -> m a
runUnexceptionalIO (UnexceptionalIO io) = liftIO io
runEitherIO :: (MonadIO m, Exception e) => EitherT e UnexceptionalIO a -> m a
runEitherIO = either (liftIO . throwIO) return <=< runUnexceptionalIO . runEitherT
fromIO' :: (Exception e) => IO a -> EitherT e UnexceptionalIO a
fromIO' = fmapLT (maybePartial . fromException) . fromIO
where
maybePartial (Just x) = x
maybePartial Nothing = error "UnexceptionalIO.fromIO' exception of unspecified type"
unsafeFromIO :: IO a -> UnexceptionalIO a
unsafeFromIO = UnexceptionalIO