{-# language BangPatterns #-}
{-# language BinaryLiterals #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
{-# language TypeApplications #-}
{-# language UnliftedFFITypes #-}
module Posix.File
(
uninterruptibleGetDescriptorFlags
, uninterruptibleGetStatusFlags
, uninterruptibleWriteByteArray
, uninterruptibleWriteBytes
, uninterruptibleWriteBytesCompletely
, uninterruptibleWriteBytesCompletelyErrno
, writeBytesCompletelyErrno
, uninterruptibleOpen
, uninterruptibleOpenMode
, uninterruptibleOpenUntypedFlags
, uninterruptibleOpenModeUntypedFlags
, writeByteArray
, writeMutableByteArray
, close
, uninterruptibleClose
, uninterruptibleErrorlessClose
, uninterruptibleUnlink
, uninterruptibleLink
, AccessMode(..)
, CreationFlags(..)
, DescriptorFlags(..)
, StatusFlags(..)
, Types.nonblocking
, Types.append
, isReadOnly
, isWriteOnly
, isReadWrite
, Types.readOnly
, Types.writeOnly
, Types.readWrite
, Types.create
, Types.truncate
, Types.exclusive
) where
import Assertion (assertByteArrayPinned,assertMutableByteArrayPinned)
import Data.Bits ((.&.),(.|.))
import Data.Primitive (ByteArray(..))
import Foreign.C.Error (Errno(Errno),getErrno,eOK)
import Foreign.C.String.Managed (ManagedCString(..))
import Foreign.C.Types (CInt(..),CSize(..))
import GHC.Exts (ByteArray#,MutableByteArray#,RealWorld)
import Posix.File.Types (CreationFlags(..),AccessMode(..),StatusFlags(..))
import Posix.File.Types (DescriptorFlags(..))
import System.Posix.Types (Fd(..),CSsize(..),CMode(..))
import Data.Bytes.Types (Bytes(Bytes))
import Data.Primitive (MutableByteArray(MutableByteArray))
import qualified Posix.File.Types as Types
uninterruptibleGetDescriptorFlags :: Fd -> IO (Either Errno DescriptorFlags)
uninterruptibleGetDescriptorFlags :: Fd -> IO (Either Errno DescriptorFlags)
uninterruptibleGetDescriptorFlags !Fd
fd = Fd -> IO DescriptorFlags
c_getFdFlags Fd
fd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DescriptorFlags -> IO (Either Errno DescriptorFlags)
errorsFromDescriptorFlags
uninterruptibleGetStatusFlags :: Fd -> IO (Either Errno StatusFlags)
uninterruptibleGetStatusFlags :: Fd -> IO (Either Errno StatusFlags)
uninterruptibleGetStatusFlags !Fd
fd = Fd -> IO StatusFlags
c_getFlFlags Fd
fd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StatusFlags -> IO (Either Errno StatusFlags)
errorsFromStatusFlags
foreign import ccall unsafe "HaskellPosix.h hs_get_fd_flags"
c_getFdFlags :: Fd -> IO DescriptorFlags
foreign import ccall unsafe "HaskellPosix.h hs_get_fl_flags"
c_getFlFlags :: Fd -> IO StatusFlags
foreign import ccall unsafe "HaskellPosix.h write_offset"
c_unsafe_bytearray_write :: Fd -> ByteArray# -> Int -> CSize -> IO CSsize
foreign import ccall unsafe "HaskellPosix.h write_offset_loop"
c_unsafe_bytearray_write_loop :: Fd -> ByteArray# -> Int -> CSize -> IO Errno
foreign import ccall safe "HaskellPosix.h write_offset_loop"
c_safe_bytearray_write_loop :: Fd -> ByteArray# -> Int -> CSize -> IO Errno
foreign import ccall safe "HaskellPosix.h write_offset"
c_safe_bytearray_write :: Fd -> ByteArray# -> Int -> CSize -> IO CSsize
foreign import ccall safe "HaskellPosix.h write_offset"
c_safe_mutablebytearray_write :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> IO CSsize
foreign import ccall unsafe "HaskellPosix.h open"
c_unsafe_open :: ByteArray# -> CInt -> IO Fd
foreign import ccall unsafe "HaskellPosix.h open"
c_unsafe_open_mode :: ByteArray# -> CInt -> CMode -> IO Fd
foreign import ccall unsafe "HaskellPosix.h unlink"
c_unsafe_unlink :: ByteArray# -> IO CInt
foreign import ccall unsafe "HaskellPosix.h link"
c_unsafe_link :: ByteArray# -> ByteArray# -> IO CInt
foreign import ccall safe "unistd.h close"
c_safe_close :: Fd -> IO CInt
foreign import ccall unsafe "unistd.h close"
c_unsafe_close :: Fd -> IO CInt
uninterruptibleOpen ::
ManagedCString
-> AccessMode
-> CreationFlags
-> StatusFlags
-> IO (Either Errno Fd)
uninterruptibleOpen :: ManagedCString
-> AccessMode
-> CreationFlags
-> StatusFlags
-> IO (Either Errno Fd)
uninterruptibleOpen (ManagedCString (ByteArray ByteArray#
name)) (AccessMode CInt
x) (CreationFlags CInt
y) (StatusFlags CInt
z) =
ByteArray# -> CInt -> IO Fd
c_unsafe_open ByteArray#
name (CInt
x forall a. Bits a => a -> a -> a
.|. CInt
y forall a. Bits a => a -> a -> a
.|. CInt
z) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd
uninterruptibleOpenUntypedFlags ::
ManagedCString
-> CInt
-> IO (Either Errno Fd)
uninterruptibleOpenUntypedFlags :: ManagedCString -> CInt -> IO (Either Errno Fd)
uninterruptibleOpenUntypedFlags (ManagedCString (ByteArray ByteArray#
name)) CInt
x =
ByteArray# -> CInt -> IO Fd
c_unsafe_open ByteArray#
name CInt
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd
uninterruptibleOpenModeUntypedFlags ::
ManagedCString
-> CInt
-> CMode
-> IO (Either Errno Fd)
uninterruptibleOpenModeUntypedFlags :: ManagedCString -> CInt -> CMode -> IO (Either Errno Fd)
uninterruptibleOpenModeUntypedFlags (ManagedCString (ByteArray ByteArray#
name)) !CInt
x !CMode
mode =
ByteArray# -> CInt -> CMode -> IO Fd
c_unsafe_open_mode ByteArray#
name CInt
x CMode
mode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd
uninterruptibleOpenMode ::
ManagedCString
-> AccessMode
-> CreationFlags
-> StatusFlags
-> CMode
-> IO (Either Errno Fd)
uninterruptibleOpenMode :: ManagedCString
-> AccessMode
-> CreationFlags
-> StatusFlags
-> CMode
-> IO (Either Errno Fd)
uninterruptibleOpenMode (ManagedCString (ByteArray ByteArray#
name)) (AccessMode CInt
x) (CreationFlags CInt
y) (StatusFlags CInt
z) !CMode
mode =
ByteArray# -> CInt -> CMode -> IO Fd
c_unsafe_open_mode ByteArray#
name (CInt
x forall a. Bits a => a -> a -> a
.|. CInt
y forall a. Bits a => a -> a -> a
.|. CInt
z) CMode
mode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd
errorsFromDescriptorFlags :: DescriptorFlags -> IO (Either Errno DescriptorFlags)
errorsFromDescriptorFlags :: DescriptorFlags -> IO (Either Errno DescriptorFlags)
errorsFromDescriptorFlags r :: DescriptorFlags
r@(DescriptorFlags CInt
x) = if CInt
x forall a. Ord a => a -> a -> Bool
> (-CInt
1)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right DescriptorFlags
r)
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
errorsFromStatusFlags :: StatusFlags -> IO (Either Errno StatusFlags)
errorsFromStatusFlags :: StatusFlags -> IO (Either Errno StatusFlags)
errorsFromStatusFlags r :: StatusFlags
r@(StatusFlags CInt
x) = if CInt
x forall a. Ord a => a -> a -> Bool
> (-CInt
1)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right StatusFlags
r)
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
uninterruptibleWriteBytesCompletely ::
Fd
-> Bytes
-> IO (Either Errno ())
uninterruptibleWriteBytesCompletely :: Fd -> Bytes -> IO (Either Errno ())
uninterruptibleWriteBytesCompletely !Fd
fd !Bytes
b = do
Errno
e <- Fd -> Bytes -> IO Errno
uninterruptibleWriteBytesCompletelyErrno Fd
fd Bytes
b
if Errno
e forall a. Eq a => a -> a -> Bool
== Errno
eOK
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ())
else forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left Errno
e)
uninterruptibleWriteBytesCompletelyErrno ::
Fd
-> Bytes
-> IO Errno
uninterruptibleWriteBytesCompletelyErrno :: Fd -> Bytes -> IO Errno
uninterruptibleWriteBytesCompletelyErrno !Fd
fd (Bytes (ByteArray ByteArray#
buf) Int
off Int
len) =
Fd -> ByteArray# -> Int -> CSize -> IO Errno
c_unsafe_bytearray_write_loop Fd
fd ByteArray#
buf Int
off (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
len)
writeBytesCompletelyErrno ::
Fd
-> Bytes
-> IO Errno
writeBytesCompletelyErrno :: Fd -> Bytes -> IO Errno
writeBytesCompletelyErrno !Fd
fd (Bytes ByteArray
buf0 Int
off Int
len) =
let !(ByteArray ByteArray#
buf1) = ByteArray -> ByteArray
assertByteArrayPinned ByteArray
buf0
in Fd -> ByteArray# -> Int -> CSize -> IO Errno
c_safe_bytearray_write_loop Fd
fd ByteArray#
buf1 Int
off (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
len)
uninterruptibleWriteBytes ::
Fd
-> Bytes
-> IO (Either Errno CSize)
uninterruptibleWriteBytes :: Fd -> Bytes -> IO (Either Errno CSize)
uninterruptibleWriteBytes !Fd
fd (Bytes (ByteArray ByteArray#
buf) Int
off Int
len) =
Fd -> ByteArray# -> Int -> CSize -> IO CSsize
c_unsafe_bytearray_write Fd
fd ByteArray#
buf Int
off (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
len)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleWriteByteArray ::
Fd
-> ByteArray
-> Int
-> CSize
-> IO (Either Errno CSize)
uninterruptibleWriteByteArray :: Fd -> ByteArray -> Int -> CSize -> IO (Either Errno CSize)
uninterruptibleWriteByteArray !Fd
fd (ByteArray ByteArray#
buf) !Int
off !CSize
len =
Fd -> ByteArray# -> Int -> CSize -> IO CSsize
c_unsafe_bytearray_write Fd
fd ByteArray#
buf Int
off CSize
len forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
writeByteArray ::
Fd
-> ByteArray
-> Int
-> CSize
-> IO (Either Errno CSize)
writeByteArray :: Fd -> ByteArray -> Int -> CSize -> IO (Either Errno CSize)
writeByteArray !Fd
fd !ByteArray
buf0 !Int
off !CSize
len =
let !(ByteArray ByteArray#
buf1) = ByteArray -> ByteArray
assertByteArrayPinned ByteArray
buf0
in Fd -> ByteArray# -> Int -> CSize -> IO CSsize
c_safe_bytearray_write Fd
fd ByteArray#
buf1 Int
off CSize
len forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
writeMutableByteArray ::
Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> IO (Either Errno CSize)
writeMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> IO (Either Errno CSize)
writeMutableByteArray !Fd
fd !MutableByteArray RealWorld
buf0 !Int
off !CSize
len =
let !(MutableByteArray MutableByteArray# RealWorld
buf1) = forall s. MutableByteArray s -> MutableByteArray s
assertMutableByteArrayPinned MutableByteArray RealWorld
buf0
in Fd -> MutableByteArray# RealWorld -> Int -> CSize -> IO CSsize
c_safe_mutablebytearray_write Fd
fd MutableByteArray# RealWorld
buf1 Int
off CSize
len forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
errorsFromSize :: CSsize -> IO (Either Errno CSize)
errorsFromSize :: CSsize -> IO (Either Errno CSize)
errorsFromSize CSsize
r = if CSsize
r forall a. Ord a => a -> a -> Bool
> (-CSsize
1)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (CSsize -> CSize
cssizeToCSize CSsize
r))
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
errorsFromFd :: Fd -> IO (Either Errno Fd)
errorsFromFd :: Fd -> IO (Either Errno Fd)
errorsFromFd Fd
r = if Fd
r forall a. Ord a => a -> a -> Bool
> (-Fd
1)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right Fd
r)
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
uninterruptibleLink ::
ManagedCString
-> ManagedCString
-> IO (Either Errno ())
uninterruptibleLink :: ManagedCString -> ManagedCString -> IO (Either Errno ())
uninterruptibleLink (ManagedCString (ByteArray ByteArray#
x)) (ManagedCString (ByteArray ByteArray#
y)) =
ByteArray# -> ByteArray# -> IO CInt
c_unsafe_link ByteArray#
x ByteArray#
y forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
uninterruptibleUnlink ::
ManagedCString
-> IO (Either Errno ())
uninterruptibleUnlink :: ManagedCString -> IO (Either Errno ())
uninterruptibleUnlink (ManagedCString (ByteArray ByteArray#
x)) =
ByteArray# -> IO CInt
c_unsafe_unlink ByteArray#
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
close ::
Fd
-> IO (Either Errno ())
close :: Fd -> IO (Either Errno ())
close Fd
fd = Fd -> IO CInt
c_safe_close Fd
fd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
uninterruptibleClose ::
Fd
-> IO (Either Errno ())
uninterruptibleClose :: Fd -> IO (Either Errno ())
uninterruptibleClose Fd
fd = Fd -> IO CInt
c_unsafe_close Fd
fd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
uninterruptibleErrorlessClose ::
Fd
-> IO ()
uninterruptibleErrorlessClose :: Fd -> IO ()
uninterruptibleErrorlessClose Fd
fd = do
CInt
_ <- Fd -> IO CInt
c_unsafe_close Fd
fd
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
cssizeToCSize :: CSsize -> CSize
cssizeToCSize :: CSsize -> CSize
cssizeToCSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral
isReadOnly :: StatusFlags -> Bool
isReadOnly :: StatusFlags -> Bool
isReadOnly (StatusFlags CInt
x) = CInt
x forall a. Bits a => a -> a -> a
.&. CInt
0b11 forall a. Eq a => a -> a -> Bool
== CInt
0
isWriteOnly :: StatusFlags -> Bool
isWriteOnly :: StatusFlags -> Bool
isWriteOnly (StatusFlags CInt
x) = CInt
x forall a. Bits a => a -> a -> a
.&. CInt
0b11 forall a. Eq a => a -> a -> Bool
== CInt
1
isReadWrite :: StatusFlags -> Bool
isReadWrite :: StatusFlags -> Bool
isReadWrite (StatusFlags CInt
x) = CInt
x forall a. Bits a => a -> a -> a
.&. CInt
0b11 forall a. Eq a => a -> a -> Bool
== CInt
2
errorsFromInt_ :: CInt -> IO (Either Errno ())
errorsFromInt_ :: CInt -> IO (Either Errno ())
errorsFromInt_ CInt
r = if CInt
r forall a. Eq a => a -> a -> Bool
== CInt
0
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ())
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno