{-# LINE 1 "libraries/unix/System/Posix/IO.hsc" #-}
{-# LANGUAGE Safe #-}
module System.Posix.IO (
stdInput, stdOutput, stdError,
OpenMode(..),
OpenFileFlags(..), defaultFileFlags,
openFd, openFdAt, createFile, createFileAt,
closeFd,
fdRead, fdWrite,
fdReadBuf, fdWriteBuf,
fdSeek,
FdOption(..),
queryFdOption,
setFdOption,
FileLock,
LockRequest(..),
getLock, setLock,
waitToSetLock,
createPipe,
dup, dupTo,
handleToFd,
fdToHandle,
) where
import Foreign ( allocaBytes, castPtr )
import Foreign.C ( peekCStringLen, withCStringLen )
import GHC.IO.Exception ( IOErrorType(EOF) )
import System.IO.Error ( ioeSetErrorString, mkIOError )
import System.Posix.Types
import System.Posix.Error
import System.Posix.IO.Common
import System.Posix.Internals ( withFilePath )
openFd :: FilePath
-> OpenMode
-> OpenFileFlags
-> IO Fd
openFd :: FilePath -> OpenMode -> OpenFileFlags -> IO Fd
openFd = Maybe Fd -> FilePath -> OpenMode -> OpenFileFlags -> IO Fd
openFdAt Maybe Fd
forall a. Maybe a
Nothing
openFdAt :: Maybe Fd
-> FilePath
-> OpenMode
-> OpenFileFlags
-> IO Fd
openFdAt :: Maybe Fd -> FilePath -> OpenMode -> OpenFileFlags -> IO Fd
openFdAt Maybe Fd
fdMay FilePath
name OpenMode
how OpenFileFlags
flags =
FilePath -> (CString -> IO Fd) -> IO Fd
forall a. FilePath -> (CString -> IO a) -> IO a
withFilePath FilePath
name ((CString -> IO Fd) -> IO Fd) -> (CString -> IO Fd) -> IO Fd
forall a b. (a -> b) -> a -> b
$ \CString
str ->
FilePath -> FilePath -> IO Fd -> IO Fd
forall a. (Eq a, Num a) => FilePath -> FilePath -> IO a -> IO a
throwErrnoPathIfMinus1Retry FilePath
"openFdAt" FilePath
name (IO Fd -> IO Fd) -> IO Fd -> IO Fd
forall a b. (a -> b) -> a -> b
$
Maybe Fd -> CString -> OpenMode -> OpenFileFlags -> IO Fd
openat_ Maybe Fd
fdMay CString
str OpenMode
how OpenFileFlags
flags
createFile :: FilePath -> FileMode -> IO Fd
createFile :: FilePath -> FileMode -> IO Fd
createFile = Maybe Fd -> FilePath -> FileMode -> IO Fd
createFileAt Maybe Fd
forall a. Maybe a
Nothing
createFileAt :: Maybe Fd
-> FilePath
-> FileMode
-> IO Fd
createFileAt :: Maybe Fd -> FilePath -> FileMode -> IO Fd
createFileAt Maybe Fd
fdMay FilePath
name FileMode
mode
= Maybe Fd -> FilePath -> OpenMode -> OpenFileFlags -> IO Fd
openFdAt Maybe Fd
fdMay FilePath
name OpenMode
WriteOnly OpenFileFlags
defaultFileFlags{ trunc=True, creat=(Just mode) }
{-# DEPRECATED fdRead "This function is scheduled to be dropped in favor of 'System.Posix.IO.ByteString.fdRead', because decoding e.g. UTF-8 streams partially is unsafe." #-}
fdRead :: Fd
-> ByteCount
-> IO (String, ByteCount)
fdRead :: Fd -> ByteCount -> IO (FilePath, ByteCount)
fdRead Fd
_fd ByteCount
0 = (FilePath, ByteCount) -> IO (FilePath, ByteCount)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
"", ByteCount
0)
fdRead Fd
fd ByteCount
nbytes =
Int
-> (Ptr Word8 -> IO (FilePath, ByteCount))
-> IO (FilePath, 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 (FilePath, ByteCount))
-> IO (FilePath, ByteCount))
-> (Ptr Word8 -> IO (FilePath, ByteCount))
-> IO (FilePath, 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 (FilePath, ByteCount)
forall a. IOError -> IO a
ioError (IOError -> FilePath -> IOError
ioeSetErrorString (IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOError
mkIOError IOErrorType
EOF FilePath
"fdRead" Maybe Handle
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing) FilePath
"EOF")
ByteCount
n -> do
FilePath
s <- CStringLen -> IO FilePath
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)
(FilePath, ByteCount) -> IO (FilePath, ByteCount)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
s, ByteCount
n)
fdWrite :: Fd -> String -> IO ByteCount
fdWrite :: Fd -> FilePath -> IO ByteCount
fdWrite Fd
fd FilePath
str =
FilePath -> (CStringLen -> IO ByteCount) -> IO ByteCount
forall a. FilePath -> (CStringLen -> IO a) -> IO a
withCStringLen FilePath
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)