module System.Posix.FileControl
( fcntl
, Fcntl(..)
, FileDescriptorFlags
, pattern FD_CLOEXEC
, FileStatusFlags
, pattern O_RDONLY
, pattern O_WRONLY
, pattern O_RDWR
, pattern O_ACCMODE
, pattern O_CREAT
, pattern O_EXCL
, pattern O_NONBLOCK
, pattern O_NOCTTY
, pattern O_TRUNC
, pattern O_APPEND
, pattern O_NDELAY
, Flock
, newFlock
, flockType
, FlockType
, pattern F_RDLCK
, pattern F_WRLCK
, pattern F_UNLCK
, flockWhence
, FlockWhence
, pattern SEEK_SET
, pattern SEEK_CUR
, pattern SEEK_END
, flockStart
, flockLen
, flockPid
) where
import Control.Applicative
import Foreign
import Foreign.C
import System.Posix.Types
import Prelude
import Foreign.Var hiding (get)
fcntl :: Fd -> Fcntl a -> IO a
fcntl fd cmd = case cmd of
F_DUPFD minFd ->
fcntl_set_int fd (0) minFd
F_DUPFD_CLOEXEC minFd ->
fcntl_set_int fd (1030) minFd
F_GETFD ->
FileDescriptorFlags <$> fcntl_get_int fd (1)
F_SETFD (FileDescriptorFlags flags) ->
fcntl_set_int_ fd (2) flags
F_GETFL ->
FileStatusFlags <$> fcntl_get_int fd (3)
F_SETFL (FileStatusFlags flags) ->
fcntl_set_int_ fd (4) flags
F_GETLK ->
fcntl_get_flock fd (5)
F_SETLK flock ->
fcntl_set_flock fd (6) flock
F_SETLKW flock ->
fcntl_set_flock fd (7) flock
F_GETOWN ->
fcntl_get_int fd (9)
F_SETOWN pid ->
fcntl_set_int_ fd (4) pid
data Fcntl a where
F_DUPFD :: Fd -> Fcntl Fd
F_DUPFD_CLOEXEC :: Fd -> Fcntl Fd
F_GETFD :: Fcntl FileDescriptorFlags
F_SETFD :: FileDescriptorFlags -> Fcntl ()
F_GETFL :: Fcntl FileStatusFlags
F_SETFL :: FileStatusFlags -> Fcntl ()
F_GETLK :: Fcntl Flock
F_SETLK :: Flock -> Fcntl ()
F_SETLKW :: Flock -> Fcntl ()
F_GETOWN :: Fcntl ProcessID
F_SETOWN :: ProcessID -> Fcntl ()
fcntl_get_int :: Integral a => Fd -> CInt -> IO a
fcntl_get_int fd cmd =
fromIntegral <$> throwErrnoIfMinus1 "fcntl"
(c_fcntl_get_int (fromIntegral fd) cmd)
foreign import ccall safe "fcntl"
c_fcntl_get_int :: CInt -> CInt -> IO CInt
fcntl_set_int :: (Integral a, Integral b) => Fd -> CInt -> a -> IO b
fcntl_set_int fd cmd n =
fromIntegral <$> throwErrnoIfMinus1 "fcntl"
(c_fcntl_set_int (fromIntegral fd) cmd (fromIntegral n))
fcntl_set_int_ :: Integral a => Fd -> CInt -> a -> IO ()
fcntl_set_int_ fd cmd n =
throwErrnoIfMinus1_ "fcntl"
(c_fcntl_set_int (fromIntegral fd) cmd (fromIntegral n))
foreign import ccall safe "fcntl"
c_fcntl_set_int :: CInt -> CInt -> CInt -> IO CInt
fcntl_get_flock :: Fd -> CInt -> IO Flock
fcntl_get_flock fd cmd = do
flock <- newFlock
throwErrnoIfMinus1_ "fcntl" $
withFlock flock $ c_fcntl_get_flock (fromIntegral fd) cmd
return flock
foreign import ccall safe "fcntl"
c_fcntl_get_flock :: CInt -> CInt -> Ptr Flock -> IO CInt
fcntl_set_flock :: Fd -> CInt -> Flock -> IO ()
fcntl_set_flock fd cmd flock =
throwErrnoIfMinus1_ "fcntl" $
withFlock flock $ c_fcntl_set_flock (fromIntegral fd) cmd
foreign import ccall safe "fcntl"
c_fcntl_set_flock :: CInt -> CInt -> Ptr Flock -> IO CInt
newtype FileDescriptorFlags = FileDescriptorFlags CInt
pattern FD_CLOEXEC :: FileDescriptorFlags
pattern FD_CLOEXEC = FileDescriptorFlags 4207876
newtype FileStatusFlags = FileStatusFlags CInt
pattern O_RDONLY :: FileStatusFlags
pattern O_RDONLY <- ((\(FileStatusFlags n) -> n .&. _O_RDONLY > 0) -> True)
where
O_RDONLY = FileStatusFlags _O_RDONLY
_O_RDONLY :: CInt
_O_RDONLY = 4208081
pattern O_WRONLY :: FileStatusFlags
pattern O_WRONLY <- ((\(FileStatusFlags n) -> n .&. _O_WRONLY > 0) -> True)
where
O_WRONLY = FileStatusFlags _O_WRONLY
_O_WRONLY :: CInt
_O_WRONLY = 4208223
pattern O_RDWR :: FileStatusFlags
pattern O_RDWR <- ((\(FileStatusFlags n) -> n .&. _O_RDWR > 0) -> True)
where
O_RDWR = FileStatusFlags _O_RDWR
_O_RDWR :: CInt
_O_RDWR = 4208232
pattern O_ACCMODE :: FileStatusFlags
pattern O_ACCMODE <- ((\(FileStatusFlags n) -> n .&. _O_ACCMODE > 0) -> True)
where
O_ACCMODE = FileStatusFlags _O_ACCMODE
_O_ACCMODE :: CInt
_O_ACCMODE = 4208239
pattern O_CREAT :: FileStatusFlags
pattern O_CREAT <- ((\(FileStatusFlags n) -> n .&. _O_CREAT > 0) -> True)
where
O_CREAT = FileStatusFlags _O_CREAT
_O_CREAT :: CInt
_O_CREAT = 4208270
pattern O_EXCL :: FileStatusFlags
pattern O_EXCL <- ((\(FileStatusFlags n) -> n .&. _O_EXCL > 0) -> True)
where
O_EXCL = FileStatusFlags _O_EXCL
_O_EXCL :: CInt
_O_EXCL = 4208278
pattern O_NONBLOCK :: FileStatusFlags
pattern O_NONBLOCK <- ((\(FileStatusFlags n) -> n .&. _O_NONBLOCK > 0) -> True)
where
O_NONBLOCK = FileStatusFlags _O_NONBLOCK
_O_NONBLOCK :: CInt
_O_NONBLOCK = 4208285
pattern O_NOCTTY :: FileStatusFlags
pattern O_NOCTTY <- ((\(FileStatusFlags n) -> n .&. _O_NOCTTY > 0) -> True)
where
O_NOCTTY = FileStatusFlags _O_NOCTTY
_O_NOCTTY :: CInt
_O_NOCTTY = 4208296
pattern O_TRUNC :: FileStatusFlags
pattern O_TRUNC <- ((\(FileStatusFlags n) -> n .&. _O_TRUNC > 0) -> True)
where
O_TRUNC = FileStatusFlags _O_TRUNC
_O_TRUNC :: CInt
_O_TRUNC = 4208305
pattern O_APPEND :: FileStatusFlags
pattern O_APPEND <- ((\(FileStatusFlags n) -> n .&. _O_APPEND > 0) -> True)
where
O_APPEND = FileStatusFlags _O_APPEND
_O_APPEND :: CInt
_O_APPEND = 4208338
pattern O_NDELAY :: FileStatusFlags
pattern O_NDELAY <- ((\(FileStatusFlags n) -> n .&. _O_NDELAY > 0) -> True)
where
O_NDELAY = FileStatusFlags _O_NDELAY
_O_NDELAY :: CInt
_O_NDELAY = 4208347
newtype Flock = Flock (ForeignPtr Flock)
withFlock :: Flock -> (Ptr Flock -> IO a) -> IO a
withFlock (Flock fptr) = withForeignPtr fptr
newFlock :: IO Flock
newFlock = Flock <$> mallocForeignPtrBytes ((32))
newtype FlockType = FlockType CInt
pattern F_RDLCK :: FlockType
pattern F_RDLCK = FlockType 4208816
pattern F_WRLCK :: FlockType
pattern F_WRLCK = FlockType 4208824
pattern F_UNLCK :: FlockType
pattern F_UNLCK = FlockType 4208832
flockType :: Flock -> Var FlockType
flockType flock = Var get set
where
get = FlockType <$> withFlock flock ((\hsc_ptr -> peekByteOff hsc_ptr 0))
set (FlockType ty) = withFlock flock $ \p ->
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ty
newtype FlockWhence = FlockWhence CInt
pattern SEEK_SET :: FlockWhence
pattern SEEK_SET = FlockWhence 4209166
pattern SEEK_CUR :: FlockWhence
pattern SEEK_CUR = FlockWhence 4209175
pattern SEEK_END :: FlockWhence
pattern SEEK_END = FlockWhence 4209184
flockWhence :: Flock -> Var FlockWhence
flockWhence flock = Var get set
where
get = FlockWhence <$> withFlock flock ((\hsc_ptr -> peekByteOff hsc_ptr 2))
set (FlockWhence whence) = withFlock flock $ \p ->
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p whence
flockStart :: Flock -> Var FileOffset
flockStart flock = Var get set
where
get = withFlock flock ((\hsc_ptr -> peekByteOff hsc_ptr 8))
set offset = withFlock flock $ \p -> ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p offset
flockLen :: Flock -> Var FileOffset
flockLen flock = Var get set
where
get = withFlock flock ((\hsc_ptr -> peekByteOff hsc_ptr 16))
set len = withFlock flock $ \p -> ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p len
flockPid :: Flock -> Var ProcessID
flockPid flock = Var get set
where
get = withFlock flock ((\hsc_ptr -> peekByteOff hsc_ptr 24))
set pid = withFlock flock $ \p -> ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p pid