{-# LANGUAGE FlexibleContexts #-}
{- |
==The problem:

In Haskell it is usually simple to keep IOError bounded within a context,
so that they can not interfere with the overall execution of a program. Since functional
substitution is done in a hierarchical way, often a single try or catch statement is
enough to treat all errors on an entire section of code.

Interruptible monad transformers turn this realitty upside down. Since the entire point
of this type class is separating the hierarchical code organization from the monadic
contexts, it becomes usefull to keep the exceptions information at the monadic context,
instead of the default of carrying it in the code hierarchy.

That is, in the following example:

@
do
    let ct1 = createContext 1
        ct2 = createContext 2
    ct1' <- resume startClient ct1
    ct2' <- resume startClient ct2
    resume finishClient ct1'
    resume finishClient ct2'
@

It may be desirable to let any IO exception on @startClient@ with the @ct1@ context
influence only the execution of @finishClient@ with the @ct1'@ context, and not
affect any execution with the other contexts.

SafeIO was created to enforce this kind of behavior.

==How to use:

1. Do not import Control.Monad.Trans, Control.Monad.IO or anything similar at your module.
2. Create an error type (let's call it @e@), and make it an instance of IOErrorDerivation.
3. Wrap your computation inside an @EitherT e@ transformer.
4. Use the safe functions on this module instead of lift, liftIO, liftBase, etc.

Remember that the context of interruptible transformers are in the inverse order that the
transformers appear on the stack, thus, at the end of execution if you want to retrieve
the EitherT context, you'll have to peel all the other contexts from it first.
-}
module Control.Monad.Trans.SafeIO (
  IOErrorDerivation(..),
  safeIO,
  safeCT
  )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 for types that keep IOError information. Instantiate this for an error type for
using the safe functions from this module.
-}
class IOErrorDerivation e where
  -- | Transforms an IOError on another error type
  coerceIOError :: IOError -> e

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

-- | Safe alternative to lift for an stack that implements MonadBaseControl.
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