{-# LINE 1 "System/Posix/IO/Common.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.IO.Common
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-----------------------------------------------------------------------------

module System.Posix.IO.Common (
    -- * Input \/ Output

    -- ** Standard file descriptors
    stdInput, stdOutput, stdError,

    -- ** Opening and closing files
    OpenMode(..),
    OpenFileFlags(..), defaultFileFlags,
    openat_,
    closeFd,

    -- ** Reading\/writing data
    -- |Programmers using the 'fdRead' and 'fdWrite' API should be aware that
    -- EAGAIN exceptions may occur for non-blocking IO!

    fdReadBuf, fdWriteBuf,

    -- ** Seeking
    fdSeek,

    -- ** File options
    FdOption(..),
    queryFdOption,
    setFdOption,

    -- ** Locking
    FileLock,
    LockRequest(..),
    getLock,  setLock,
    waitToSetLock,

    -- ** Pipes
    createPipe,

    -- ** Duplicating file descriptors
    dup, dupTo,

    -- ** Converting file descriptors to\/from Handles
    handleToFd,
    fdToHandle,

  ) where

import System.IO
import System.IO.Error
import System.Posix.Types
import qualified System.Posix.Internals as Base

import Foreign
import Foreign.C

import GHC.IO.Handle.Internals
import GHC.IO.Handle.Types
import qualified GHC.IO.FD as FD
import qualified GHC.IO.Handle.FD as FD
import GHC.IO.Exception
import Data.Typeable (cast)


{-# LINE 81 "System/Posix/IO/Common.hsc" #-}




{-# LINE 92 "System/Posix/IO/Common.hsc" #-}

-- -----------------------------------------------------------------------------
-- Pipes
-- |The 'createPipe' function creates a pair of connected file
-- descriptors. The first component is the fd to read from, the second
-- is the write end.  Although pipes may be bidirectional, this
-- behaviour is not portable and programmers should use two separate
-- pipes for this purpose.  May throw an exception if this is an
-- invalid descriptor.

createPipe :: IO (Fd, Fd)
createPipe :: IO (Fd, Fd)
createPipe =
  forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p_fd -> do
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"createPipe" (Ptr CInt -> IO CInt
c_pipe Ptr CInt
p_fd)
    CInt
rfd <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CInt
p_fd Int
0
    CInt
wfd <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CInt
p_fd Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Fd
Fd CInt
rfd, CInt -> Fd
Fd CInt
wfd)

foreign import ccall unsafe "pipe"
   c_pipe :: Ptr CInt -> IO CInt


{-# LINE 114 "System/Posix/IO/Common.hsc" #-}


{-# LINE 128 "System/Posix/IO/Common.hsc" #-}

-- -----------------------------------------------------------------------------
-- Duplicating file descriptors

-- | May throw an exception if this is an invalid descriptor.
dup :: Fd -> IO Fd
dup :: Fd -> IO Fd
dup (Fd CInt
fd) = do CInt
r <- forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"dup" (CInt -> IO CInt
c_dup CInt
fd); forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Fd
Fd CInt
r)

-- | May throw an exception if this is an invalid descriptor.
dupTo :: Fd -> Fd -> IO Fd
dupTo :: Fd -> Fd -> IO Fd
dupTo (Fd CInt
fd1) (Fd CInt
fd2) = do
  CInt
r <- forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"dupTo" (CInt -> CInt -> IO CInt
c_dup2 CInt
fd1 CInt
fd2)
  forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Fd
Fd CInt
r)

foreign import ccall unsafe "dup"
   c_dup :: CInt -> IO CInt

foreign import ccall unsafe "dup2"
   c_dup2 :: CInt -> CInt -> IO CInt


{-# LINE 149 "System/Posix/IO/Common.hsc" #-}

-- -----------------------------------------------------------------------------
-- Opening and closing files

stdInput, stdOutput, stdError :: Fd
stdInput :: Fd
stdInput   = CInt -> Fd
Fd (CInt
0)
{-# LINE 155 "System/Posix/IO/Common.hsc" #-}
stdOutput  = Fd (1)
stdError :: Fd
{-# LINE 156 "System/Posix/IO/Common.hsc" #-}
stdError   = Fd (2)
{-# LINE 157 "System/Posix/IO/Common.hsc" #-}

data OpenMode = ReadOnly | WriteOnly | ReadWrite
              deriving (ReadPrec [OpenMode]
ReadPrec OpenMode
Int -> ReadS OpenMode
ReadS [OpenMode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OpenMode]
$creadListPrec :: ReadPrec [OpenMode]
readPrec :: ReadPrec OpenMode
$creadPrec :: ReadPrec OpenMode
readList :: ReadS [OpenMode]
$creadList :: ReadS [OpenMode]
readsPrec :: Int -> ReadS OpenMode
$creadsPrec :: Int -> ReadS OpenMode
Read, Int -> OpenMode -> ShowS
[OpenMode] -> ShowS
OpenMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenMode] -> ShowS
$cshowList :: [OpenMode] -> ShowS
show :: OpenMode -> String
$cshow :: OpenMode -> String
showsPrec :: Int -> OpenMode -> ShowS
$cshowsPrec :: Int -> OpenMode -> ShowS
Show, OpenMode -> OpenMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenMode -> OpenMode -> Bool
$c/= :: OpenMode -> OpenMode -> Bool
== :: OpenMode -> OpenMode -> Bool
$c== :: OpenMode -> OpenMode -> Bool
Eq, Eq OpenMode
OpenMode -> OpenMode -> Bool
OpenMode -> OpenMode -> Ordering
OpenMode -> OpenMode -> OpenMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OpenMode -> OpenMode -> OpenMode
$cmin :: OpenMode -> OpenMode -> OpenMode
max :: OpenMode -> OpenMode -> OpenMode
$cmax :: OpenMode -> OpenMode -> OpenMode
>= :: OpenMode -> OpenMode -> Bool
$c>= :: OpenMode -> OpenMode -> Bool
> :: OpenMode -> OpenMode -> Bool
$c> :: OpenMode -> OpenMode -> Bool
<= :: OpenMode -> OpenMode -> Bool
$c<= :: OpenMode -> OpenMode -> Bool
< :: OpenMode -> OpenMode -> Bool
$c< :: OpenMode -> OpenMode -> Bool
compare :: OpenMode -> OpenMode -> Ordering
$ccompare :: OpenMode -> OpenMode -> Ordering
Ord)

-- |Correspond to some of the int flags from C's fcntl.h.
data OpenFileFlags =
 OpenFileFlags {
    OpenFileFlags -> Bool
append    :: Bool,           -- ^ O_APPEND
    OpenFileFlags -> Bool
exclusive :: Bool,           -- ^ O_EXCL, result is undefined if O_CREAT is False
                                 --
                                 -- __NOTE__: Result is undefined if 'creat' is 'Nothing'.
    OpenFileFlags -> Bool
noctty    :: Bool,           -- ^ O_NOCTTY
    OpenFileFlags -> Bool
nonBlock  :: Bool,           -- ^ O_NONBLOCK
    OpenFileFlags -> Bool
trunc     :: Bool,           -- ^ O_TRUNC
    OpenFileFlags -> Bool
nofollow  :: Bool,           -- ^ O_NOFOLLOW
                                 --
                                 -- @since 2.8.0.0
    OpenFileFlags -> Maybe FileMode
creat     :: Maybe FileMode, -- ^ O_CREAT
                                 --
                                 -- @since 2.8.0.0
    OpenFileFlags -> Bool
cloexec   :: Bool,           -- ^ O_CLOEXEC
                                 --
                                 -- @since 2.8.0.0
    OpenFileFlags -> Bool
directory :: Bool,           -- ^ O_DIRECTORY
                                 --
                                 -- @since 2.8.0.0
    OpenFileFlags -> Bool
sync      :: Bool            -- ^ O_SYNC
                                 --
                                 -- @since 2.8.0.0
 }
 deriving (ReadPrec [OpenFileFlags]
ReadPrec OpenFileFlags
Int -> ReadS OpenFileFlags
ReadS [OpenFileFlags]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OpenFileFlags]
$creadListPrec :: ReadPrec [OpenFileFlags]
readPrec :: ReadPrec OpenFileFlags
$creadPrec :: ReadPrec OpenFileFlags
readList :: ReadS [OpenFileFlags]
$creadList :: ReadS [OpenFileFlags]
readsPrec :: Int -> ReadS OpenFileFlags
$creadsPrec :: Int -> ReadS OpenFileFlags
Read, Int -> OpenFileFlags -> ShowS
[OpenFileFlags] -> ShowS
OpenFileFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenFileFlags] -> ShowS
$cshowList :: [OpenFileFlags] -> ShowS
show :: OpenFileFlags -> String
$cshow :: OpenFileFlags -> String
showsPrec :: Int -> OpenFileFlags -> ShowS
$cshowsPrec :: Int -> OpenFileFlags -> ShowS
Show, OpenFileFlags -> OpenFileFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenFileFlags -> OpenFileFlags -> Bool
$c/= :: OpenFileFlags -> OpenFileFlags -> Bool
== :: OpenFileFlags -> OpenFileFlags -> Bool
$c== :: OpenFileFlags -> OpenFileFlags -> Bool
Eq, Eq OpenFileFlags
OpenFileFlags -> OpenFileFlags -> Bool
OpenFileFlags -> OpenFileFlags -> Ordering
OpenFileFlags -> OpenFileFlags -> OpenFileFlags
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OpenFileFlags -> OpenFileFlags -> OpenFileFlags
$cmin :: OpenFileFlags -> OpenFileFlags -> OpenFileFlags
max :: OpenFileFlags -> OpenFileFlags -> OpenFileFlags
$cmax :: OpenFileFlags -> OpenFileFlags -> OpenFileFlags
>= :: OpenFileFlags -> OpenFileFlags -> Bool
$c>= :: OpenFileFlags -> OpenFileFlags -> Bool
> :: OpenFileFlags -> OpenFileFlags -> Bool
$c> :: OpenFileFlags -> OpenFileFlags -> Bool
<= :: OpenFileFlags -> OpenFileFlags -> Bool
$c<= :: OpenFileFlags -> OpenFileFlags -> Bool
< :: OpenFileFlags -> OpenFileFlags -> Bool
$c< :: OpenFileFlags -> OpenFileFlags -> Bool
compare :: OpenFileFlags -> OpenFileFlags -> Ordering
$ccompare :: OpenFileFlags -> OpenFileFlags -> Ordering
Ord)


-- | Default values for the 'OpenFileFlags' type.
--
-- Each field of 'OpenFileFlags' is either 'False' or 'Nothing'
-- respectively.
defaultFileFlags :: OpenFileFlags
defaultFileFlags :: OpenFileFlags
defaultFileFlags =
 OpenFileFlags {
    append :: Bool
append    = Bool
False,
    exclusive :: Bool
exclusive = Bool
False,
    noctty :: Bool
noctty    = Bool
False,
    nonBlock :: Bool
nonBlock  = Bool
False,
    trunc :: Bool
trunc     = Bool
False,
    nofollow :: Bool
nofollow  = Bool
False,
    creat :: Maybe FileMode
creat     = forall a. Maybe a
Nothing,
    cloexec :: Bool
cloexec   = Bool
False,
    directory :: Bool
directory = Bool
False,
    sync :: Bool
sync      = Bool
False
  }


-- |Open and optionally create a file relative to an optional
-- directory file descriptor.
openat_  :: Maybe Fd -- ^ Optional directory file descriptor
         -> CString -- ^ Pathname to open
         -> OpenMode -- ^ Read-only, read-write or write-only
         -> OpenFileFlags -- ^ Append, exclusive, etc.
         -> IO Fd
openat_ :: Maybe Fd -> CString -> OpenMode -> OpenFileFlags -> IO Fd
openat_ Maybe Fd
fdMay CString
str OpenMode
how (OpenFileFlags Bool
appendFlag Bool
exclusiveFlag Bool
nocttyFlag
                                Bool
nonBlockFlag Bool
truncateFlag Bool
nofollowFlag
                                Maybe FileMode
creatFlag Bool
cloexecFlag Bool
directoryFlag
                                Bool
syncFlag) =
    CInt -> Fd
Fd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CString -> CInt -> FileMode -> IO CInt
c_openat CInt
c_fd CString
str CInt
all_flags FileMode
mode_w
  where
    c_fd :: CInt
c_fd = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-CInt
100) (\ (Fd CInt
fd) -> CInt
fd) Maybe Fd
fdMay
{-# LINE 224 "System/Posix/IO/Common.hsc" #-}
    all_flags  = creat .|. flags .|. open_mode

    flags :: CInt
flags =
       (if Bool
appendFlag       then (CInt
1024)    else CInt
0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 228 "System/Posix/IO/Common.hsc" #-}
       (if exclusiveFlag    then (128)      else 0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 229 "System/Posix/IO/Common.hsc" #-}
       (if nocttyFlag       then (256)    else 0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 230 "System/Posix/IO/Common.hsc" #-}
       (if nonBlockFlag     then (2048)  else 0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 231 "System/Posix/IO/Common.hsc" #-}
       (if truncateFlag     then (512)     else 0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 232 "System/Posix/IO/Common.hsc" #-}
       (if nofollowFlag     then (131072)  else 0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 233 "System/Posix/IO/Common.hsc" #-}
       (if cloexecFlag      then (524288)   else 0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 234 "System/Posix/IO/Common.hsc" #-}
       (if directoryFlag    then (65536) else 0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 235 "System/Posix/IO/Common.hsc" #-}
       (if syncFlag         then (1052672)      else 0)
{-# LINE 236 "System/Posix/IO/Common.hsc" #-}

    (CInt
creat, FileMode
mode_w) = case Maybe FileMode
creatFlag of
                        Maybe FileMode
Nothing -> (CInt
0,FileMode
0)
                        Just FileMode
x  -> ((CInt
64), FileMode
x)
{-# LINE 240 "System/Posix/IO/Common.hsc" #-}

    open_mode :: CInt
open_mode = case OpenMode
how of
                   OpenMode
ReadOnly  -> (CInt
0)
{-# LINE 243 "System/Posix/IO/Common.hsc" #-}
                   OpenMode
WriteOnly -> (CInt
1)
{-# LINE 244 "System/Posix/IO/Common.hsc" #-}
                   OpenMode
ReadWrite -> (CInt
2)
{-# LINE 245 "System/Posix/IO/Common.hsc" #-}

foreign import capi unsafe "HsUnix.h openat"
   c_openat :: CInt -> CString -> CInt -> CMode -> IO CInt

-- |Close this file descriptor.  May throw an exception if this is an
-- invalid descriptor.

closeFd :: Fd -> IO ()
closeFd :: Fd -> IO ()
closeFd (Fd CInt
fd) = forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"closeFd" (CInt -> IO CInt
c_close CInt
fd)
-- Here we don't to retry on EINTR because according to
--  http://pubs.opengroup.org/onlinepubs/9699919799/functions/close.html
-- "with errno set to [EINTR] [...] the state of fildes is unspecified"
-- and on Linux, already the first close() removes the FD from the process's
-- FD table so closing a second time is invalid
-- (see http://man7.org/linux/man-pages/man2/close.2.html#NOTES).

foreign import ccall unsafe "HsUnix.h close"
   c_close :: CInt -> IO CInt

-- -----------------------------------------------------------------------------
-- Converting file descriptors to/from Handles

-- | Extracts the 'Fd' from a 'Handle'.  This function has the side effect
-- of closing the 'Handle' (and flushing its write buffer, if necessary),
-- without closing the underlying 'Fd'.
--
-- __Warning:__ This means you take over ownership of the underlying 'Fd'.
-- 'hClose` on the 'Handle' will no longer have any effect.
-- This will break common patterns to avoid file descriptor leaks,
-- such as using 'hClose' in the cleanup action of @Control.Exception.bracket@,
-- making it a silent no-op.
-- Be sure to close the returned 'Fd' yourself to not leak it.
handleToFd :: Handle -> IO Fd

-- | Converts an 'Fd' into a 'Handle' that can be used with the
-- standard Haskell IO library (see "System.IO").
fdToHandle :: Fd -> IO Handle
fdToHandle :: Fd -> IO Handle
fdToHandle Fd
fd = CInt -> IO Handle
FD.fdToHandle (forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd)

handleToFd :: Handle -> IO Fd
handleToFd h :: Handle
h@(FileHandle String
_ MVar Handle__
m) = do
  forall a.
String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' String
"handleToFd" Handle
h MVar Handle__
m forall a b. (a -> b) -> a -> b
$ Handle -> Handle__ -> IO (Handle__, Fd)
handleToFd' Handle
h
handleToFd h :: Handle
h@(DuplexHandle String
_ MVar Handle__
r MVar Handle__
w) = do
  Fd
_ <- forall a.
String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' String
"handleToFd" Handle
h MVar Handle__
r forall a b. (a -> b) -> a -> b
$ Handle -> Handle__ -> IO (Handle__, Fd)
handleToFd' Handle
h
  forall a.
String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' String
"handleToFd" Handle
h MVar Handle__
w forall a b. (a -> b) -> a -> b
$ Handle -> Handle__ -> IO (Handle__, Fd)
handleToFd' Handle
h
  -- for a DuplexHandle, make sure we mark both sides as closed,
  -- otherwise a finalizer will come along later and close the other
  -- side. (#3914)

handleToFd' :: Handle -> Handle__ -> IO (Handle__, Fd)
handleToFd' :: Handle -> Handle__ -> IO (Handle__, Fd)
handleToFd' Handle
h h_ :: Handle__
h_@Handle__{haType :: Handle__ -> HandleType
haType=HandleType
_,dev
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe (MVar Handle__)
Newline
BufferMode
IORef (dec_state, Buffer Word8)
IORef (BufferList CharBufElem)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haDevice :: ()
haEncoder :: ()
haInputNL :: Handle__ -> Newline
haLastDecode :: ()
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haDevice :: dev
..} = do
  case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
haDevice of
    Maybe FD
Nothing -> forall a. IOError -> IO a
ioError (IOError -> String -> IOError
ioeSetErrorString (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
IllegalOperation
                                           String
"handleToFd" (forall a. a -> Maybe a
Just Handle
h) forall a. Maybe a
Nothing)
                        String
"handle is not a file descriptor")
    Just FD
fd -> do
     -- converting a Handle into an Fd effectively means
     -- letting go of the Handle; it is put into a closed
     -- state as a result.
     Handle__ -> IO ()
flushWriteBuffer Handle__
h_
     FD -> IO ()
FD.release FD
fd
     forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__{haType :: HandleType
haType=HandleType
ClosedHandle,dev
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe (MVar Handle__)
Newline
BufferMode
IORef (dec_state, Buffer Word8)
IORef (BufferList CharBufElem)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
haBufferMode :: BufferMode
haBuffers :: IORef (BufferList CharBufElem)
haByteBuffer :: IORef (Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haDevice :: dev
haEncoder :: Maybe (TextEncoder enc_state)
haInputNL :: Newline
haLastDecode :: IORef (dec_state, Buffer Word8)
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haDevice :: dev
..}, CInt -> Fd
Fd (FD -> CInt
FD.fdFD FD
fd))


-- -----------------------------------------------------------------------------
-- Fd options

data FdOption = AppendOnWrite     -- ^O_APPEND
              | CloseOnExec       -- ^FD_CLOEXEC
              | NonBlockingRead   -- ^O_NONBLOCK
              | SynchronousWrites -- ^O_SYNC

fdOption2Int :: FdOption -> CInt
fdOption2Int :: FdOption -> CInt
fdOption2Int FdOption
CloseOnExec       = (CInt
1)
{-# LINE 318 "System/Posix/IO/Common.hsc" #-}
fdOption2Int AppendOnWrite     = (1024)
{-# LINE 319 "System/Posix/IO/Common.hsc" #-}
fdOption2Int NonBlockingRead   = (2048)
{-# LINE 320 "System/Posix/IO/Common.hsc" #-}
fdOption2Int SynchronousWrites = (1052672)
{-# LINE 321 "System/Posix/IO/Common.hsc" #-}

-- | May throw an exception if this is an invalid descriptor.
queryFdOption :: Fd -> FdOption -> IO Bool
queryFdOption :: Fd -> FdOption -> IO Bool
queryFdOption (Fd CInt
fd) FdOption
opt = do
  CInt
r <- forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"queryFdOption" (CInt -> CInt -> IO CInt
Base.c_fcntl_read CInt
fd CInt
flag)
  forall (m :: * -> *) a. Monad m => a -> m a
return ((CInt
r forall a. Bits a => a -> a -> a
.&. FdOption -> CInt
fdOption2Int FdOption
opt) forall a. Eq a => a -> a -> Bool
/= CInt
0)
 where
  flag :: CInt
flag    = case FdOption
opt of
              FdOption
CloseOnExec       -> (CInt
1)
{-# LINE 330 "System/Posix/IO/Common.hsc" #-}
              FdOption
_                 -> (CInt
3)
{-# LINE 331 "System/Posix/IO/Common.hsc" #-}

-- | May throw an exception if this is an invalid descriptor.
setFdOption :: Fd -> FdOption -> Bool -> IO ()
setFdOption :: Fd -> FdOption -> Bool -> IO ()
setFdOption (Fd CInt
fd) FdOption
opt Bool
val = do
  CInt
r <- forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"setFdOption" (CInt -> CInt -> IO CInt
Base.c_fcntl_read CInt
fd CInt
getflag)
  let r' :: CInt
r' | Bool
val       = CInt
r forall a. Bits a => a -> a -> a
.|. CInt
opt_val
         | Bool
otherwise = CInt
r forall a. Bits a => a -> a -> a
.&. (forall a. Bits a => a -> a
complement CInt
opt_val)
  forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setFdOption"
                      (CInt -> CInt -> CLong -> IO CInt
Base.c_fcntl_write CInt
fd CInt
setflag (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
r'))
 where
  (CInt
getflag,CInt
setflag)= case FdOption
opt of
              FdOption
CloseOnExec       -> ((CInt
1),(CInt
2))
{-# LINE 343 "System/Posix/IO/Common.hsc" #-}
              FdOption
_                 -> ((CInt
3),(CInt
4))
{-# LINE 344 "System/Posix/IO/Common.hsc" #-}
  opt_val = fdOption2Int opt

-- -----------------------------------------------------------------------------
-- Seeking

mode2Int :: SeekMode -> CInt
mode2Int :: SeekMode -> CInt
mode2Int SeekMode
AbsoluteSeek = (CInt
0)
{-# LINE 351 "System/Posix/IO/Common.hsc" #-}
mode2Int RelativeSeek = (1)
{-# LINE 352 "System/Posix/IO/Common.hsc" #-}
mode2Int SeekFromEnd  = (2)
{-# LINE 353 "System/Posix/IO/Common.hsc" #-}

-- | May throw an exception if this is an invalid descriptor.
fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset
fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset
fdSeek (Fd CInt
fd) SeekMode
mode FileOffset
off =
  forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"fdSeek" (CInt -> FileOffset -> CInt -> IO FileOffset
Base.c_lseek CInt
fd FileOffset
off (SeekMode -> CInt
mode2Int SeekMode
mode))

-- -----------------------------------------------------------------------------
-- Locking

data LockRequest = ReadLock
                 | WriteLock
                 | Unlock

type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset)


{-# LINE 386 "System/Posix/IO/Common.hsc" #-}

-- | May throw an exception if this is an invalid descriptor.
getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock))
getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock))
getLock (Fd CInt
fd) FileLock
lock =
  forall a. FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock FileLock
lock forall a b. (a -> b) -> a -> b
$ \Ptr CFLock
p_flock -> do
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"getLock" (CInt -> CInt -> Ptr CFLock -> IO CInt
Base.c_fcntl_lock CInt
fd (CInt
5) Ptr CFLock
p_flock)
{-# LINE 392 "System/Posix/IO/Common.hsc" #-}
    result <- bytes2ProcessIDAndLock p_flock
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall {a} {b} {c} {d}.
(a, (LockRequest, b, c, d)) -> Maybe (a, (LockRequest, b, c, d))
maybeResult (ProcessID, FileLock)
result)
  where
    maybeResult :: (a, (LockRequest, b, c, d)) -> Maybe (a, (LockRequest, b, c, d))
maybeResult (a
_, (LockRequest
Unlock, b
_, c
_, d
_)) = forall a. Maybe a
Nothing
    maybeResult (a, (LockRequest, b, c, d))
x = forall a. a -> Maybe a
Just (a, (LockRequest, b, c, d))
x

allocaLock :: FileLock -> (Ptr Base.CFLock -> IO a) -> IO a
allocaLock :: forall a. FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock (LockRequest
lockreq, SeekMode
mode, FileOffset
start, FileOffset
len) Ptr CFLock -> IO a
io =
  forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
32) forall a b. (a -> b) -> a -> b
$ \Ptr CFLock
p -> do
{-# LINE 401 "System/Posix/IO/Common.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0))   p (lockReq2Int lockreq :: CShort)
{-# LINE 402 "System/Posix/IO/Common.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p (fromIntegral (mode2Int mode) :: CShort)
{-# LINE 403 "System/Posix/IO/Common.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8))  p start
{-# LINE 404 "System/Posix/IO/Common.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16))    p len
{-# LINE 405 "System/Posix/IO/Common.hsc" #-}
    io p

lockReq2Int :: LockRequest -> CShort
lockReq2Int :: LockRequest -> CShort
lockReq2Int LockRequest
ReadLock  = (CShort
0)
{-# LINE 409 "System/Posix/IO/Common.hsc" #-}
lockReq2Int WriteLock = (1)
{-# LINE 410 "System/Posix/IO/Common.hsc" #-}
lockReq2Int Unlock    = (2)
{-# LINE 411 "System/Posix/IO/Common.hsc" #-}

bytes2ProcessIDAndLock :: Ptr Base.CFLock -> IO (ProcessID, FileLock)
bytes2ProcessIDAndLock :: Ptr CFLock -> IO (ProcessID, FileLock)
bytes2ProcessIDAndLock Ptr CFLock
p = do
  CShort
req   <- ((\Ptr CFLock
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CFLock
hsc_ptr Int
0))   Ptr CFLock
p
{-# LINE 415 "System/Posix/IO/Common.hsc" #-}
  mode  <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 416 "System/Posix/IO/Common.hsc" #-}
  start <- ((\hsc_ptr -> peekByteOff hsc_ptr 8))  p
{-# LINE 417 "System/Posix/IO/Common.hsc" #-}
  len   <- ((\hsc_ptr -> peekByteOff hsc_ptr 16))    p
{-# LINE 418 "System/Posix/IO/Common.hsc" #-}
  pid   <- ((\hsc_ptr -> peekByteOff hsc_ptr 24))    p
{-# LINE 419 "System/Posix/IO/Common.hsc" #-}
  return (pid, (int2req req, int2mode mode, start, len))
 where
  int2req :: CShort -> LockRequest
  int2req :: CShort -> LockRequest
int2req (CShort
0) = LockRequest
ReadLock
{-# LINE 423 "System/Posix/IO/Common.hsc" #-}
  int2req (1) = WriteLock
{-# LINE 424 "System/Posix/IO/Common.hsc" #-}
  int2req (2) = Unlock
{-# LINE 425 "System/Posix/IO/Common.hsc" #-}
  int2req _ = error $ "int2req: bad argument"

  int2mode :: CShort -> SeekMode
  int2mode :: CShort -> SeekMode
int2mode (CShort
0) = SeekMode
AbsoluteSeek
{-# LINE 429 "System/Posix/IO/Common.hsc" #-}
  int2mode (1) = RelativeSeek
{-# LINE 430 "System/Posix/IO/Common.hsc" #-}
  int2mode (2) = SeekFromEnd
{-# LINE 431 "System/Posix/IO/Common.hsc" #-}
  int2mode _ = error $ "int2mode: bad argument"

-- | May throw an exception if this is an invalid descriptor.
setLock :: Fd -> FileLock -> IO ()
setLock :: Fd -> FileLock -> IO ()
setLock (Fd CInt
fd) FileLock
lock = do
  forall a. FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock FileLock
lock forall a b. (a -> b) -> a -> b
$ \Ptr CFLock
p_flock ->
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setLock" (CInt -> CInt -> Ptr CFLock -> IO CInt
Base.c_fcntl_lock CInt
fd (CInt
6) Ptr CFLock
p_flock)
{-# LINE 438 "System/Posix/IO/Common.hsc" #-}

-- | May throw an exception if this is an invalid descriptor.
waitToSetLock :: Fd -> FileLock -> IO ()
waitToSetLock :: Fd -> FileLock -> IO ()
waitToSetLock (Fd CInt
fd) FileLock
lock = do
  forall a. FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock FileLock
lock forall a b. (a -> b) -> a -> b
$ \Ptr CFLock
p_flock ->
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"waitToSetLock"
        (CInt -> CInt -> Ptr CFLock -> IO CInt
Base.c_fcntl_lock CInt
fd (CInt
7) Ptr CFLock
p_flock)
{-# LINE 445 "System/Posix/IO/Common.hsc" #-}


{-# LINE 447 "System/Posix/IO/Common.hsc" #-}

-- -----------------------------------------------------------------------------
-- fd{Read,Write}Buf

-- | Read data from an 'Fd' into memory.  This is exactly equivalent
-- to the POSIX @read@ function.
fdReadBuf :: Fd
          -> Ptr Word8 -- ^ Memory in which to put the data
          -> ByteCount -- ^ Maximum number of bytes to read
          -> IO ByteCount -- ^ Number of bytes read (zero for EOF)
fdReadBuf :: Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
fdReadBuf Fd
_fd Ptr Word8
_buf ByteCount
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ByteCount
0
fdReadBuf Fd
fd Ptr Word8
buf ByteCount
nbytes =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
    forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"fdReadBuf" forall a b. (a -> b) -> a -> b
$
      CInt -> CString -> ByteCount -> IO CSsize
c_safe_read (forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd) (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf) ByteCount
nbytes

foreign import ccall safe "read"
   c_safe_read :: CInt -> Ptr CChar -> CSize -> IO CSsize

-- | Write data from memory to an 'Fd'.  This is exactly equivalent
-- to the POSIX @write@ function.
fdWriteBuf :: Fd
           -> Ptr Word8    -- ^ Memory containing the data to write
           -> ByteCount    -- ^ Maximum number of bytes to write
           -> IO ByteCount -- ^ Number of bytes written
fdWriteBuf :: Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
fdWriteBuf Fd
fd Ptr Word8
buf ByteCount
len =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
    forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"fdWriteBuf" forall a b. (a -> b) -> a -> b
$
      CInt -> CString -> ByteCount -> IO CSsize
c_safe_write (forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd) (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf) ByteCount
len

foreign import ccall safe "write"
   c_safe_write :: CInt -> Ptr CChar -> CSize -> IO CSsize