{-# LINE 1 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE PatternSynonyms #-}
module System.Posix.Files.PosixString (
unionFileModes, intersectFileModes,
nullFileMode,
ownerReadMode, ownerWriteMode, ownerExecuteMode, ownerModes,
groupReadMode, groupWriteMode, groupExecuteMode, groupModes,
otherReadMode, otherWriteMode, otherExecuteMode, otherModes,
setUserIDMode, setGroupIDMode,
stdFileMode, accessModes,
fileTypeModes,
blockSpecialMode, characterSpecialMode, namedPipeMode, regularFileMode,
directoryMode, symbolicLinkMode, socketMode,
setFileMode, setFdMode, setFileCreationMask,
fileAccess, fileExist,
FileStatus,
getFileStatus, getFdStatus, getSymbolicLinkStatus,
deviceID, fileID, fileMode, linkCount, fileOwner, fileGroup,
specialDeviceID, fileSize, accessTime, modificationTime,
statusChangeTime,
accessTimeHiRes, modificationTimeHiRes, statusChangeTimeHiRes,
isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile,
isDirectory, isSymbolicLink, isSocket,
ExtendedFileStatus(..),
CAttributes(..),
haveStatx,
getExtendedFileStatus,
StatxFlags(..),
defaultStatxFlags,
pattern EmptyPath,
pattern NoAutoMount,
pattern SymlinkNoFollow,
pattern SyncAsStat,
pattern ForceSync,
pattern DontSync,
StatxMask(..),
defaultStatxMask,
pattern StatxType,
pattern StatxMode,
pattern StatxNlink,
pattern StatxUid,
pattern StatxGid,
pattern StatxAtime,
pattern StatxMtime,
pattern StatxCtime,
pattern StatxIno,
pattern StatxSize,
pattern StatxBlocks,
pattern StatxBasicStats,
pattern StatxBtime,
pattern StatxMntId,
pattern StatxAll,
fileBlockSizeX,
linkCountX,
fileOwnerX,
fileGroupX,
fileModeX,
fileIDX,
fileSizeX,
fileBlocksX,
accessTimeHiResX,
creationTimeHiResX,
statusChangeTimeHiResX,
modificationTimeHiResX,
deviceIDX,
specialDeviceIDX,
mountIDX,
fileCompressedX,
fileImmutableX,
fileAppendX,
fileNoDumpX,
fileEncryptedX,
fileVerityX,
fileDaxX,
isBlockDeviceX,
isCharacterDeviceX,
isNamedPipeX,
isRegularFileX,
isDirectoryX,
isSymbolicLinkX,
isSocketX,
createNamedPipe,
createDevice,
createLink, removeLink,
createSymbolicLink, readSymbolicLink,
rename,
setOwnerAndGroup, setFdOwnerAndGroup,
{-# LINE 142 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
setSymbolicLinkOwnerAndGroup,
{-# LINE 144 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
setFileTimes, setFileTimesHiRes,
setSymbolicLinkTimesHiRes,
touchFile, touchFd, touchSymbolicLink,
setFileSize, setFdSize,
PathVar(..), getPathVar, getFdPathVar,
) where
import System.Posix.Types
import System.Posix.Internals hiding (withFilePath, peekFilePathLen)
import qualified System.Posix.Files.Common as Common
import Foreign
import Foreign.C hiding (
throwErrnoPath,
throwErrnoPathIf,
throwErrnoPathIf_,
throwErrnoPathIfNull,
throwErrnoPathIfMinus1,
throwErrnoPathIfMinus1_ )
import System.OsPath.Types
import System.Posix.Files hiding (getFileStatus, getExtendedFileStatus, getSymbolicLinkStatus, createNamedPipe, createDevice, createLink, removeLink, createSymbolicLink, readSymbolicLink, rename, setOwnerAndGroup, setSymbolicLinkOwnerAndGroup, setFileTimes, setSymbolicLinkTimesHiRes, touchFile, touchSymbolicLink, setFileSize, getPathVar, setFileMode, fileAccess, fileExist, setFdTimesHiRes, setFileTimesHiRes)
import System.Posix.Files.Common (getExtendedFileStatus_)
import System.Posix.PosixPath.FilePath
import Data.Time.Clock.POSIX (POSIXTime)
{-# LINE 180 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
setFileMode :: PosixPath -> FileMode -> IO ()
setFileMode :: PosixPath -> CMode -> IO ()
setFileMode PosixPath
name CMode
m =
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s -> do
String -> PosixPath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"setFileMode" PosixPath
name (CString -> CMode -> IO CInt
c_chmod CString
s CMode
m)
fileAccess :: PosixPath -> Bool -> Bool -> Bool -> IO Bool
fileAccess :: PosixPath -> Bool -> Bool -> Bool -> IO Bool
fileAccess PosixPath
name Bool
readOK Bool
writeOK Bool
execOK = PosixPath -> CMode -> IO Bool
access PosixPath
name CMode
flags
where
flags :: CMode
flags = CMode
read_f CMode -> CMode -> CMode
forall a. Bits a => a -> a -> a
.|. CMode
write_f CMode -> CMode -> CMode
forall a. Bits a => a -> a -> a
.|. CMode
exec_f
read_f :: CMode
read_f = if Bool
readOK then (CMode
4) else CMode
0
{-# LINE 209 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
write_f = if writeOK then (2) else 0
{-# LINE 210 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
exec_f = if execOK then (1) else 0
{-# LINE 211 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
fileExist :: PosixPath -> IO Bool
fileExist :: PosixPath -> IO Bool
fileExist PosixPath
name =
PosixPath -> (CString -> IO Bool) -> IO Bool
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
s -> do
r <- CString -> CInt -> IO CInt
c_access CString
s (CInt
0)
{-# LINE 219 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
if (r == 0)
then return True
else do err <- getErrno
if (err == eNOENT)
then return False
else throwErrnoPath "fileExist" name
access :: PosixPath -> CMode -> IO Bool
access :: PosixPath -> CMode -> IO Bool
access PosixPath
name CMode
flags =
PosixPath -> (CString -> IO Bool) -> IO Bool
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
s -> do
r <- CString -> CInt -> IO CInt
c_access CString
s (CMode -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CMode
flags)
if (r == 0)
then return True
else do err <- getErrno
if (err == eACCES || err == eROFS || err == eTXTBSY ||
err == ePERM)
then return False
else throwErrnoPath "fileAccess" name
getFileStatus :: PosixPath -> IO FileStatus
getFileStatus :: PosixPath -> IO FileStatus
getFileStatus PosixPath
path = do
fp <- Int -> IO (ForeignPtr CStat)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Int
144)
{-# LINE 246 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
withForeignPtr fp $ \p ->
withFilePath path $ \s ->
throwErrnoPathIfMinus1Retry_ "getFileStatus" path (c_stat s p)
return (Common.FileStatus fp)
getExtendedFileStatus :: Maybe Fd
-> PosixPath
-> StatxFlags
-> StatxMask
-> IO ExtendedFileStatus
getExtendedFileStatus :: Maybe Fd
-> PosixPath -> StatxFlags -> StatxMask -> IO ExtendedFileStatus
getExtendedFileStatus Maybe Fd
mfd PosixPath
path StatxFlags
flags StatxMask
masks = PosixPath
-> (CString -> IO ExtendedFileStatus) -> IO ExtendedFileStatus
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
path ((CString -> IO ExtendedFileStatus) -> IO ExtendedFileStatus)
-> (CString -> IO ExtendedFileStatus) -> IO ExtendedFileStatus
forall a b. (a -> b) -> a -> b
$ \CString
s -> Maybe Fd
-> CString -> StatxFlags -> StatxMask -> IO ExtendedFileStatus
getExtendedFileStatus_ Maybe Fd
mfd CString
s StatxFlags
flags StatxMask
masks
getSymbolicLinkStatus :: PosixPath -> IO FileStatus
getSymbolicLinkStatus :: PosixPath -> IO FileStatus
getSymbolicLinkStatus PosixPath
path = do
fp <- Int -> IO (ForeignPtr CStat)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Int
144)
{-# LINE 278 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
withForeignPtr fp $ \p ->
withFilePath path $ \s ->
throwErrnoPathIfMinus1_ "getSymbolicLinkStatus" path (c_lstat s p)
return (Common.FileStatus fp)
foreign import capi unsafe "HsUnix.h lstat"
c_lstat :: CString -> Ptr CStat -> IO CInt
createNamedPipe :: PosixPath -> FileMode -> IO ()
createNamedPipe :: PosixPath -> CMode -> IO ()
createNamedPipe PosixPath
name CMode
mode = do
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
String -> PosixPath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"createNamedPipe" PosixPath
name (CString -> CMode -> IO CInt
c_mkfifo CString
s CMode
mode)
{-# LINE 305 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
createDevice :: PosixPath -> FileMode -> DeviceID -> IO ()
createDevice :: PosixPath -> CMode -> DeviceID -> IO ()
createDevice PosixPath
path CMode
mode DeviceID
dev =
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
String -> PosixPath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"createDevice" PosixPath
path (CString -> CMode -> DeviceID -> IO CInt
c_mknod CString
s CMode
mode DeviceID
dev)
foreign import capi unsafe "HsUnix.h mknod"
c_mknod :: CString -> CMode -> CDev -> IO CInt
{-# LINE 322 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
createLink :: PosixPath -> PosixPath -> IO ()
createLink :: PosixPath -> PosixPath -> IO ()
createLink PosixPath
name1 PosixPath
name2 =
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name1 ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s1 ->
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name2 ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s2 ->
String -> PosixPath -> PosixPath -> IO CInt -> IO ()
forall a.
(Eq a, Num a) =>
String -> PosixPath -> PosixPath -> IO a -> IO ()
throwErrnoTwoPathsIfMinus1_ String
"createLink" PosixPath
name1 PosixPath
name2 (CString -> CString -> IO CInt
c_link CString
s1 CString
s2)
removeLink :: PosixPath -> IO ()
removeLink :: PosixPath -> IO ()
removeLink PosixPath
name =
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
String -> PosixPath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"removeLink" PosixPath
name (CString -> IO CInt
c_unlink CString
s)
createSymbolicLink :: PosixPath -> PosixPath -> IO ()
createSymbolicLink :: PosixPath -> PosixPath -> IO ()
createSymbolicLink PosixPath
name1 PosixPath
name2 =
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name1 ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s1 ->
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name2 ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s2 ->
String -> PosixPath -> PosixPath -> IO CInt -> IO ()
forall a.
(Eq a, Num a) =>
String -> PosixPath -> PosixPath -> IO a -> IO ()
throwErrnoTwoPathsIfMinus1_ String
"createSymbolicLink" PosixPath
name1 PosixPath
name2 (CString -> CString -> IO CInt
c_symlink CString
s1 CString
s2)
foreign import ccall unsafe "symlink"
c_symlink :: CString -> CString -> IO CInt
{-# LINE 371 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
readSymbolicLink :: PosixPath -> IO PosixPath
readSymbolicLink :: PosixPath -> IO PosixPath
readSymbolicLink PosixPath
file =
Int -> (CString -> IO PosixPath) -> IO PosixPath
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray0 (Int
4096) ((CString -> IO PosixPath) -> IO PosixPath)
-> (CString -> IO PosixPath) -> IO PosixPath
forall a b. (a -> b) -> a -> b
$ \CString
buf -> do
{-# LINE 378 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
withFilePath file $ \s -> do
len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $
c_readlink s buf (4096)
{-# LINE 381 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
peekFilePathLen (buf,fromIntegral len)
foreign import ccall unsafe "readlink"
c_readlink :: CString -> CString -> CSize -> IO CInt
rename :: PosixPath -> PosixPath -> IO ()
rename :: PosixPath -> PosixPath -> IO ()
rename PosixPath
name1 PosixPath
name2 =
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name1 ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s1 ->
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name2 ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s2 ->
String -> PosixPath -> PosixPath -> IO CInt -> IO ()
forall a.
(Eq a, Num a) =>
String -> PosixPath -> PosixPath -> IO a -> IO ()
throwErrnoTwoPathsIfMinus1_ String
"rename" PosixPath
name1 PosixPath
name2 (CString -> CString -> IO CInt
c_rename CString
s1 CString
s2)
foreign import ccall unsafe "rename"
c_rename :: CString -> CString -> IO CInt
{-# LINE 405 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
setOwnerAndGroup :: PosixPath -> UserID -> GroupID -> IO ()
setOwnerAndGroup :: PosixPath -> UserID -> GroupID -> IO ()
setOwnerAndGroup PosixPath
name UserID
uid GroupID
gid = do
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
String -> PosixPath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"setOwnerAndGroup" PosixPath
name (CString -> UserID -> GroupID -> IO CInt
c_chown CString
s UserID
uid GroupID
gid)
foreign import ccall unsafe "chown"
c_chown :: CString -> CUid -> CGid -> IO CInt
{-# LINE 427 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
{-# LINE 429 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
setSymbolicLinkOwnerAndGroup :: PosixPath -> UserID -> GroupID -> IO ()
setSymbolicLinkOwnerAndGroup :: PosixPath -> UserID -> GroupID -> IO ()
setSymbolicLinkOwnerAndGroup PosixPath
name UserID
uid GroupID
gid = do
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
String -> PosixPath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"setSymbolicLinkOwnerAndGroup" PosixPath
name
(CString -> UserID -> GroupID -> IO CInt
c_lchown CString
s UserID
uid GroupID
gid)
foreign import ccall unsafe "lchown"
c_lchown :: CString -> CUid -> CGid -> IO CInt
{-# LINE 442 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
setFileTimes :: PosixPath -> EpochTime -> EpochTime -> IO ()
setFileTimes :: PosixPath -> EpochTime -> EpochTime -> IO ()
setFileTimes PosixPath
name EpochTime
atime EpochTime
mtime = do
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
Int -> (Ptr CUtimbuf -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
16) ((Ptr CUtimbuf -> IO ()) -> IO ())
-> (Ptr CUtimbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUtimbuf
p -> do
{-# LINE 454 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p atime
{-# LINE 455 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p mtime
{-# LINE 456 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
throwErrnoPathIfMinus1_ "setFileTimes" name (c_utime s p)
setFileTimesHiRes :: PosixPath -> POSIXTime -> POSIXTime -> IO ()
{-# LINE 472 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
setFileTimesHiRes :: PosixPath -> POSIXTime -> POSIXTime -> IO ()
setFileTimesHiRes PosixPath
name POSIXTime
atime POSIXTime
mtime =
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
[CTimeSpec] -> (Ptr CTimeSpec -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [POSIXTime -> CTimeSpec
Common.toCTimeSpec POSIXTime
atime, POSIXTime -> CTimeSpec
Common.toCTimeSpec POSIXTime
mtime] ((Ptr CTimeSpec -> IO ()) -> IO ())
-> (Ptr CTimeSpec -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CTimeSpec
times ->
String -> PosixPath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"setFileTimesHiRes" PosixPath
name (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
CInt -> CString -> Ptr CTimeSpec -> CInt -> IO CInt
Common.c_utimensat (-CInt
100) CString
s Ptr CTimeSpec
times CInt
0
{-# LINE 477 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
{-# LINE 483 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
setSymbolicLinkTimesHiRes :: PosixPath -> POSIXTime -> POSIXTime -> IO ()
{-# LINE 495 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
setSymbolicLinkTimesHiRes name atime mtime =
withFilePath name $ \s ->
withArray [Common.toCTimeSpec atime, Common.toCTimeSpec mtime] $ \times ->
throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
Common.c_utimensat (-100) s times (256)
{-# LINE 500 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
{-# LINE 510 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
touchFile :: PosixPath -> IO ()
touchFile :: PosixPath -> IO ()
touchFile PosixPath
name = do
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
String -> PosixPath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"touchFile" PosixPath
name (CString -> Ptr CUtimbuf -> IO CInt
c_utime CString
s Ptr CUtimbuf
forall a. Ptr a
nullPtr)
touchSymbolicLink :: PosixPath -> IO ()
{-# LINE 527 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
touchSymbolicLink name =
withFilePath name $ \s ->
throwErrnoPathIfMinus1_ "touchSymbolicLink" name (Common.c_lutimes s nullPtr)
{-# LINE 534 "libraries/unix/System/Posix/Files/PosixString.hsc" #-}
setFileSize :: PosixPath -> FileOffset -> IO ()
setFileSize :: PosixPath -> FileOffset -> IO ()
setFileSize PosixPath
file FileOffset
off =
PosixPath -> (CString -> IO ()) -> IO ()
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
file ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
String -> PosixPath -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"setFileSize" PosixPath
file (CString -> FileOffset -> IO CInt
c_truncate CString
s FileOffset
off)
foreign import capi unsafe "HsUnix.h truncate"
c_truncate :: CString -> COff -> IO CInt
getPathVar :: PosixPath -> PathVar -> IO Limit
getPathVar :: PosixPath -> PathVar -> IO CLong
getPathVar PosixPath
name PathVar
v = do
PosixPath -> (CString -> IO CLong) -> IO CLong
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO CLong) -> IO CLong)
-> (CString -> IO CLong) -> IO CLong
forall a b. (a -> b) -> a -> b
$ \ CString
nameP ->
String -> PosixPath -> IO CLong -> IO CLong
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO a
throwErrnoPathIfMinus1 String
"getPathVar" PosixPath
name (IO CLong -> IO CLong) -> IO CLong -> IO CLong
forall a b. (a -> b) -> a -> b
$
CString -> CInt -> IO CLong
c_pathconf CString
nameP (PathVar -> CInt
Common.pathVarConst PathVar
v)
foreign import ccall unsafe "pathconf"
c_pathconf :: CString -> CInt -> IO CLong