content: {-# OPTIONS_JHC -fno-prelude -fffi -funboxed-values #-}
  module Jhc.Handle(
      Handle(..),
      IOMode(..),
      stdin,
      stdout,
      stderr,
      withHandle,
      hClose,
      hIsOpen,
      openBinaryPipe,
      openPipe,
      openBinaryFile,
      openFile
      ) where
  
  import Foreign.C.Error
  import Foreign.C.String
  import Foreign.Marshal.Utils
  import Foreign.Storable
  import Jhc.Addr
  import Jhc.Basics
  import Jhc.Enum
  import Jhc.Monad
  import Jhc.Type.Handle
  import Jhc.Order
  import Jhc.Show
  import Prelude.IO
  import System.C.Stdio
  
  deriving instance Eq IOMode
  deriving instance Ord IOMode
  deriving instance Enum IOMode
  --deriving instance Bounded IOMode
  
  instance Show IOMode where
      show ReadMode = "ReadMode"
      show WriteMode = "WriteMode"
      show AppendMode = "AppendMode"
      show ReadWriteMode = "ReadWriteMode"
  
  instance Show Handle where
      showsPrec _ h s = handleName h ++ s
  
  stdin, stdout, stderr :: Handle
  
  {-# INLINE make_builtin #-}
  make_builtin mode name std = Handle { handleName = name, handleFile = std, handleIOMode = mode, handleBinary = False, handleIsPipe = False }
  
  stdin = make_builtin ReadMode "stdin" c_stdin
  stdout = make_builtin WriteMode "stdout" c_stdout
  stderr = make_builtin WriteMode "stderr" c_stderr
  
  foreign import ccall "stdio.h &stdin" c_stdin :: Ptr FILE
  foreign import ccall "stdio.h &stdout" c_stdout :: Ptr FILE
  foreign import ccall "stdio.h &stderr" c_stderr :: Ptr FILE
  
  withHandle h action = do
      ptr <- peek (handleFile h)
      case ptr == nullPtr of
          True -> fail $ handleName h ++ ": handle  is closed"
          False -> action ptr
  
  hClose h = do
      ptr <- peek (handleFile h)
      case ptr == nullPtr of
          True -> return ()
          False -> do ec <- if handleIsPipe h then c_pclose ptr
                                              else c_fclose ptr
                      if ec /= 0 then fail ("hClose "++handleName h++" failed")
                                 else return ()
                      poke (handleFile h) nullPtr
  
  hIsOpen h = do
      ptr <- peek (handleFile h)
      return (ptr /= nullPtr)
  
  throwErrnoFN     :: String	-- ^ textual description of the error location
                 -> String
  	       -> IO a
  throwErrnoFN loc fn  = do
      errno <- getErrno
      ioError (errnoToIOError loc errno Nothing (Just fn))
  
  openFile :: FilePath -> IOMode -> IO Handle
  openFile fp m = do
      ptr <- withCString fp $ \cfp -> c_fopen cfp (Ptr (toStr m))
      if ptr == nullPtr then throwErrnoFN "openFile" fp  else do
          pptr <- new ptr
          return Handle { handleBinary = False, handleIsPipe = False, handleName = fp, handleIOMode = m, handleFile = pptr }
  
  openPipe :: String -> IOMode -> IO Handle
  openPipe c m = do
      ptr <- withCString c $ \command -> c_popen command (Ptr (toStr m))
      -- if ptr == nullPtr then throwErrnoFN "openPipe" c else do
      pptr <- new ptr
      return Handle { handleBinary = False, handleIsPipe = True, handleName = c, handleIOMode = m, handleFile = pptr }
  
  openBinaryPipe :: String -> IOMode -> IO Handle
  openBinaryPipe c m = do
      ptr <- withCString c $ \command -> c_popen command (Ptr (toStr m))
      if ptr == nullPtr then throwErrnoFN "openPipe" c  else do
          pptr <- new ptr
          return Handle { handleBinary = True, handleIsPipe = True, handleName = c, handleIOMode = m, handleFile = pptr }
  
  openBinaryFile :: FilePath -> IOMode -> IO Handle
  openBinaryFile fp m = do
      h <- openFile fp m
      return h { handleBinary = True }
  
  toStr x = Addr_ (case x of
      ReadMode -> "r"#
      WriteMode -> "w"#
      AppendMode -> "a"#
      ReadWriteMode -> "r+"#)
  