{-# 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.IO.Class (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

{- |
Users of the library may define new instances of MonadSIO,
but monads other than SIO may not make the absence of exceptions explicit.
It is important however, that we do not make the method 'toSIO' public,
since this would allow users
the unsafe conversion from @IO@ to @SIO@.
-}
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