{-# LINE 1 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LANGUAGE Trustworthy #-}
module System.Posix.Files.Common (
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,
setFdMode, setFileCreationMask,
FileStatus(..),
getFdStatus,
deviceID, fileID, fileMode, linkCount, fileOwner, fileGroup,
specialDeviceID, fileSize, accessTime, modificationTime,
statusChangeTime,
accessTimeHiRes, modificationTimeHiRes, statusChangeTimeHiRes,
setFdTimesHiRes, touchFd,
isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile,
isDirectory, isSymbolicLink, isSocket,
setFdSize,
setFdOwnerAndGroup,
PathVar(..), getFdPathVar, pathVarConst,
{-# LINE 70 "libraries/unix/System/Posix/Files/Common.hsc" #-}
CTimeSpec(..),
toCTimeSpec,
c_utimensat,
{-# LINE 74 "libraries/unix/System/Posix/Files/Common.hsc" #-}
CTimeVal(..),
toCTimeVal,
c_utimes,
{-# LINE 78 "libraries/unix/System/Posix/Files/Common.hsc" #-}
c_lutimes,
{-# LINE 80 "libraries/unix/System/Posix/Files/Common.hsc" #-}
) where
import System.Posix.Types
import System.IO.Unsafe
import Data.Bits
import Data.Int
import Data.Ratio
import Data.Time.Clock.POSIX (POSIXTime)
import System.Posix.Internals
import Foreign.C
import Foreign.ForeignPtr
{-# LINE 92 "libraries/unix/System/Posix/Files/Common.hsc" #-}
import Foreign.Marshal (withArray)
{-# LINE 94 "libraries/unix/System/Posix/Files/Common.hsc" #-}
import Foreign.Ptr
import Foreign.Storable
nullFileMode :: FileMode
nullFileMode :: FileMode
nullFileMode = FileMode
0
ownerReadMode :: FileMode
ownerReadMode :: FileMode
ownerReadMode = (FileMode
256)
{-# LINE 110 "libraries/unix/System/Posix/Files/Common.hsc" #-}
ownerWriteMode :: FileMode
ownerWriteMode :: FileMode
ownerWriteMode = (FileMode
128)
{-# LINE 114 "libraries/unix/System/Posix/Files/Common.hsc" #-}
ownerExecuteMode :: FileMode
ownerExecuteMode :: FileMode
ownerExecuteMode = (FileMode
64)
{-# LINE 118 "libraries/unix/System/Posix/Files/Common.hsc" #-}
groupReadMode :: FileMode
groupReadMode :: FileMode
groupReadMode = (FileMode
32)
{-# LINE 122 "libraries/unix/System/Posix/Files/Common.hsc" #-}
groupWriteMode :: FileMode
groupWriteMode :: FileMode
groupWriteMode = (FileMode
16)
{-# LINE 126 "libraries/unix/System/Posix/Files/Common.hsc" #-}
groupExecuteMode :: FileMode
groupExecuteMode :: FileMode
groupExecuteMode = (FileMode
8)
{-# LINE 130 "libraries/unix/System/Posix/Files/Common.hsc" #-}
otherReadMode :: FileMode
otherReadMode :: FileMode
otherReadMode = (FileMode
4)
{-# LINE 134 "libraries/unix/System/Posix/Files/Common.hsc" #-}
otherWriteMode :: FileMode
otherWriteMode :: FileMode
otherWriteMode = (FileMode
2)
{-# LINE 138 "libraries/unix/System/Posix/Files/Common.hsc" #-}
otherExecuteMode :: FileMode
otherExecuteMode :: FileMode
otherExecuteMode = (FileMode
1)
{-# LINE 142 "libraries/unix/System/Posix/Files/Common.hsc" #-}
setUserIDMode :: FileMode
setUserIDMode :: FileMode
setUserIDMode = (FileMode
2048)
{-# LINE 146 "libraries/unix/System/Posix/Files/Common.hsc" #-}
setGroupIDMode :: FileMode
setGroupIDMode :: FileMode
setGroupIDMode = (FileMode
1024)
{-# LINE 150 "libraries/unix/System/Posix/Files/Common.hsc" #-}
stdFileMode :: FileMode
stdFileMode :: FileMode
stdFileMode = FileMode
ownerReadMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
ownerWriteMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|.
FileMode
groupReadMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
groupWriteMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|.
FileMode
otherReadMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
otherWriteMode
ownerModes :: FileMode
ownerModes :: FileMode
ownerModes = (FileMode
448)
{-# LINE 160 "libraries/unix/System/Posix/Files/Common.hsc" #-}
groupModes :: FileMode
groupModes :: FileMode
groupModes = (FileMode
56)
{-# LINE 164 "libraries/unix/System/Posix/Files/Common.hsc" #-}
otherModes :: FileMode
otherModes :: FileMode
otherModes = (FileMode
7)
{-# LINE 168 "libraries/unix/System/Posix/Files/Common.hsc" #-}
accessModes :: FileMode
accessModes :: FileMode
accessModes = FileMode
ownerModes FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
groupModes FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
otherModes
unionFileModes :: FileMode -> FileMode -> FileMode
unionFileModes :: FileMode -> FileMode -> FileMode
unionFileModes FileMode
m1 FileMode
m2 = FileMode
m1 FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
m2
intersectFileModes :: FileMode -> FileMode -> FileMode
intersectFileModes :: FileMode -> FileMode -> FileMode
intersectFileModes FileMode
m1 FileMode
m2 = FileMode
m1 FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.&. FileMode
m2
fileTypeModes :: FileMode
fileTypeModes :: FileMode
fileTypeModes = (FileMode
61440)
{-# LINE 185 "libraries/unix/System/Posix/Files/Common.hsc" #-}
blockSpecialMode :: FileMode
blockSpecialMode :: FileMode
blockSpecialMode = (FileMode
24576)
{-# LINE 188 "libraries/unix/System/Posix/Files/Common.hsc" #-}
characterSpecialMode :: FileMode
characterSpecialMode :: FileMode
characterSpecialMode = (FileMode
8192)
{-# LINE 191 "libraries/unix/System/Posix/Files/Common.hsc" #-}
namedPipeMode :: FileMode
namedPipeMode :: FileMode
namedPipeMode = (FileMode
4096)
{-# LINE 194 "libraries/unix/System/Posix/Files/Common.hsc" #-}
regularFileMode :: FileMode
regularFileMode :: FileMode
regularFileMode = (FileMode
32768)
{-# LINE 197 "libraries/unix/System/Posix/Files/Common.hsc" #-}
directoryMode :: FileMode
directoryMode :: FileMode
directoryMode = (FileMode
16384)
{-# LINE 200 "libraries/unix/System/Posix/Files/Common.hsc" #-}
symbolicLinkMode :: FileMode
symbolicLinkMode :: FileMode
symbolicLinkMode = (FileMode
40960)
{-# LINE 203 "libraries/unix/System/Posix/Files/Common.hsc" #-}
socketMode :: FileMode
socketMode :: FileMode
socketMode = (FileMode
49152)
{-# LINE 206 "libraries/unix/System/Posix/Files/Common.hsc" #-}
setFdMode :: Fd -> FileMode -> IO ()
setFdMode :: Fd -> FileMode -> IO ()
setFdMode (Fd CInt
fd) FileMode
m =
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setFdMode" (CInt -> FileMode -> IO CInt
c_fchmod CInt
fd FileMode
m)
foreign import ccall unsafe "fchmod"
c_fchmod :: CInt -> CMode -> IO CInt
setFileCreationMask :: FileMode -> IO FileMode
setFileCreationMask :: FileMode -> IO FileMode
setFileCreationMask FileMode
mask = FileMode -> IO FileMode
c_umask FileMode
mask
newtype FileStatus = FileStatus (ForeignPtr CStat)
deviceID :: FileStatus -> DeviceID
fileID :: FileStatus -> FileID
fileMode :: FileStatus -> FileMode
linkCount :: FileStatus -> LinkCount
fileOwner :: FileStatus -> UserID
fileGroup :: FileStatus -> GroupID
specialDeviceID :: FileStatus -> DeviceID
fileSize :: FileStatus -> FileOffset
accessTime :: FileStatus -> EpochTime
accessTimeHiRes :: FileStatus -> POSIXTime
modificationTime :: FileStatus -> EpochTime
modificationTimeHiRes :: FileStatus -> POSIXTime
statusChangeTime :: FileStatus -> EpochTime
statusChangeTimeHiRes :: FileStatus -> POSIXTime
deviceID :: FileStatus -> DeviceID
deviceID (FileStatus ForeignPtr CStat
stat) =
IO DeviceID -> DeviceID
forall a. IO a -> a
unsafePerformIO (IO DeviceID -> DeviceID) -> IO DeviceID -> DeviceID
forall a b. (a -> b) -> a -> b
$ ForeignPtr CStat -> (Ptr CStat -> IO DeviceID) -> IO DeviceID
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CStat
stat ((Ptr CStat -> IO DeviceID) -> IO DeviceID)
-> (Ptr CStat -> IO DeviceID) -> IO DeviceID
forall a b. (a -> b) -> a -> b
$ ((\Ptr CStat
hsc_ptr -> Ptr CStat -> Int -> IO DeviceID
forall b. Ptr b -> Int -> IO DeviceID
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CStat
hsc_ptr Int
0))
{-# LINE 268 "libraries/unix/System/Posix/Files/Common.hsc" #-}
fileID (FileStatus stat) =
unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 8))
fileMode :: FileStatus -> FileMode
{-# LINE 270 "libraries/unix/System/Posix/Files/Common.hsc" #-}
fileMode (FileStatus stat) =
unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 24))
{-# LINE 272 "libraries/unix/System/Posix/Files/Common.hsc" #-}
linkCount (FileStatus stat) =
unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 16))
{-# LINE 274 "libraries/unix/System/Posix/Files/Common.hsc" #-}
fileOwner (FileStatus stat) =
unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 28))
{-# LINE 276 "libraries/unix/System/Posix/Files/Common.hsc" #-}
fileGroup (FileStatus stat) =
unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 32))
{-# LINE 278 "libraries/unix/System/Posix/Files/Common.hsc" #-}
specialDeviceID (FileStatus stat) =
unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 40))
fileSize :: FileStatus -> FileOffset
{-# LINE 280 "libraries/unix/System/Posix/Files/Common.hsc" #-}
fileSize (FileStatus stat) =
unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 48))
{-# LINE 282 "libraries/unix/System/Posix/Files/Common.hsc" #-}
accessTime (FileStatus stat) =
unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 72))
{-# LINE 284 "libraries/unix/System/Posix/Files/Common.hsc" #-}
modificationTime (FileStatus stat) =
unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 88))
{-# LINE 286 "libraries/unix/System/Posix/Files/Common.hsc" #-}
statusChangeTime (FileStatus stat) =
unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 104))
{-# LINE 288 "libraries/unix/System/Posix/Files/Common.hsc" #-}
accessTimeHiRes :: FileStatus -> POSIXTime
accessTimeHiRes (FileStatus ForeignPtr CStat
stat) =
IO POSIXTime -> POSIXTime
forall a. IO a -> a
unsafePerformIO (IO POSIXTime -> POSIXTime) -> IO POSIXTime -> POSIXTime
forall a b. (a -> b) -> a -> b
$ ForeignPtr CStat -> (Ptr CStat -> IO POSIXTime) -> IO POSIXTime
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CStat
stat ((Ptr CStat -> IO POSIXTime) -> IO POSIXTime)
-> (Ptr CStat -> IO POSIXTime) -> IO POSIXTime
forall a b. (a -> b) -> a -> b
$ \Ptr CStat
stat_ptr -> do
EpochTime
sec <- ((\Ptr CStat
hsc_ptr -> Ptr CStat -> Int -> IO EpochTime
forall b. Ptr b -> Int -> IO EpochTime
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CStat
hsc_ptr Int
72)) Ptr CStat
stat_ptr :: IO EpochTime
{-# LINE 292 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 293 "libraries/unix/System/Posix/Files/Common.hsc" #-}
nsec <- ((\hsc_ptr -> peekByteOff hsc_ptr 80)) stat_ptr :: IO (Int64)
{-# LINE 294 "libraries/unix/System/Posix/Files/Common.hsc" #-}
let frac = toInteger nsec % 10^(9::Int)
{-# LINE 310 "libraries/unix/System/Posix/Files/Common.hsc" #-}
POSIXTime -> IO POSIXTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (POSIXTime -> IO POSIXTime) -> POSIXTime -> IO POSIXTime
forall a b. (a -> b) -> a -> b
$ Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> POSIXTime) -> Rational -> POSIXTime
forall a b. (a -> b) -> a -> b
$ EpochTime -> Rational
forall a. Real a => a -> Rational
toRational EpochTime
sec Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
frac
modificationTimeHiRes :: FileStatus -> POSIXTime
modificationTimeHiRes (FileStatus ForeignPtr CStat
stat) =
IO POSIXTime -> POSIXTime
forall a. IO a -> a
unsafePerformIO (IO POSIXTime -> POSIXTime) -> IO POSIXTime -> POSIXTime
forall a b. (a -> b) -> a -> b
$ ForeignPtr CStat -> (Ptr CStat -> IO POSIXTime) -> IO POSIXTime
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CStat
stat ((Ptr CStat -> IO POSIXTime) -> IO POSIXTime)
-> (Ptr CStat -> IO POSIXTime) -> IO POSIXTime
forall a b. (a -> b) -> a -> b
$ \Ptr CStat
stat_ptr -> do
EpochTime
sec <- ((\Ptr CStat
hsc_ptr -> Ptr CStat -> Int -> IO EpochTime
forall b. Ptr b -> Int -> IO EpochTime
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CStat
hsc_ptr Int
88)) Ptr CStat
stat_ptr :: IO EpochTime
{-# LINE 315 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 316 "libraries/unix/System/Posix/Files/Common.hsc" #-}
nsec <- ((\hsc_ptr -> peekByteOff hsc_ptr 96)) stat_ptr :: IO (Int64)
{-# LINE 317 "libraries/unix/System/Posix/Files/Common.hsc" #-}
let frac = toInteger nsec % 10^(9::Int)
{-# LINE 333 "libraries/unix/System/Posix/Files/Common.hsc" #-}
POSIXTime -> IO POSIXTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (POSIXTime -> IO POSIXTime) -> POSIXTime -> IO POSIXTime
forall a b. (a -> b) -> a -> b
$ Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> POSIXTime) -> Rational -> POSIXTime
forall a b. (a -> b) -> a -> b
$ EpochTime -> Rational
forall a. Real a => a -> Rational
toRational EpochTime
sec Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
frac
statusChangeTimeHiRes :: FileStatus -> POSIXTime
statusChangeTimeHiRes (FileStatus ForeignPtr CStat
stat) =
IO POSIXTime -> POSIXTime
forall a. IO a -> a
unsafePerformIO (IO POSIXTime -> POSIXTime) -> IO POSIXTime -> POSIXTime
forall a b. (a -> b) -> a -> b
$ ForeignPtr CStat -> (Ptr CStat -> IO POSIXTime) -> IO POSIXTime
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CStat
stat ((Ptr CStat -> IO POSIXTime) -> IO POSIXTime)
-> (Ptr CStat -> IO POSIXTime) -> IO POSIXTime
forall a b. (a -> b) -> a -> b
$ \Ptr CStat
stat_ptr -> do
EpochTime
sec <- ((\Ptr CStat
hsc_ptr -> Ptr CStat -> Int -> IO EpochTime
forall b. Ptr b -> Int -> IO EpochTime
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CStat
hsc_ptr Int
104)) Ptr CStat
stat_ptr :: IO EpochTime
{-# LINE 338 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 339 "libraries/unix/System/Posix/Files/Common.hsc" #-}
nsec <- ((\hsc_ptr -> peekByteOff hsc_ptr 112)) stat_ptr :: IO (Int64)
{-# LINE 340 "libraries/unix/System/Posix/Files/Common.hsc" #-}
let frac = toInteger nsec % 10^(9::Int)
{-# LINE 356 "libraries/unix/System/Posix/Files/Common.hsc" #-}
POSIXTime -> IO POSIXTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (POSIXTime -> IO POSIXTime) -> POSIXTime -> IO POSIXTime
forall a b. (a -> b) -> a -> b
$ Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> POSIXTime) -> Rational -> POSIXTime
forall a b. (a -> b) -> a -> b
$ EpochTime -> Rational
forall a. Real a => a -> Rational
toRational EpochTime
sec Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
frac
isBlockDevice :: FileStatus -> Bool
isCharacterDevice :: FileStatus -> Bool
isNamedPipe :: FileStatus -> Bool
isRegularFile :: FileStatus -> Bool
isDirectory :: FileStatus -> Bool
isSymbolicLink :: FileStatus -> Bool
isSocket :: FileStatus -> Bool
isBlockDevice :: FileStatus -> Bool
isBlockDevice FileStatus
stat =
(FileStatus -> FileMode
fileMode FileStatus
stat FileMode -> FileMode -> FileMode
`intersectFileModes` FileMode
fileTypeModes) FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== FileMode
blockSpecialMode
isCharacterDevice :: FileStatus -> Bool
isCharacterDevice FileStatus
stat =
(FileStatus -> FileMode
fileMode FileStatus
stat FileMode -> FileMode -> FileMode
`intersectFileModes` FileMode
fileTypeModes) FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== FileMode
characterSpecialMode
isNamedPipe :: FileStatus -> Bool
isNamedPipe FileStatus
stat =
(FileStatus -> FileMode
fileMode FileStatus
stat FileMode -> FileMode -> FileMode
`intersectFileModes` FileMode
fileTypeModes) FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== FileMode
namedPipeMode
isRegularFile :: FileStatus -> Bool
isRegularFile FileStatus
stat =
(FileStatus -> FileMode
fileMode FileStatus
stat FileMode -> FileMode -> FileMode
`intersectFileModes` FileMode
fileTypeModes) FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== FileMode
regularFileMode
isDirectory :: FileStatus -> Bool
isDirectory FileStatus
stat =
(FileStatus -> FileMode
fileMode FileStatus
stat FileMode -> FileMode -> FileMode
`intersectFileModes` FileMode
fileTypeModes) FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== FileMode
directoryMode
isSymbolicLink :: FileStatus -> Bool
isSymbolicLink FileStatus
stat =
(FileStatus -> FileMode
fileMode FileStatus
stat FileMode -> FileMode -> FileMode
`intersectFileModes` FileMode
fileTypeModes) FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== FileMode
symbolicLinkMode
isSocket :: FileStatus -> Bool
isSocket FileStatus
stat =
(FileStatus -> FileMode
fileMode FileStatus
stat FileMode -> FileMode -> FileMode
`intersectFileModes` FileMode
fileTypeModes) FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== FileMode
socketMode
getFdStatus :: Fd -> IO FileStatus
getFdStatus :: Fd -> IO FileStatus
getFdStatus (Fd CInt
fd) = do
ForeignPtr CStat
fp <- Int -> IO (ForeignPtr CStat)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Int
144)
{-# LINE 394 "libraries/unix/System/Posix/Files/Common.hsc" #-}
withForeignPtr fp $ \p ->
throwErrnoIfMinus1_ "getFdStatus" (c_fstat fd p)
FileStatus -> IO FileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr CStat -> FileStatus
FileStatus ForeignPtr CStat
fp)
{-# LINE 402 "libraries/unix/System/Posix/Files/Common.hsc" #-}
data CTimeSpec = CTimeSpec EpochTime CLong
instance Storable CTimeSpec where
sizeOf :: CTimeSpec -> Int
sizeOf CTimeSpec
_ = (Int
16)
{-# LINE 406 "libraries/unix/System/Posix/Files/Common.hsc" #-}
alignment _ = alignment (undefined :: CInt)
poke :: Ptr CTimeSpec -> CTimeSpec -> IO ()
poke Ptr CTimeSpec
p (CTimeSpec EpochTime
sec CLong
nsec) = do
((\Ptr CTimeSpec
hsc_ptr -> Ptr CTimeSpec -> Int -> EpochTime -> IO ()
forall b. Ptr b -> Int -> EpochTime -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CTimeSpec
hsc_ptr Int
0)) Ptr CTimeSpec
p EpochTime
sec
{-# LINE 409 "libraries/unix/System/Posix/Files/Common.hsc" #-}
((\Ptr CTimeSpec
hsc_ptr -> Ptr CTimeSpec -> Int -> CLong -> IO ()
forall b. Ptr b -> Int -> CLong -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CTimeSpec
hsc_ptr Int
8)) Ptr CTimeSpec
p CLong
nsec
{-# LINE 410 "libraries/unix/System/Posix/Files/Common.hsc" #-}
peek p = do
sec <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 412 "libraries/unix/System/Posix/Files/Common.hsc" #-}
nsec <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 413 "libraries/unix/System/Posix/Files/Common.hsc" #-}
return $ CTimeSpec sec nsec
toCTimeSpec :: POSIXTime -> CTimeSpec
toCTimeSpec :: POSIXTime -> CTimeSpec
toCTimeSpec POSIXTime
t = EpochTime -> CLong -> CTimeSpec
CTimeSpec (Int64 -> EpochTime
CTime Int64
sec) (Rational -> CLong
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational -> CLong) -> Rational -> CLong
forall a b. (a -> b) -> a -> b
$ Rational
10Rational -> Int -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9::Int) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
frac)
where
(Int64
sec, Rational
frac) = if (Rational
frac' Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0) then (Int64
sec' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1, Rational
frac' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
1) else (Int64
sec', Rational
frac')
(Int64
sec', Rational
frac') = Rational -> (Int64, Rational)
forall b. Integral b => Rational -> (b, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Rational -> (Int64, Rational)) -> Rational -> (Int64, Rational)
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational POSIXTime
t
{-# LINE 421 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 423 "libraries/unix/System/Posix/Files/Common.hsc" #-}
foreign import ccall unsafe "utimensat"
c_utimensat :: CInt -> CString -> Ptr CTimeSpec -> CInt -> IO CInt
{-# LINE 426 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 428 "libraries/unix/System/Posix/Files/Common.hsc" #-}
foreign import ccall unsafe "futimens"
c_futimens :: CInt -> Ptr CTimeSpec -> IO CInt
{-# LINE 431 "libraries/unix/System/Posix/Files/Common.hsc" #-}
data CTimeVal = CTimeVal CLong CLong
instance Storable CTimeVal where
sizeOf :: CTimeVal -> Int
sizeOf CTimeVal
_ = (Int
16)
{-# LINE 436 "libraries/unix/System/Posix/Files/Common.hsc" #-}
alignment _ = alignment (undefined :: CInt)
poke :: Ptr CTimeVal -> CTimeVal -> IO ()
poke Ptr CTimeVal
p (CTimeVal CLong
sec CLong
usec) = do
((\Ptr CTimeVal
hsc_ptr -> Ptr CTimeVal -> Int -> CLong -> IO ()
forall b. Ptr b -> Int -> CLong -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CTimeVal
hsc_ptr Int
0)) Ptr CTimeVal
p CLong
sec
{-# LINE 439 "libraries/unix/System/Posix/Files/Common.hsc" #-}
((\Ptr CTimeVal
hsc_ptr -> Ptr CTimeVal -> Int -> CLong -> IO ()
forall b. Ptr b -> Int -> CLong -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CTimeVal
hsc_ptr Int
8)) Ptr CTimeVal
p CLong
usec
{-# LINE 440 "libraries/unix/System/Posix/Files/Common.hsc" #-}
peek p = do
sec <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 442 "libraries/unix/System/Posix/Files/Common.hsc" #-}
usec <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 443 "libraries/unix/System/Posix/Files/Common.hsc" #-}
return $ CTimeVal sec usec
toCTimeVal :: POSIXTime -> CTimeVal
toCTimeVal :: POSIXTime -> CTimeVal
toCTimeVal POSIXTime
t = CLong -> CLong -> CTimeVal
CTimeVal CLong
sec (Rational -> CLong
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational -> CLong) -> Rational -> CLong
forall a b. (a -> b) -> a -> b
$ Rational
10Rational -> Int -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6::Int) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
frac)
where
(CLong
sec, Rational
frac) = if (Rational
frac' Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0) then (CLong
sec' CLong -> CLong -> CLong
forall a. Num a => a -> a -> a
- CLong
1, Rational
frac' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
1) else (CLong
sec', Rational
frac')
(CLong
sec', Rational
frac') = Rational -> (CLong, Rational)
forall b. Integral b => Rational -> (b, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Rational -> (CLong, Rational)) -> Rational -> (CLong, Rational)
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational POSIXTime
t
foreign import ccall unsafe "utimes"
c_utimes :: CString -> Ptr CTimeVal -> IO CInt
{-# LINE 455 "libraries/unix/System/Posix/Files/Common.hsc" #-}
foreign import ccall unsafe "lutimes"
c_lutimes :: CString -> Ptr CTimeVal -> IO CInt
{-# LINE 458 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 460 "libraries/unix/System/Posix/Files/Common.hsc" #-}
foreign import ccall unsafe "futimes"
c_futimes :: CInt -> Ptr CTimeVal -> IO CInt
{-# LINE 463 "libraries/unix/System/Posix/Files/Common.hsc" #-}
setFdTimesHiRes :: Fd -> POSIXTime -> POSIXTime -> IO ()
{-# LINE 473 "libraries/unix/System/Posix/Files/Common.hsc" #-}
setFdTimesHiRes (Fd fd) atime mtime =
withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
throwErrnoIfMinus1_ "setFdTimesHiRes" (c_futimens fd times)
{-# LINE 484 "libraries/unix/System/Posix/Files/Common.hsc" #-}
touchFd :: Fd -> IO ()
{-# LINE 494 "libraries/unix/System/Posix/Files/Common.hsc" #-}
touchFd (Fd fd) =
throwErrnoIfMinus1_ "touchFd" (c_futimes fd nullPtr)
{-# LINE 500 "libraries/unix/System/Posix/Files/Common.hsc" #-}
setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO ()
setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO ()
setFdOwnerAndGroup (Fd CInt
fd) UserID
uid GroupID
gid =
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setFdOwnerAndGroup" (CInt -> UserID -> GroupID -> IO CInt
c_fchown CInt
fd UserID
uid GroupID
gid)
foreign import ccall unsafe "fchown"
c_fchown :: CInt -> CUid -> CGid -> IO CInt
setFdSize :: Fd -> FileOffset -> IO ()
setFdSize :: Fd -> FileOffset -> IO ()
setFdSize (Fd CInt
fd) FileOffset
off =
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setFdSize" (CInt -> FileOffset -> IO CInt
c_ftruncate CInt
fd FileOffset
off)
data PathVar
= FileSizeBits
| LinkLimit
| InputLineLimit
| InputQueueLimit
| FileNameLimit
| PathNameLimit
| PipeBufferLimit
| SymbolicLinkLimit
| SetOwnerAndGroupIsRestricted
| FileNamesAreNotTruncated
| VDisableChar
| AsyncIOAvailable
| PrioIOAvailable
| SyncIOAvailable
pathVarConst :: PathVar -> CInt
pathVarConst :: PathVar -> CInt
pathVarConst PathVar
v = case PathVar
v of
PathVar
LinkLimit -> (CInt
0)
{-# LINE 553 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
InputLineLimit -> (CInt
1)
{-# LINE 554 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
InputQueueLimit -> (CInt
2)
{-# LINE 555 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
FileNameLimit -> (CInt
3)
{-# LINE 556 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
PathNameLimit -> (CInt
4)
{-# LINE 557 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
PipeBufferLimit -> (CInt
5)
{-# LINE 558 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
SetOwnerAndGroupIsRestricted -> (CInt
6)
{-# LINE 559 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
FileNamesAreNotTruncated -> (CInt
7)
{-# LINE 560 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
VDisableChar -> (CInt
8)
{-# LINE 561 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 563 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
SyncIOAvailable -> (CInt
9)
{-# LINE 564 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 567 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 569 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
AsyncIOAvailable -> (CInt
10)
{-# LINE 570 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 573 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 575 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
PrioIOAvailable -> (CInt
11)
{-# LINE 576 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 579 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 583 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
FileSizeBits -> String -> CInt
forall a. HasCallStack => String -> a
error String
"_PC_FILESIZEBITS not available"
{-# LINE 585 "libraries/unix/System/Posix/Files/Common.hsc" #-}
{-# LINE 589 "libraries/unix/System/Posix/Files/Common.hsc" #-}
PathVar
SymbolicLinkLimit -> String -> CInt
forall a. HasCallStack => String -> a
error String
"_PC_SYMLINK_MAX not available"
{-# LINE 591 "libraries/unix/System/Posix/Files/Common.hsc" #-}
getFdPathVar :: Fd -> PathVar -> IO Limit
getFdPathVar :: Fd -> PathVar -> IO CLong
getFdPathVar (Fd CInt
fd) PathVar
v =
String -> IO CLong -> IO CLong
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"getFdPathVar" (IO CLong -> IO CLong) -> IO CLong -> IO CLong
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> IO CLong
c_fpathconf CInt
fd (PathVar -> CInt
pathVarConst PathVar
v)
foreign import ccall unsafe "fpathconf"
c_fpathconf :: CInt -> CInt -> IO CLong