{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{- |
Module defining the type for exception free I/O.
Exceptional results in SIO must be represented by traditional error codes.

If you want to turn an IO action into 'SIO'
you must convert it to @ExceptionalT IOException SIO a@
by 'ioToExceptionalSIO' (or 'Control.Monad.Trans.liftIO')
and then handle the 'IOException's using 'SyncExc.resolveT'.
-}
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.Trans (MonadIO, liftIO, )

import System.IO.Unsafe (unsafeInterleaveIO, )


{- |
An I/O action of type 'SIO' cannot skip following SIO actions
as a result of exceptional outcomes like \"File not found\".
However an 'error' can well break the program.
-}
newtype SIO a = SIO (IO a) -- {sioToIO :: 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

-- helper classes for defining the MonadIO instance of SIO

{-
It's important that no-one else can define instances of MonadSIO
because we cannot assert absence of exceptions in other monads.
It is also important not to export 'toSIO',
since we can also not assert absence of exceptions in IO actions.
-}
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