module System.IO.Straight (
SIO, sioToIO, ioToExceptionalSIO, unsafeInterleaveSIO,
ExceptionalT, IOException,
) where
import Control.Monad.Exception.Synchronous
(Exceptional(Success, Exception), ExceptionalT(ExceptionalT), )
import qualified Control.Monad.Exception.Synchronous as SyncExc
import Control.Exception (IOException)
import System.IO.Error (try)
import Control.Monad.IO.Class (MonadIO, liftIO, )
import System.IO.Unsafe (unsafeInterleaveIO, )
newtype SIO a = SIO (IO a)
deriving (Functor, Monad)
sioToIO :: SIO a -> IO a
sioToIO (SIO x) = x
ioToExceptionalSIO :: IO a -> ExceptionalT IOException SIO a
ioToExceptionalSIO =
ExceptionalT . SIO . fmap (either Exception Success) . try
unsafeInterleaveSIO :: SIO a -> SIO a
unsafeInterleaveSIO (SIO io) = SIO $ unsafeInterleaveIO io
class Monad m => MonadSIO m where toSIO :: IO a -> m a
instance MonadSIO SIO where toSIO = SIO
class ContainsIOException e where fromIOException :: IOException -> e
instance ContainsIOException IOException where fromIOException = id
instance (MonadSIO m, ContainsIOException e) =>
MonadIO (ExceptionalT e m) where
liftIO =
ExceptionalT . toSIO .
fmap (either (Exception . fromIOException) Success) . try