{-# LINE 1 "src/System/LibFuse3/FileStat.hsc" #-}
{-# LANGUAGE RecordWildCards #-}
-- | @struct stat@ in Haskell.
module System.LibFuse3.FileStat where



import Foreign (Storable, alloca, castPtr, peek, peekByteOff, pokeByteOff)
import Foreign.C (throwErrnoIfMinus1Retry_)
import System.Clock (TimeSpec)
import System.Posix.Error (throwErrnoPathIfMinus1Retry_)
import System.Posix.Internals (c_fstat, lstat, withFilePath)
import System.Posix.Types
  ( CBlkCnt
  , DeviceID
  , Fd(Fd)
  , FileID
  , FileMode
  , FileOffset
  , GroupID
  , LinkCount
  , UserID
  )

import qualified Foreign

-- | A file status a.k.a. metadata.
--
-- The differences from `System.Posix.Files.FileStatus` are:
--
--   - Is a record type with a `Storable` instance.
--
--   - Has an extra field `blockCount`.
--
--       - An equivalent accessor @fileBlocks@ was added in unix-2.8.0.0, but it is a @Maybe@.
--
--   - Provides an exact representation (`TimeSpec`) of the time fields without converting to `Date.Time.Clock.POSIX.POSIXTime`.
--
--       - This assumes that the @struct stat@ has @st_atim@, @st_mtim@ and @st_ctim@ fields.
--         On Linux this requires Linux >= 2.6.
--
-- @Ptr FileStat@ can be cast to @Ptr `System.Posix.Internals.CStat`@ and vice versa.
--
-- Use `defaultFileStat` and modify its fields you are interested in.
--
-- The @st_ino@ field is ignored unless the @use_ino@ mount option is given.
--
-- The @st_dev@ and @st_blksize@ fields are ignored by libfuse, so not provided.
data FileStat = FileStat
  { -- | Inode number. @st_ino@
    FileStat -> FileID
fileID :: FileID
  , -- | File type and mode. @st_mode@
    FileStat -> FileMode
fileMode :: FileMode
  , -- | Number of hard links. @st_nlink@
    FileStat -> LinkCount
linkCount :: LinkCount
  , -- | User ID of owner. @st_uid@
    FileStat -> UserID
fileOwner :: UserID
  , -- | Group ID of owner. @st_gid@
    FileStat -> GroupID
fileGroup :: GroupID
  , -- | Device ID (if special file). @st_rdev@
    FileStat -> DeviceID
specialDeviceID :: DeviceID
  , -- | Total size, in bytes. @st_size@
    FileStat -> FileOffset
fileSize :: FileOffset
  , -- | Number of 512B blocks allocated. @st_blocks@
    FileStat -> CBlkCnt
blockCount :: CBlkCnt
  -- these assumes Linux >= 2.6
  , -- | Time of last access. @st_atim@
    FileStat -> TimeSpec
accessTimeHiRes :: TimeSpec
  , -- | Time of last modification. @st_mtim@
    FileStat -> TimeSpec
modificationTimeHiRes :: TimeSpec
  , -- | Time of last status change. @st_ctim@
    FileStat -> TimeSpec
statusChangeTimeHiRes :: TimeSpec
  }
  deriving (FileStat -> FileStat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileStat -> FileStat -> Bool
$c/= :: FileStat -> FileStat -> Bool
== :: FileStat -> FileStat -> Bool
$c== :: FileStat -> FileStat -> Bool
Eq, Int -> FileStat -> ShowS
[FileStat] -> ShowS
FileStat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileStat] -> ShowS
$cshowList :: [FileStat] -> ShowS
show :: FileStat -> String
$cshow :: FileStat -> String
showsPrec :: Int -> FileStat -> ShowS
$cshowsPrec :: Int -> FileStat -> ShowS
Show)

-- | Targets @struct stat@.
instance Storable FileStat where
  sizeOf :: FileStat -> Int
sizeOf FileStat
_ = (Int
144)
{-# LINE 78 "src/System/LibFuse3/FileStat.hsc" #-}

  alignment :: FileStat -> Int
alignment FileStat
_ = Int
8
{-# LINE 80 "src/System/LibFuse3/FileStat.hsc" #-}

  peek :: Ptr FileStat -> IO FileStat
peek Ptr FileStat
ptr = do
    FileID
fileID     <- ((\Ptr FileStat
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FileStat
hsc_ptr Int
8)) Ptr FileStat
ptr
{-# LINE 83 "src/System/LibFuse3/FileStat.hsc" #-}
    fileMode   <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 84 "src/System/LibFuse3/FileStat.hsc" #-}
    linkCount  <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 85 "src/System/LibFuse3/FileStat.hsc" #-}
    fileOwner  <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
{-# LINE 86 "src/System/LibFuse3/FileStat.hsc" #-}
    fileGroup  <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 87 "src/System/LibFuse3/FileStat.hsc" #-}
    specialDeviceID <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
{-# LINE 88 "src/System/LibFuse3/FileStat.hsc" #-}
    fileSize   <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) ptr
{-# LINE 89 "src/System/LibFuse3/FileStat.hsc" #-}
    blockCount <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) ptr
{-# LINE 90 "src/System/LibFuse3/FileStat.hsc" #-}
    accessTimeHiRes       <- ((\hsc_ptr -> peekByteOff hsc_ptr 72)) ptr
{-# LINE 91 "src/System/LibFuse3/FileStat.hsc" #-}
    modificationTimeHiRes <- ((\hsc_ptr -> peekByteOff hsc_ptr 88)) ptr
{-# LINE 92 "src/System/LibFuse3/FileStat.hsc" #-}
    statusChangeTimeHiRes <- ((\hsc_ptr -> peekByteOff hsc_ptr 104)) ptr
{-# LINE 93 "src/System/LibFuse3/FileStat.hsc" #-}
    pure FileStat{..}

  poke :: Ptr FileStat -> FileStat -> IO ()
poke Ptr FileStat
ptr FileStat{UserID
FileOffset
LinkCount
FileMode
FileID
GroupID
DeviceID
CBlkCnt
TimeSpec
statusChangeTimeHiRes :: TimeSpec
modificationTimeHiRes :: TimeSpec
accessTimeHiRes :: TimeSpec
blockCount :: CBlkCnt
fileSize :: FileOffset
specialDeviceID :: DeviceID
fileGroup :: GroupID
fileOwner :: UserID
linkCount :: LinkCount
fileMode :: FileMode
fileID :: FileID
statusChangeTimeHiRes :: FileStat -> TimeSpec
modificationTimeHiRes :: FileStat -> TimeSpec
accessTimeHiRes :: FileStat -> TimeSpec
blockCount :: FileStat -> CBlkCnt
fileSize :: FileStat -> FileOffset
specialDeviceID :: FileStat -> DeviceID
fileGroup :: FileStat -> GroupID
fileOwner :: FileStat -> UserID
linkCount :: FileStat -> LinkCount
fileMode :: FileStat -> FileMode
fileID :: FileStat -> FileID
..} = do
    ((\Ptr FileStat
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FileStat
hsc_ptr Int
8))    Ptr FileStat
ptr FileID
fileID
{-# LINE 97 "src/System/LibFuse3/FileStat.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24))   ptr fileMode
{-# LINE 98 "src/System/LibFuse3/FileStat.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16))  ptr linkCount
{-# LINE 99 "src/System/LibFuse3/FileStat.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 28))    ptr fileOwner
{-# LINE 100 "src/System/LibFuse3/FileStat.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 32))    ptr fileGroup
{-# LINE 101 "src/System/LibFuse3/FileStat.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 40))   ptr specialDeviceID
{-# LINE 102 "src/System/LibFuse3/FileStat.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 48))   ptr fileSize
{-# LINE 103 "src/System/LibFuse3/FileStat.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 64)) ptr blockCount
{-# LINE 104 "src/System/LibFuse3/FileStat.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 72))   ptr accessTimeHiRes
{-# LINE 105 "src/System/LibFuse3/FileStat.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 88))   ptr modificationTimeHiRes
{-# LINE 106 "src/System/LibFuse3/FileStat.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 104))   ptr statusChangeTimeHiRes
{-# LINE 107 "src/System/LibFuse3/FileStat.hsc" #-}

-- | The default value of `FileStat`.
--
-- The Haskell Equivalent of zero-setting C code @{ struct stat st; memset(&st, 0, sizeof(struct stat)); }@.
defaultFileStat :: FileStat
defaultFileStat :: FileStat
defaultFileStat = FileID
-> FileMode
-> LinkCount
-> UserID
-> GroupID
-> DeviceID
-> FileOffset
-> CBlkCnt
-> TimeSpec
-> TimeSpec
-> TimeSpec
-> FileStat
FileStat FileID
0 FileMode
0 LinkCount
0 UserID
0 GroupID
0 DeviceID
0 FileOffset
0 CBlkCnt
0 TimeSpec
0 TimeSpec
0 TimeSpec
0

-- | Reads a file status of a given file.
--
-- Calls @lstat@.
getFileStat :: FilePath -> IO FileStat
getFileStat :: String -> IO FileStat
getFileStat String
path =
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr FileStat
buf ->
    forall a. String -> (CString -> IO a) -> IO a
withFilePath String
path forall a b. (a -> b) -> a -> b
$ \CString
cpath -> do
      forall a. (Eq a, Num a) => String -> String -> IO a -> IO ()
throwErrnoPathIfMinus1Retry_ String
"getFileStat" String
path (CString -> Ptr CStat -> IO CInt
lstat CString
cpath (forall a b. Ptr a -> Ptr b
castPtr Ptr FileStat
buf))
      forall a. Storable a => Ptr a -> IO a
peek Ptr FileStat
buf

-- | Reads a file status of a given file.
--
-- Calls @fstat@.
getFileStatFd :: Fd -> IO FileStat
getFileStatFd :: Fd -> IO FileStat
getFileStatFd (Fd CInt
fd) =
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr FileStat
buf -> do
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"getFileStatFd" (CInt -> Ptr CStat -> IO CInt
c_fstat CInt
fd (forall a b. Ptr a -> Ptr b
castPtr Ptr FileStat
buf))
    forall a. Storable a => Ptr a -> IO a
peek Ptr FileStat
buf