IO

module IO(
    Handle, -- abstract
    --HandlePosn,
    IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
    BufferMode(NoBuffering,LineBuffering,BlockBuffering),
    SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
    stdin, stdout, stderr, 
    openFile, hClose, hFileSize, --hIsEOF, isEOF,
    hSetBuffering,hGetBuffering,
    hFlush, 
    --hGetPosn, hSetPosn, hSeek, 
    hWaitForInput, hReady, hGetChar, hGetLine, hGetContents, --hLookAhead, 
    hPutChar, hPutStr, hPutStrLn, hPrint,
    --hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable,
    isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError, 
    isFullError, isEOFError,
    isIllegalOperation, isPermissionError, isUserError, 
    ioeGetErrorString, --ioeGetHandle, ioeGetFileName,
    try, bracket, bracket_,

    -- ...and what the Prelude exports
    IO, FilePath, IOError, ioError, userError, catch, interact,
    putChar, putStr, putStrLn, print, getChar, getLine, getContents,
    readFile, writeFile, appendFile, readIO, readLn,
    -- * Extra
    IOErrorType(..), usleep, ioeAddPath
  ) where
import Prelude
import Ix(Ix)
import PreludeIO
import MonadicIO0

data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
                    deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
data BufferMode  =  NoBuffering | LineBuffering 
                 |  BlockBuffering (Maybe Int)
                    deriving (Eq, Ord, Read, Show)
data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
                    deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)

--newtype Handle = Handle PrimHandle deriving (Eq,Show)

stdin = {-Handle-} prim_stdin
stdout = {-Handle-} prim_stdout
stderr = {-Handle-} prim_stderr

openFile :: FilePath -> IOMode -> IO Handle
openFile path mode = {-fmap Handle-} (primOpenFile path (fromEnum mode))
                     `ioeAddPath` path

hGetBuffering :: Handle -> IO BufferMode
hGetBuffering h = return LineBuffering -- !!!

hSetBuffering ({-Handle-} ph) mode = primHSetBuffering ph m
  where
    m = case mode of
          NoBuffering -> -3
          LineBuffering -> -2
          BlockBuffering Nothing -> -1
          BlockBuffering (Just n) -> n

hClose ({-Handle-} h) = primHClose h

hFileSize ({-Handle-} h) = primFileSizeFd =<< primFileNo h

hGetLine h       =  do c <- hGetChar h
                       if c == '\n' then return "" else 
                          do s <- hGetLine h
                             return (c:s)

hGetChar ({-Handle-} h) = primHGetChar h
hGetContents ({-Handle-} h) = primHGetContents h

hPutChar ({-Handle-} h) c = primHPutChar h c
hPutStr ({-Handle-} h) s = primHPutStr h s
hPutStrLn h s = hPutStr h s >> hPutChar h '\n'
hPrint h x = hPutStrLn h (show x)

hFlush ({-Handle-} h) = primHFlush h
---

hWaitForInput :: Handle -> Int -> IO Bool
hWaitForInput h ms =
  -- Best used with NoBuffering, otherwise
  -- this could block even if there is data in the input buffer already
  do fd <- primFileNo h
     (rfds,_) <- primSelect [fd] [] (1000*ms)
     return (fd `elem` rfds)

hReady h = hWaitForInput h 0

-- | Suspend execution for a given number of microseconds
usleep = prim_usleep

---

ioeGetErrorString (IOE k s) = s

ioErrorType (IOE k _) = k

isAlreadyExistsError e = ioErrorType e == AlreadyExistsError
isDoesNotExistError  e = ioErrorType e == DoesNotExistError
isAlreadyInUseError  e = ioErrorType e == AlreadyInUseError
isFullError          e = ioErrorType e == FullError
isEOFError           e = ioErrorType e == EOFError
isIllegalOperation   e = ioErrorType e == IllegalOperation
isPermissionError    e = ioErrorType e == PermissionError
isUserError          e = ioErrorType e == UserError


---
try            :: IO a -> IO (Either IOError a)
try f          =  catch (fmap Right f) (return . Left)

bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket before after m =
  do    x  <- before
        rs <- try (m x)
        after x
	returnTry rs

-- variant of the above where middle computation doesn't want x
bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
bracket_ before after m = bracket before after (const m)

returnTry (Right r) = return r
returnTry (Left  e) = ioError e