{-# 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 (
stdInput, stdOutput, stdError,
OpenMode(..),
OpenFileFlags(..), defaultFileFlags,
open_,
closeFd,
fdRead, fdWrite,
fdReadBuf, fdWriteBuf,
fdSeek,
FdOption(..),
queryFdOption,
setFdOption,
FileLock,
LockRequest(..),
getLock, setLock,
waitToSetLock,
createPipe,
dup, dupTo,
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)
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
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)
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
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
data OpenFileFlags =
OpenFileFlags {
OpenFileFlags -> Bool
append :: Bool,
OpenFileFlags -> Bool
exclusive :: Bool,
OpenFileFlags -> Bool
noctty :: Bool,
OpenFileFlags -> Bool
nonBlock :: Bool,
OpenFileFlags -> Bool
trunc :: Bool
}
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_ :: CString
-> OpenMode
-> Maybe FileMode
-> 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
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Fd
Fd CInt
fd)
where
all_flags :: CInt
all_flags = CInt
creat forall a. Bits a => a -> a -> a
.|. CInt
flags forall a. Bits a => a -> a -> a
.|. CInt
open_mode
flags :: CInt
flags =
(if Bool
appendFlag then (CInt
1024) else CInt
0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 173 "libraries/unix/System/Posix/IO/Common.hsc" #-}
(if exclusiveFlag then (128) else 0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 174 "libraries/unix/System/Posix/IO/Common.hsc" #-}
(if nocttyFlag then (256) else 0) forall a. Bits a => a -> a -> a
.|.
{-# LINE 175 "libraries/unix/System/Posix/IO/Common.hsc" #-}
(if nonBlockFlag then (2048) else 0) 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
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)
foreign import ccall unsafe "HsUnix.h close"
c_close :: CInt -> IO CInt
handleToFd :: Handle -> IO Fd
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
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
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))
data FdOption = AppendOnWrite
| CloseOnExec
| NonBlockingRead
| SynchronousWrites
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" #-}
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 257 "libraries/unix/System/Posix/IO/Common.hsc" #-}
FdOption
_ -> (CInt
3)
{-# LINE 258 "libraries/unix/System/Posix/IO/Common.hsc" #-}
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 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
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" #-}
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))
data LockRequest = ReadLock
| WriteLock
| Unlock
type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset)
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 300 "libraries/unix/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 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 -> 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"
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 346 "libraries/unix/System/Posix/IO/Common.hsc" #-}
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 353 "libraries/unix/System/Posix/IO/Common.hsc" #-}
fdRead :: Fd
-> ByteCount
-> IO (String, ByteCount)
fdRead :: Fd -> ByteCount -> IO (String, ByteCount)
fdRead Fd
_fd ByteCount
0 = forall (m :: * -> *) a. Monad m => a -> m a
return (String
"", ByteCount
0)
fdRead Fd
fd ByteCount
nbytes = do
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
nbytes) 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 -> forall a. IOError -> IO a
ioError (IOError -> String -> IOError
ioeSetErrorString (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
EOF String
"fdRead" forall a. Maybe a
Nothing forall a. Maybe a
Nothing) String
"EOF")
ByteCount
n -> do
String
s <- CStringLen -> IO String
peekCStringLen (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf, forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
n)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
s, ByteCount
n)
fdReadBuf :: Fd
-> Ptr Word8
-> ByteCount
-> IO ByteCount
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
fdWrite :: Fd -> String -> IO ByteCount
fdWrite :: Fd -> String -> IO ByteCount
fdWrite Fd
fd String
str =
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str forall a b. (a -> b) -> a -> b
$ \ (CString
buf,Int
len) ->
Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
fdWriteBuf Fd
fd (forall a b. Ptr a -> Ptr b
castPtr CString
buf) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
fdWriteBuf :: Fd
-> Ptr Word8
-> ByteCount
-> IO ByteCount
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