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

{-# LINE 5 "libraries/unix/System/Posix/IO/Common.hsc" #-}
{-# LANGUAGE Safe #-}

{-# LINE 9 "libraries/unix/System/Posix/IO/Common.hsc" #-}

-----------------------------------------------------------------------------
-- |
-- 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,
    open_,
    closeFd,

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

    fdRead, fdWrite,
    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)



-- -----------------------------------------------------------------------------
-- 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 =
  Int -> (Ptr CInt -> IO (Fd, Fd)) -> IO (Fd, Fd)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 ((Ptr CInt -> IO (Fd, Fd)) -> IO (Fd, Fd))
-> (Ptr CInt -> IO (Fd, Fd)) -> IO (Fd, Fd)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p_fd -> do
    String -> IO CInt -> IO ()
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 <- Ptr CInt -> Int -> IO CInt
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CInt
p_fd Int
0
    CInt
wfd <- Ptr CInt -> Int -> IO CInt
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CInt
p_fd Int
1
    (Fd, Fd) -> IO (Fd, Fd)
forall a. a -> IO a
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

-- -----------------------------------------------------------------------------
-- 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 <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"dup" (CInt -> IO CInt
c_dup CInt
fd); Fd -> IO Fd
forall a. a -> IO a
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 <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"dupTo" (CInt -> CInt -> IO CInt
c_dup2 CInt
fd1 CInt
fd2)
  Fd -> IO Fd
forall a. a -> IO a
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

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

stdInput, stdOutput, stdError :: Fd
stdInput :: Fd
stdInput   = CInt -> Fd
Fd (CInt
0)
{-# LINE 128 "libraries/unix/System/Posix/IO/Common.hsc" #-}
stdOutput  = Fd (1)
stdError :: Fd
{-# LINE 129 "libraries/unix/System/Posix/IO/Common.hsc" #-}
stdError   = Fd (2)
{-# LINE 130 "libraries/unix/System/Posix/IO/Common.hsc" #-}

data OpenMode = ReadOnly | WriteOnly | ReadWrite

-- |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
    OpenFileFlags -> Bool
noctty    :: Bool, -- ^ O_NOCTTY
    OpenFileFlags -> Bool
nonBlock  :: Bool, -- ^ O_NONBLOCK
    OpenFileFlags -> Bool
trunc     :: Bool  -- ^ O_TRUNC
 }


-- |Default values for the 'OpenFileFlags' type. False for each of
-- append, exclusive, noctty, nonBlock, and trunc.
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
  }


-- |Open and optionally create this file.  See 'System.Posix.Files'
-- for information on how to use the 'FileMode' type.
open_  :: CString
       -> OpenMode
       -> Maybe FileMode -- ^Just x => creates the file with the given modes, Nothing => the file must exist.
       -> OpenFileFlags
       -> IO Fd
open_ :: CString -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
open_ CString
str OpenMode
how Maybe FileMode
maybe_mode (OpenFileFlags Bool
appendFlag Bool
exclusiveFlag Bool
nocttyFlag
                                Bool
nonBlockFlag Bool
truncateFlag) = do
    CInt
fd <- CString -> CInt -> FileMode -> IO CInt
c_open CString
str CInt
all_flags FileMode
mode_w
    Fd -> IO Fd
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Fd
Fd CInt
fd)
  where
    all_flags :: CInt
all_flags  = CInt
creat CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
flags CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
open_mode

    flags :: CInt
flags =
       (if Bool
appendFlag    then (CInt
1024)   else CInt
0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
{-# LINE 173 "libraries/unix/System/Posix/IO/Common.hsc" #-}
       (if exclusiveFlag then (128)     else 0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
{-# LINE 174 "libraries/unix/System/Posix/IO/Common.hsc" #-}
       (if nocttyFlag    then (256)   else 0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
{-# LINE 175 "libraries/unix/System/Posix/IO/Common.hsc" #-}
       (if nonBlockFlag  then (2048) else 0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
{-# LINE 176 "libraries/unix/System/Posix/IO/Common.hsc" #-}
       (if truncateFlag  then (512)    else 0)
{-# LINE 177 "libraries/unix/System/Posix/IO/Common.hsc" #-}

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

    open_mode :: CInt
open_mode = case OpenMode
how of
                   OpenMode
ReadOnly  -> (CInt
0)
{-# LINE 184 "libraries/unix/System/Posix/IO/Common.hsc" #-}
                   OpenMode
WriteOnly -> (CInt
1)
{-# LINE 185 "libraries/unix/System/Posix/IO/Common.hsc" #-}
                   OpenMode
ReadWrite -> (CInt
2)
{-# LINE 186 "libraries/unix/System/Posix/IO/Common.hsc" #-}

foreign import capi unsafe "HsUnix.h open"
   c_open :: 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) = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"closeFd" (CInt -> IO CInt
c_close CInt
fd)

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.
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 (Fd -> CInt
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
  String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, Fd))
-> IO Fd
forall a.
String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' String
"handleToFd" Handle
h MVar Handle__
m ((Handle__ -> IO (Handle__, Fd)) -> IO Fd)
-> (Handle__ -> IO (Handle__, Fd)) -> IO Fd
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
_ <- String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, Fd))
-> IO Fd
forall a.
String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' String
"handleToFd" Handle
h MVar Handle__
r ((Handle__ -> IO (Handle__, Fd)) -> IO Fd)
-> (Handle__ -> IO (Handle__, Fd)) -> IO Fd
forall a b. (a -> b) -> a -> b
$ Handle -> Handle__ -> IO (Handle__, Fd)
handleToFd' Handle
h
  String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, Fd))
-> IO Fd
forall a.
String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' String
"handleToFd" Handle
h MVar Handle__
w ((Handle__ -> IO (Handle__, Fd)) -> IO Fd)
-> (Handle__ -> IO (Handle__, Fd)) -> IO Fd
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 (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
haDevice :: dev
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
haDevice :: ()
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haInputNL :: Handle__ -> Newline
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
..} = do
  case dev -> Maybe FD
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
haDevice of
    Maybe FD
Nothing -> IOError -> IO (Handle__, Fd)
forall a. IOError -> IO a
ioError (IOError -> String -> IOError
ioeSetErrorString (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
IllegalOperation
                                           String
"handleToFd" (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h) Maybe String
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
     (Handle__, Fd) -> IO (Handle__, Fd)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__{haType :: HandleType
haType=HandleType
ClosedHandle,dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
haDevice :: dev
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
haDevice :: dev
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..}, 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 245 "libraries/unix/System/Posix/IO/Common.hsc" #-}
fdOption2Int AppendOnWrite     = (1024)
{-# LINE 246 "libraries/unix/System/Posix/IO/Common.hsc" #-}
fdOption2Int NonBlockingRead   = (2048)
{-# LINE 247 "libraries/unix/System/Posix/IO/Common.hsc" #-}
fdOption2Int SynchronousWrites = (1052672)
{-# LINE 248 "libraries/unix/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 <- String -> IO CInt -> IO CInt
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)
  Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CInt
r CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. FdOption -> CInt
fdOption2Int FdOption
opt) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0)
 where
  flag :: CInt
flag    = case FdOption
opt of
              FdOption
CloseOnExec       -> (CInt
1)
{-# LINE 257 "libraries/unix/System/Posix/IO/Common.hsc" #-}
              FdOption
_                 -> (CInt
3)
{-# LINE 258 "libraries/unix/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 <- String -> IO CInt -> IO CInt
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 CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
opt_val
         | Bool
otherwise = CInt
r CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. (CInt -> CInt
forall a. Bits a => a -> a
complement CInt
opt_val)
  String -> IO CInt -> IO ()
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 (CInt -> CLong
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 270 "libraries/unix/System/Posix/IO/Common.hsc" #-}
              FdOption
_                 -> ((CInt
3),(CInt
4))
{-# LINE 271 "libraries/unix/System/Posix/IO/Common.hsc" #-}
  opt_val = fdOption2Int opt

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

mode2Int :: SeekMode -> CInt
mode2Int :: SeekMode -> CInt
mode2Int SeekMode
AbsoluteSeek = (CInt
0)
{-# LINE 278 "libraries/unix/System/Posix/IO/Common.hsc" #-}
mode2Int RelativeSeek = (1)
{-# LINE 279 "libraries/unix/System/Posix/IO/Common.hsc" #-}
mode2Int SeekFromEnd  = (2)
{-# LINE 280 "libraries/unix/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 =
  String -> IO FileOffset -> IO FileOffset
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)

-- | 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 =
  FileLock
-> (Ptr CFLock -> IO (Maybe (ProcessID, FileLock)))
-> IO (Maybe (ProcessID, FileLock))
forall a. FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock FileLock
lock ((Ptr CFLock -> IO (Maybe (ProcessID, FileLock)))
 -> IO (Maybe (ProcessID, FileLock)))
-> (Ptr CFLock -> IO (Maybe (ProcessID, FileLock)))
-> IO (Maybe (ProcessID, FileLock))
forall a b. (a -> b) -> a -> b
$ \Ptr CFLock
p_flock -> do
    String -> IO CInt -> IO ()
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 300 "libraries/unix/System/Posix/IO/Common.hsc" #-}
    result <- bytes2ProcessIDAndLock p_flock
    Maybe (ProcessID, FileLock) -> IO (Maybe (ProcessID, FileLock))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ProcessID, FileLock) -> Maybe (ProcessID, FileLock)
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
_)) = Maybe (a, (LockRequest, b, c, d))
forall a. Maybe a
Nothing
    maybeResult (a, (LockRequest, b, c, d))
x = (a, (LockRequest, b, c, d)) -> Maybe (a, (LockRequest, b, c, d))
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 =
  Int -> (Ptr CFLock -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
32) ((Ptr CFLock -> IO a) -> IO a) -> (Ptr CFLock -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CFLock
p -> do
{-# LINE 309 "libraries/unix/System/Posix/IO/Common.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0))   p (lockReq2Int lockreq :: CShort)
{-# LINE 310 "libraries/unix/System/Posix/IO/Common.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p (fromIntegral (mode2Int mode) :: CShort)
{-# LINE 311 "libraries/unix/System/Posix/IO/Common.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8))  p start
{-# LINE 312 "libraries/unix/System/Posix/IO/Common.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16))    p len
{-# LINE 313 "libraries/unix/System/Posix/IO/Common.hsc" #-}
    io p

lockReq2Int :: LockRequest -> CShort
lockReq2Int :: LockRequest -> CShort
lockReq2Int LockRequest
ReadLock  = (CShort
0)
{-# LINE 317 "libraries/unix/System/Posix/IO/Common.hsc" #-}
lockReq2Int WriteLock = (1)
{-# LINE 318 "libraries/unix/System/Posix/IO/Common.hsc" #-}
lockReq2Int Unlock    = (2)
{-# LINE 319 "libraries/unix/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 -> Ptr CFLock -> Int -> IO CShort
forall b. Ptr b -> Int -> IO CShort
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CFLock
hsc_ptr Int
0))   Ptr CFLock
p
{-# LINE 323 "libraries/unix/System/Posix/IO/Common.hsc" #-}
  mode  <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 324 "libraries/unix/System/Posix/IO/Common.hsc" #-}
  start <- ((\hsc_ptr -> peekByteOff hsc_ptr 8))  p
{-# LINE 325 "libraries/unix/System/Posix/IO/Common.hsc" #-}
  len   <- ((\hsc_ptr -> peekByteOff hsc_ptr 16))    p
{-# LINE 326 "libraries/unix/System/Posix/IO/Common.hsc" #-}
  pid   <- ((\hsc_ptr -> peekByteOff hsc_ptr 24))    p
{-# LINE 327 "libraries/unix/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 331 "libraries/unix/System/Posix/IO/Common.hsc" #-}
  int2req (1) = WriteLock
{-# LINE 332 "libraries/unix/System/Posix/IO/Common.hsc" #-}
  int2req (2) = Unlock
{-# LINE 333 "libraries/unix/System/Posix/IO/Common.hsc" #-}
  int2req _ = error $ "int2req: bad argument"

  int2mode :: CShort -> SeekMode
  int2mode :: CShort -> SeekMode
int2mode (CShort
0) = SeekMode
AbsoluteSeek
{-# LINE 337 "libraries/unix/System/Posix/IO/Common.hsc" #-}
  int2mode (1) = RelativeSeek
{-# LINE 338 "libraries/unix/System/Posix/IO/Common.hsc" #-}
  int2mode (2) = SeekFromEnd
{-# LINE 339 "libraries/unix/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
  FileLock -> (Ptr CFLock -> IO ()) -> IO ()
forall a. FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock FileLock
lock ((Ptr CFLock -> IO ()) -> IO ()) -> (Ptr CFLock -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CFLock
p_flock ->
    String -> IO CInt -> IO ()
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 346 "libraries/unix/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
  FileLock -> (Ptr CFLock -> IO ()) -> IO ()
forall a. FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock FileLock
lock ((Ptr CFLock -> IO ()) -> IO ()) -> (Ptr CFLock -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CFLock
p_flock ->
    String -> IO CInt -> IO ()
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 353 "libraries/unix/System/Posix/IO/Common.hsc" #-}

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

-- | Read data from an 'Fd' and convert it to a 'String' using the locale encoding.
-- Throws an exception if this is an invalid descriptor, or EOF has been
-- reached.
fdRead :: Fd
       -> ByteCount -- ^How many bytes to read
       -> IO (String, ByteCount) -- ^The bytes read, how many bytes were read.
fdRead :: Fd -> ByteCount -> IO (String, ByteCount)
fdRead Fd
_fd ByteCount
0 = (String, ByteCount) -> IO (String, ByteCount)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"", ByteCount
0)
fdRead Fd
fd ByteCount
nbytes = do
    Int
-> (Ptr Word8 -> IO (String, ByteCount)) -> IO (String, ByteCount)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (ByteCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
nbytes) ((Ptr Word8 -> IO (String, ByteCount)) -> IO (String, ByteCount))
-> (Ptr Word8 -> IO (String, ByteCount)) -> IO (String, ByteCount)
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
buf -> do
    ByteCount
rc <- Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
fdReadBuf Fd
fd Ptr Word8
buf ByteCount
nbytes
    case ByteCount
rc of
      ByteCount
0 -> IOError -> IO (String, ByteCount)
forall a. IOError -> IO a
ioError (IOError -> String -> IOError
ioeSetErrorString (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
EOF String
"fdRead" Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) String
"EOF")
      ByteCount
n -> do
       String
s <- CStringLen -> IO String
peekCStringLen (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf, ByteCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
n)
       (String, ByteCount) -> IO (String, ByteCount)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
s, ByteCount
n)

-- | 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 = ByteCount -> IO ByteCount
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteCount
0
fdReadBuf Fd
fd Ptr Word8
buf ByteCount
nbytes =
  (CSsize -> ByteCount) -> IO CSsize -> IO ByteCount
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSsize -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CSsize -> IO ByteCount) -> IO CSsize -> IO ByteCount
forall a b. (a -> b) -> a -> b
$
    String -> IO CSsize -> IO CSsize
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"fdReadBuf" (IO CSsize -> IO CSsize) -> IO CSsize -> IO CSsize
forall a b. (a -> b) -> a -> b
$
      CInt -> CString -> ByteCount -> IO CSsize
c_safe_read (Fd -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd) (Ptr Word8 -> CString
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 a 'String' to an 'Fd' using the locale encoding.
fdWrite :: Fd -> String -> IO ByteCount
fdWrite :: Fd -> String -> IO ByteCount
fdWrite Fd
fd String
str =
  String -> (CStringLen -> IO ByteCount) -> IO ByteCount
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str ((CStringLen -> IO ByteCount) -> IO ByteCount)
-> (CStringLen -> IO ByteCount) -> IO ByteCount
forall a b. (a -> b) -> a -> b
$ \ (CString
buf,Int
len) ->
    Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
fdWriteBuf Fd
fd (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
buf) (Int -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

-- | 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 =
  (CSsize -> ByteCount) -> IO CSsize -> IO ByteCount
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSsize -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CSsize -> IO ByteCount) -> IO CSsize -> IO ByteCount
forall a b. (a -> b) -> a -> b
$
    String -> IO CSsize -> IO CSsize
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"fdWriteBuf" (IO CSsize -> IO CSsize) -> IO CSsize -> IO CSsize
forall a b. (a -> b) -> a -> b
$
      CInt -> CString -> ByteCount -> IO CSsize
c_safe_write (Fd -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd) (Ptr Word8 -> CString
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