{- |
Files with text content.
-}
module System.IO.Exception.TextFile where

import System.IO.Exception.File (EIO, close, )
import qualified Control.Monad.Exception.Synchronous  as Sync
import qualified Control.Monad.Exception.Asynchronous as Async
import Control.Monad.Exception.Synchronous (bracketT, )
import System.IO.Straight (SIO, ioToExceptionalSIO, unsafeInterleaveSIO, )
import System.IO (Handle, IOMode, )
import qualified System.IO as IO

import System.IO.Error (isEOFError, )
import Control.Exception (IOException)

import Prelude hiding (getChar)


open :: FilePath -> IOMode -> EIO Handle
open :: FilePath -> IOMode -> EIO Handle
open name :: FilePath
name mode :: IOMode
mode =
   IO Handle -> EIO Handle
forall a. IO a -> ExceptionalT IOException SIO a
ioToExceptionalSIO (IO Handle -> EIO Handle) -> IO Handle -> EIO Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
IO.openFile FilePath
name IOMode
mode

with ::
   FilePath -> IOMode -> (Handle -> EIO r) -> EIO r
with :: FilePath -> IOMode -> (Handle -> EIO r) -> EIO r
with name :: FilePath
name mode :: IOMode
mode =
   EIO Handle
-> (Handle -> ExceptionalT IOException SIO ())
-> (Handle -> EIO r)
-> EIO r
forall (m :: * -> *) e h a.
Monad m =>
ExceptionalT e m h
-> (h -> ExceptionalT e m ())
-> (h -> ExceptionalT e m a)
-> ExceptionalT e m a
bracketT (FilePath -> IOMode -> EIO Handle
open FilePath
name IOMode
mode) Handle -> ExceptionalT IOException SIO ()
close

getChar :: Handle -> EIO Char
getChar :: Handle -> EIO Char
getChar h :: Handle
h =
   IO Char -> EIO Char
forall a. IO a -> ExceptionalT IOException SIO a
ioToExceptionalSIO (IO Char -> EIO Char) -> IO Char -> EIO Char
forall a b. (a -> b) -> a -> b
$ Handle -> IO Char
IO.hGetChar Handle
h

getContentsSynchronous :: Handle -> EIO String
getContentsSynchronous :: Handle -> EIO FilePath
getContentsSynchronous h :: Handle
h =
   (IOException -> Maybe IOException)
-> (Char -> FilePath -> FilePath)
-> FilePath
-> EIO Char
-> EIO FilePath
forall (m :: * -> *) e0 e1 a b.
Monad m =>
(e0 -> Maybe e1)
-> (a -> b -> b) -> b -> ExceptionalT e0 m a -> ExceptionalT e1 m b
Sync.manyT
      -- candidate for toMaybe from utility-ht
      (\e :: IOException
e -> if IOException -> Bool
isEOFError IOException
e then Maybe IOException
forall a. Maybe a
Nothing else IOException -> Maybe IOException
forall a. a -> Maybe a
Just IOException
e)
      (:) [] (Handle -> EIO Char
getChar Handle
h)

{- |
This calls 'unsafeInterleaveIO'.
Maybe we should also attach 'unsafe' to this function name?
We should use the LazyIO type and manyT here.
-}
getContentsAsynchronous :: Handle -> SIO (Async.Exceptional IOException String)
getContentsAsynchronous :: Handle -> SIO (Exceptional IOException FilePath)
getContentsAsynchronous h :: Handle
h =
   (SIO (Exceptional IOException FilePath)
 -> SIO (Exceptional IOException FilePath))
-> (Char -> FilePath -> FilePath)
-> FilePath
-> EIO Char
-> SIO (Exceptional IOException FilePath)
forall (m :: * -> *) e b a.
Monad m =>
(m (Exceptional e b) -> m (Exceptional e b))
-> (a -> b -> b) -> b -> ExceptionalT e m a -> m (Exceptional e b)
Async.manySynchronousT SIO (Exceptional IOException FilePath)
-> SIO (Exceptional IOException FilePath)
forall a. SIO a -> SIO a
unsafeInterleaveSIO (:) [] (Handle -> EIO Char
getChar Handle
h)

putChar :: Handle -> Char -> EIO ()
putChar :: Handle -> Char -> ExceptionalT IOException SIO ()
putChar h :: Handle
h c :: Char
c =
   IO () -> ExceptionalT IOException SIO ()
forall a. IO a -> ExceptionalT IOException SIO a
ioToExceptionalSIO (IO () -> ExceptionalT IOException SIO ())
-> IO () -> ExceptionalT IOException SIO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Char -> IO ()
IO.hPutChar Handle
h Char
c