{-# OPTIONS_GHC -optc-D_GNU_SOURCE #-}
{-# LINE 1 "src-linux/System/FS/BlockIO/Internal/Fcntl.hsc" #-}
{-# LANGUAGE CPP #-}
-- | Compatibility layer for the @unix@ package to provide a @fileSetCaching@ function.
--
-- @unix >= 2.8.7@ defines a @fileSetCaching@ function, but @unix < 2.8.7@ does not. This module defines the function for @unix@ versions @< 2.8.7@. The implementation is adapted from https://github.com/haskell/unix/blob/v2.8.8.0/System/Posix/Fcntl.hsc#L116-L182.
--
-- NOTE: in the future if we no longer support @unix@ versions @< 2.8.7@, then this module can be removed.
module System.FS.BlockIO.Internal.Fcntl (fileSetCaching) where


{-# LINE 14 "src-linux/System/FS/BlockIO/Internal/Fcntl.hsc" #-}

-- hsc2hs does not define _GNU_SOURCE, so a .hsc file must define it explicitly
-- or O_DIRECT stays hidden. The unix package doesn’t define it in source, but
-- its configure script calls AC_USE_SYSTEM_EXTENSIONS, which adds -D_GNU_SOURCE
-- to the build CFLAGS, and those flags are passed on to hsc2hs through the
-- generated `config.mk`.




import           Data.Bits (complement, (.&.), (.|.))
import           Foreign.C (throwErrnoIfMinus1, throwErrnoIfMinus1_)
import           System.Posix.Internals
import           System.Posix.Types (Fd (Fd))

-- | For simplification, we considered that Linux !HAS_F_NOCACHE and HAS_O_DIRECT
fileSetCaching :: Fd -> Bool -> IO ()
fileSetCaching :: Fd -> Bool -> IO ()
fileSetCaching (Fd CInt
fd) Bool
val = do
    CInt
r <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"fileSetCaching" (CInt -> CInt -> IO CInt
c_fcntl_read CInt
fd CInt
3)
{-# LINE 33 "src-linux/System/FS/BlockIO/Internal/Fcntl.hsc" #-}
    let r' | val       = fromIntegral r .&. complement opt_val
           | otherwise = fromIntegral r .|. opt_val
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"fileSetCaching" (CInt -> CInt -> CLong -> IO CInt
c_fcntl_write CInt
fd CInt
4 CLong
r')
{-# LINE 36 "src-linux/System/FS/BlockIO/Internal/Fcntl.hsc" #-}
  where
    opt_val :: CLong
opt_val = CLong
16384
{-# LINE 38 "src-linux/System/FS/BlockIO/Internal/Fcntl.hsc" #-}

{-# LINE 39 "src-linux/System/FS/BlockIO/Internal/Fcntl.hsc" #-}