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



import Foreign (Ptr, Storable, alloca, peek, peekByteOff, pokeByteOff)
import Foreign.C (CInt(CInt), CString, CULong, throwErrnoIfMinus1Retry_)
import System.Posix.Error (throwErrnoPathIfMinus1Retry_)
import System.Posix.Internals (withFilePath)
import System.Posix.Types (CFsBlkCnt, CFsFilCnt, Fd(Fd))

import qualified Foreign

-- | Passed to `System.LibFuse3.fuseStatfs`.
--
-- The 'Storable' instance targets C @struct statvfs@.
--
-- @f_favail@, @f_fsid@ and @f_flag@ fields are ignored by libfuse, and their corresponding
-- fields are not defined.
data FileSystemStats = FileSystemStats
  { -- | Filesystem block size. @f_bsize@
    FileSystemStats -> CULong
blockSize :: CULong
  , -- | Fragment size. @f_frsize@
    FileSystemStats -> CULong
fragmentSize :: CULong
  , -- | Size of the filesystem in @f_frsize@ units. @f_blocks@
    FileSystemStats -> CFsBlkCnt
blockCount :: CFsBlkCnt
  , -- | Number of free blocks. @f_bfree@
    FileSystemStats -> CFsBlkCnt
blocksFree :: CFsBlkCnt
  , -- | Number of free blocks for unprivileged users. @f_bavail@
    FileSystemStats -> CFsBlkCnt
blocksAvailable :: CFsBlkCnt
  , -- | Number of inodes (file nodes). @f_files@
    FileSystemStats -> CFsFilCnt
fileCount :: CFsFilCnt
  , -- | Number of free inodes. @f_ffree@
    FileSystemStats -> CFsFilCnt
filesFree :: CFsFilCnt
  , -- | Maximum filename length. @f_namemax@
    FileSystemStats -> CULong
maxNameLength :: CULong
  }
  deriving (FileSystemStats -> FileSystemStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileSystemStats -> FileSystemStats -> Bool
$c/= :: FileSystemStats -> FileSystemStats -> Bool
== :: FileSystemStats -> FileSystemStats -> Bool
$c== :: FileSystemStats -> FileSystemStats -> Bool
Eq, Int -> FileSystemStats -> ShowS
[FileSystemStats] -> ShowS
FileSystemStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileSystemStats] -> ShowS
$cshowList :: [FileSystemStats] -> ShowS
show :: FileSystemStats -> String
$cshow :: FileSystemStats -> String
showsPrec :: Int -> FileSystemStats -> ShowS
$cshowsPrec :: Int -> FileSystemStats -> ShowS
Show)

instance Storable FileSystemStats where
  sizeOf :: FileSystemStats -> Int
sizeOf FileSystemStats
_ = (Int
112)
{-# LINE 43 "src/System/LibFuse3/FileSystemStats.hsc" #-}

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

  peek :: Ptr FileSystemStats -> IO FileSystemStats
peek Ptr FileSystemStats
ptr = do
    CULong
blockSize       <- ((\Ptr FileSystemStats
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FileSystemStats
hsc_ptr Int
0)) Ptr FileSystemStats
ptr
{-# LINE 48 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    fragmentSize    <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 49 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    blockCount      <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 50 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    blocksFree      <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 51 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    blocksAvailable <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 52 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    fileCount       <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
{-# LINE 53 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    filesFree       <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) ptr
{-# LINE 54 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    maxNameLength   <- ((\hsc_ptr -> peekByteOff hsc_ptr 80)) ptr
{-# LINE 55 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    pure FileSystemStats{..}

  poke :: Ptr FileSystemStats -> FileSystemStats -> IO ()
poke Ptr FileSystemStats
ptr FileSystemStats{CFsFilCnt
CFsBlkCnt
CULong
maxNameLength :: CULong
filesFree :: CFsFilCnt
fileCount :: CFsFilCnt
blocksAvailable :: CFsBlkCnt
blocksFree :: CFsBlkCnt
blockCount :: CFsBlkCnt
fragmentSize :: CULong
blockSize :: CULong
maxNameLength :: FileSystemStats -> CULong
filesFree :: FileSystemStats -> CFsFilCnt
fileCount :: FileSystemStats -> CFsFilCnt
blocksAvailable :: FileSystemStats -> CFsBlkCnt
blocksFree :: FileSystemStats -> CFsBlkCnt
blockCount :: FileSystemStats -> CFsBlkCnt
fragmentSize :: FileSystemStats -> CULong
blockSize :: FileSystemStats -> CULong
..} = do
    ((\Ptr FileSystemStats
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FileSystemStats
hsc_ptr Int
0))   Ptr FileSystemStats
ptr CULong
blockSize
{-# LINE 59 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8))  ptr fragmentSize
{-# LINE 60 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16))  ptr blockCount
{-# LINE 61 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24))   ptr blocksFree
{-# LINE 62 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 32))  ptr blocksAvailable
{-# LINE 63 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 40))   ptr fileCount
{-# LINE 64 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 48))   ptr filesFree
{-# LINE 65 "src/System/LibFuse3/FileSystemStats.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 80)) ptr maxNameLength
{-# LINE 66 "src/System/LibFuse3/FileSystemStats.hsc" #-}

-- | Gets filesystem statistics.
--
-- Calls @statvfs@.
getFileSystemStats
  :: FilePath  -- ^ A path of any file within the filesystem
  -> IO FileSystemStats
getFileSystemStats :: String -> IO FileSystemStats
getFileSystemStats String
path =
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr FileSystemStats
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
"getFileSystemStats" String
path (CString -> Ptr FileSystemStats -> IO CInt
c_statvfs CString
cpath Ptr FileSystemStats
buf)
    forall a. Storable a => Ptr a -> IO a
peek Ptr FileSystemStats
buf

-- | Gets filesystem statistics.
--
-- Calls @fstatvfs@.
getFileSystemStatsFd :: Fd -> IO FileSystemStats
getFileSystemStatsFd :: Fd -> IO FileSystemStats
getFileSystemStatsFd Fd
fd =
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr FileSystemStats
buf -> do
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"getFileSystemStatsFd" (Fd -> Ptr FileSystemStats -> IO CInt
c_fstatvfs Fd
fd Ptr FileSystemStats
buf)
    forall a. Storable a => Ptr a -> IO a
peek Ptr FileSystemStats
buf

foreign import ccall safe "fstatvfs"
  c_fstatvfs :: Fd -> Ptr FileSystemStats -> IO CInt

foreign import ccall safe "statvfs"
  c_statvfs :: CString -> Ptr FileSystemStats -> IO CInt