src/win32/System/Posix/IO.hsc

   1 module System.Posix.IO where
   2
   3 import Foreign.C.String ( withCString )
   4 import Foreign.C.Error ( throwErrnoIfMinus1, throwErrnoIfMinus1_ )
   5
   6 import GHC.Handle ( fdToHandle )
   7
   8 import System.Posix.Internals ( c_open, c_close, c_dup2 )
   9 import System.Posix.Types ( Fd(..), FileMode )
  10 import System.IO ( Handle )
  11
  12 import Data.Bits ( (.|.) )
  13
  14
  15 stdOutput :: Fd
  16 stdOutput = Fd 1
  17
  18 stdError :: Fd
  19 stdError = Fd 2
  20
  21 data OpenFileFlags =
  22  OpenFileFlags {
  23   append :: Bool,
  24   exclusive :: Bool,
  25   noctty :: Bool,
  26   nonBlock :: Bool,
  27   trunc :: Bool
  28  }
  29
  30
  31 -- Adapted from System.Posix.IO in ghc
  32 #include <fcntl.h>
  33
  34 openFd :: FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
  35 openFd name how maybe_mode off = do
  36   withCString name $ \s -> do
  37    fd <- throwErrnoIfMinus1 "openFd" (c_open s all_flags mode_w)
  38    return (Fd fd)
  39  where
  40    all_flags = binary .|. creat .|. flags .|. open_mode
  41    flags =
  42     (if append off    then (#const O_APPEND)   else 0) .|.
  43     (if exclusive off then (#const O_EXCL)     else 0) .|.
  44     (if trunc off     then (#const O_TRUNC)    else 0)
  45    binary = (#const O_BINARY)
  46    (creat, mode_w) = maybe (0,0) (\x->((#const O_CREAT),x)) maybe_mode
  47    open_mode = case how of
  48                 ReadOnly  -> (#const O_RDONLY)
  49                 WriteOnly -> (#const O_WRONLY)
  50                 ReadWrite -> (#const O_RDWR)
  51
  52 closeFd :: Fd -> IO ()
  53 closeFd (Fd fd) = throwErrnoIfMinus1_ "closeFd" (c_close fd)
  54
  55
  56 fdToHandle :: Fd -> IO Handle
  57 fdToHandle fd = GHC.Handle.fdToHandle (fromIntegral fd)
  58
  59 dupTo :: Fd -> Fd -> IO Fd
  60 dupTo (Fd fd1) (Fd fd2) = do
  61   r <- throwErrnoIfMinus1 "dupTo" (c_dup2 fd1 fd2)
  62   return (Fd r)
  63
  64 data OpenMode = ReadOnly | WriteOnly | ReadWrite
  65
  66 defaultFileFlags :: OpenFileFlags
  67 defaultFileFlags = OpenFileFlags False False False False False
  68
  69