interruptible/src/Control/Monad/Trans/SafeIO.hs

{-# LANGUAGE FlexibleContexts #-}
{- |

-}
module Control.Monad.Trans.SafeIO where

import System.IO.Error
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Either
import Control.Monad.Trans.Control
import qualified Control.Exception.Lifted as Lift

class IOErrorDerivation e where
  coerceIOError :: IOError -> e

safeIO :: (MonadIO m, IOErrorDerivation e) => IO a -> EitherT e m a
safeIO io = (liftIO $ tryIOError io) >>= hoistResult

safeCT :: (MonadBaseControl IO m, IOErrorDerivation e) => m a -> EitherT e m a
safeCT f = (lift $ Lift.try f) >>= hoistResult

hoistResult :: (IOErrorDerivation e, Monad m) => Either IOError a -> EitherT e m a
hoistResult (Left e) = left . coerceIOError $ e
hoistResult (Right v) = right v