{-# LINE 1 "libraries/unix/System/Posix/IO/Common.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe #-}
module System.Posix.IO.Common (
stdInput, stdOutput, stdError,
OpenMode(..),
OpenFileFlags(..), defaultFileFlags,
openat_,
closeFd,
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)
{-# LINE 81 "libraries/unix/System/Posix/IO/Common.hsc" #-}
{-# LINE 92 "libraries/unix/System/Posix/IO/Common.hsc" #-}
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
{-# LINE 114 "libraries/unix/System/Posix/IO/Common.hsc" #-}
{-# LINE 128 "libraries/unix/System/Posix/IO/Common.hsc" #-}
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)
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
{-# LINE 149 "libraries/unix/System/Posix/IO/Common.hsc" #-}
stdInput, stdOutput, stdError :: Fd
stdInput :: Fd
stdInput = CInt -> Fd
Fd (CInt
0)
{-# LINE 155 "libraries/unix/System/Posix/IO/Common.hsc" #-}
stdOutput = Fd (1)
stdError :: Fd
{-# LINE 156 "libraries/unix/System/Posix/IO/Common.hsc" #-}
stdError = Fd (2)
{-# LINE 157 "libraries/unix/System/Posix/IO/Common.hsc" #-}
data OpenMode = ReadOnly | WriteOnly | ReadWrite
deriving (ReadPrec [OpenMode]
ReadPrec OpenMode
Int -> ReadS OpenMode
ReadS [OpenMode]
(Int -> ReadS OpenMode)
-> ReadS [OpenMode]
-> ReadPrec OpenMode
-> ReadPrec [OpenMode]
-> Read OpenMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OpenMode
readsPrec :: Int -> ReadS OpenMode
$creadList :: ReadS [OpenMode]
readList :: ReadS [OpenMode]
$creadPrec :: ReadPrec OpenMode
readPrec :: ReadPrec OpenMode
$creadListPrec :: ReadPrec [OpenMode]
readListPrec :: ReadPrec [OpenMode]
Read, Int -> OpenMode -> ShowS
[OpenMode] -> ShowS
OpenMode -> String
(Int -> OpenMode -> ShowS)
-> (OpenMode -> String) -> ([OpenMode] -> ShowS) -> Show OpenMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenMode -> ShowS
showsPrec :: Int -> OpenMode -> ShowS
$cshow :: OpenMode -> String
show :: OpenMode -> String
$cshowList :: [OpenMode] -> ShowS
showList :: [OpenMode] -> ShowS
Show, OpenMode -> OpenMode -> Bool
(OpenMode -> OpenMode -> Bool)
-> (OpenMode -> OpenMode -> Bool) -> Eq OpenMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenMode -> OpenMode -> Bool
== :: OpenMode -> OpenMode -> Bool
$c/= :: OpenMode -> OpenMode -> Bool
/= :: OpenMode -> OpenMode -> Bool
Eq, Eq OpenMode
Eq OpenMode =>
(OpenMode -> OpenMode -> Ordering)
-> (OpenMode -> OpenMode -> Bool)
-> (OpenMode -> OpenMode -> Bool)
-> (OpenMode -> OpenMode -> Bool)
-> (OpenMode -> OpenMode -> Bool)
-> (OpenMode -> OpenMode -> OpenMode)
-> (OpenMode -> OpenMode -> OpenMode)
-> Ord 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
$ccompare :: OpenMode -> OpenMode -> Ordering
compare :: OpenMode -> OpenMode -> Ordering
$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
>= :: OpenMode -> OpenMode -> Bool
$cmax :: OpenMode -> OpenMode -> OpenMode
max :: OpenMode -> OpenMode -> OpenMode
$cmin :: OpenMode -> OpenMode -> OpenMode
min :: OpenMode -> OpenMode -> OpenMode
Ord)
data OpenFileFlags =
OpenFileFlags {
OpenFileFlags -> Bool
append :: Bool,
OpenFileFlags -> Bool
exclusive :: Bool,
OpenFileFlags -> Bool
noctty :: Bool,
OpenFileFlags -> Bool
nonBlock :: Bool,
OpenFileFlags -> Bool
trunc :: Bool,
OpenFileFlags -> Bool
nofollow :: Bool,
OpenFileFlags -> Maybe FileMode
creat :: Maybe FileMode,
OpenFileFlags -> Bool
cloexec :: Bool,
OpenFileFlags -> Bool
directory :: Bool,
OpenFileFlags -> Bool
sync :: Bool
}
deriving (ReadPrec [OpenFileFlags]
ReadPrec OpenFileFlags
Int -> ReadS OpenFileFlags
ReadS [OpenFileFlags]
(Int -> ReadS OpenFileFlags)
-> ReadS [OpenFileFlags]
-> ReadPrec OpenFileFlags
-> ReadPrec [OpenFileFlags]
-> Read OpenFileFlags
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OpenFileFlags
readsPrec :: Int -> ReadS OpenFileFlags
$creadList :: ReadS [OpenFileFlags]
readList :: ReadS [OpenFileFlags]
$creadPrec :: ReadPrec OpenFileFlags
readPrec :: ReadPrec OpenFileFlags
$creadListPrec :: ReadPrec [OpenFileFlags]
readListPrec :: ReadPrec [OpenFileFlags]
Read, Int -> OpenFileFlags -> ShowS
[OpenFileFlags] -> ShowS
OpenFileFlags -> String
(Int -> OpenFileFlags -> ShowS)
-> (OpenFileFlags -> String)
-> ([OpenFileFlags] -> ShowS)
-> Show OpenFileFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenFileFlags -> ShowS
showsPrec :: Int -> OpenFileFlags -> ShowS
$cshow :: OpenFileFlags -> String
show :: OpenFileFlags -> String
$cshowList :: [OpenFileFlags] -> ShowS
showList :: [OpenFileFlags] -> ShowS
Show, OpenFileFlags -> OpenFileFlags -> Bool
(OpenFileFlags -> OpenFileFlags -> Bool)
-> (OpenFileFlags -> OpenFileFlags -> Bool) -> Eq OpenFileFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenFileFlags -> OpenFileFlags -> Bool
== :: OpenFileFlags -> OpenFileFlags -> Bool
$c/= :: OpenFileFlags -> OpenFileFlags -> Bool
/= :: OpenFileFlags -> OpenFileFlags -> Bool
Eq, Eq OpenFileFlags
Eq OpenFileFlags =>
(OpenFileFlags -> OpenFileFlags -> Ordering)
-> (OpenFileFlags -> OpenFileFlags -> Bool)
-> (OpenFileFlags -> OpenFileFlags -> Bool)
-> (OpenFileFlags -> OpenFileFlags -> Bool)
-> (OpenFileFlags -> OpenFileFlags -> Bool)
-> (OpenFileFlags -> OpenFileFlags -> OpenFileFlags)
-> (OpenFileFlags -> OpenFileFlags -> OpenFileFlags)
-> Ord 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
$ccompare :: OpenFileFlags -> OpenFileFlags -> Ordering
compare :: OpenFileFlags -> OpenFileFlags -> Ordering
$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
>= :: OpenFileFlags -> OpenFileFlags -> Bool
$cmax :: OpenFileFlags -> OpenFileFlags -> OpenFileFlags
max :: OpenFileFlags -> OpenFileFlags -> OpenFileFlags
$cmin :: OpenFileFlags -> OpenFileFlags -> OpenFileFlags
min :: OpenFileFlags -> OpenFileFlags -> OpenFileFlags
Ord)
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 = Maybe FileMode
forall a. Maybe a
Nothing,
cloexec :: Bool
cloexec = Bool
False,
directory :: Bool
directory = Bool
False,
sync :: Bool
sync = Bool
False
}
openat_ :: Maybe Fd
-> CString
-> OpenMode
-> OpenFileFlags
-> 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 (CInt -> Fd) -> IO CInt -> IO 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 = CInt -> (Fd -> CInt) -> Maybe Fd -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-CInt
100) (\ (Fd CInt
fd) -> CInt
fd) Maybe Fd
fdMay
{-# LINE 224 "libraries/unix/System/Posix/IO/Common.hsc" #-}
all_flags = creat .|. flags .|. 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 228 "libraries/unix/System/Posix/IO/Common.hsc" #-}
(if exclusiveFlag then (128) else 0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
{-# LINE 229 "libraries/unix/System/Posix/IO/Common.hsc" #-}
(if nocttyFlag then (256) else 0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
{-# LINE 230 "libraries/unix/System/Posix/IO/Common.hsc" #-}
(if nonBlockFlag then (2048) else 0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
{-# LINE 231 "libraries/unix/System/Posix/IO/Common.hsc" #-}
(if truncateFlag then (512) else 0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
{-# LINE 232 "libraries/unix/System/Posix/IO/Common.hsc" #-}
(if nofollowFlag then (131072) else 0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
{-# LINE 233 "libraries/unix/System/Posix/IO/Common.hsc" #-}
(if cloexecFlag then (524288) else 0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
{-# LINE 234 "libraries/unix/System/Posix/IO/Common.hsc" #-}
(if directoryFlag then (65536) else 0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
{-# LINE 235 "libraries/unix/System/Posix/IO/Common.hsc" #-}
(if syncFlag then (1052672) else 0)
{-# LINE 236 "libraries/unix/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 "libraries/unix/System/Posix/IO/Common.hsc" #-}
open_mode :: CInt
open_mode = case OpenMode
how of
OpenMode
ReadOnly -> (CInt
0)
{-# LINE 243 "libraries/unix/System/Posix/IO/Common.hsc" #-}
OpenMode
WriteOnly -> (CInt
1)
{-# LINE 244 "libraries/unix/System/Posix/IO/Common.hsc" #-}
OpenMode
ReadWrite -> (CInt
2)
{-# LINE 245 "libraries/unix/System/Posix/IO/Common.hsc" #-}
foreign import capi unsafe "HsUnix.h openat"
c_openat :: CInt -> CString -> CInt -> CMode -> IO CInt
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
handleToFd :: Handle -> IO Fd
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
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
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))
data FdOption = AppendOnWrite
| CloseOnExec
| NonBlockingRead
| SynchronousWrites
fdOption2Int :: FdOption -> CInt
fdOption2Int :: FdOption -> CInt
fdOption2Int FdOption
CloseOnExec = (CInt
1)
{-# LINE 318 "libraries/unix/System/Posix/IO/Common.hsc" #-}
fdOption2Int AppendOnWrite = (1024)
{-# LINE 319 "libraries/unix/System/Posix/IO/Common.hsc" #-}
fdOption2Int NonBlockingRead = (2048)
{-# LINE 320 "libraries/unix/System/Posix/IO/Common.hsc" #-}
fdOption2Int SynchronousWrites = (1052672)
{-# LINE 321 "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 <- 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 330 "libraries/unix/System/Posix/IO/Common.hsc" #-}
FdOption
_ -> (CInt
3)
{-# LINE 331 "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 <- 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 343 "libraries/unix/System/Posix/IO/Common.hsc" #-}
FdOption
_ -> ((CInt
3),(CInt
4))
{-# LINE 344 "libraries/unix/System/Posix/IO/Common.hsc" #-}
opt_val = fdOption2Int opt
mode2Int :: SeekMode -> CInt
mode2Int :: SeekMode -> CInt
mode2Int SeekMode
AbsoluteSeek = (CInt
0)
{-# LINE 351 "libraries/unix/System/Posix/IO/Common.hsc" #-}
mode2Int RelativeSeek = (1)
{-# LINE 352 "libraries/unix/System/Posix/IO/Common.hsc" #-}
mode2Int SeekFromEnd = (2)
{-# LINE 353 "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 =
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))
data LockRequest = ReadLock
| WriteLock
| Unlock
type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset)
{-# LINE 386 "libraries/unix/System/Posix/IO/Common.hsc" #-}
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 392 "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 401 "libraries/unix/System/Posix/IO/Common.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p (lockReq2Int lockreq :: CShort)
{-# LINE 402 "libraries/unix/System/Posix/IO/Common.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p (fromIntegral (mode2Int mode) :: CShort)
{-# LINE 403 "libraries/unix/System/Posix/IO/Common.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p start
{-# LINE 404 "libraries/unix/System/Posix/IO/Common.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p len
{-# LINE 405 "libraries/unix/System/Posix/IO/Common.hsc" #-}
io p
lockReq2Int :: LockRequest -> CShort
lockReq2Int :: LockRequest -> CShort
lockReq2Int LockRequest
ReadLock = (CShort
0)
{-# LINE 409 "libraries/unix/System/Posix/IO/Common.hsc" #-}
lockReq2Int WriteLock = (1)
{-# LINE 410 "libraries/unix/System/Posix/IO/Common.hsc" #-}
lockReq2Int Unlock = (2)
{-# LINE 411 "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 415 "libraries/unix/System/Posix/IO/Common.hsc" #-}
mode <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 416 "libraries/unix/System/Posix/IO/Common.hsc" #-}
start <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 417 "libraries/unix/System/Posix/IO/Common.hsc" #-}
len <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 418 "libraries/unix/System/Posix/IO/Common.hsc" #-}
pid <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 419 "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 423 "libraries/unix/System/Posix/IO/Common.hsc" #-}
int2req (1) = WriteLock
{-# LINE 424 "libraries/unix/System/Posix/IO/Common.hsc" #-}
int2req (2) = Unlock
{-# LINE 425 "libraries/unix/System/Posix/IO/Common.hsc" #-}
int2req _ = error $ "int2req: bad argument"
int2mode :: CShort -> SeekMode
int2mode :: CShort -> SeekMode
int2mode (CShort
0) = SeekMode
AbsoluteSeek
{-# LINE 429 "libraries/unix/System/Posix/IO/Common.hsc" #-}
int2mode (1) = RelativeSeek
{-# LINE 430 "libraries/unix/System/Posix/IO/Common.hsc" #-}
int2mode (2) = SeekFromEnd
{-# LINE 431 "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
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 438 "libraries/unix/System/Posix/IO/Common.hsc" #-}
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 445 "libraries/unix/System/Posix/IO/Common.hsc" #-}
{-# LINE 447 "libraries/unix/System/Posix/IO/Common.hsc" #-}
fdReadBuf :: Fd
-> Ptr Word8
-> ByteCount
-> IO ByteCount
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
fdWriteBuf :: Fd
-> Ptr Word8
-> ByteCount
-> IO ByteCount
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