From 8ca4ac80c9d177b4e4dee77de1f8c3f2f143d58f Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Tue, 25 Nov 2025 09:34:56 +0100 Subject: [PATCH] Allow unix 2.8.6 --- blockio/blockio.cabal | 12 ++++-- .../src-linux/System/FS/BlockIO/Internal.hs | 5 ++- .../System/FS/BlockIO/Internal/Fcntl.hsc | 38 +++++++++++++++++++ .../src-macos/System/FS/BlockIO/Internal.hs | 2 +- .../System/FS/BlockIO/Internal/Fcntl.hsc | 25 ++++++++++++ 5 files changed, 75 insertions(+), 7 deletions(-) create mode 100644 blockio/src-linux/System/FS/BlockIO/Internal/Fcntl.hsc create mode 100644 blockio/src-macos/System/FS/BlockIO/Internal/Fcntl.hsc diff --git a/blockio/blockio.cabal b/blockio/blockio.cabal index 68b69d765..61b651dab 100644 --- a/blockio/blockio.cabal +++ b/blockio/blockio.cabal @@ -93,8 +93,10 @@ library if os(linux) hs-source-dirs: src-linux - other-modules: System.FS.BlockIO.Internal - build-depends: unix ^>=2.8.7 + build-depends: unix ^>=2.8.6 + other-modules: + System.FS.BlockIO.Internal + System.FS.BlockIO.Internal.Fcntl if !flag(serialblockio) other-modules: System.FS.BlockIO.Async @@ -102,8 +104,10 @@ library elif os(osx) hs-source-dirs: src-macos - build-depends: unix ^>=2.8.7 - other-modules: System.FS.BlockIO.Internal + build-depends: unix ^>=2.8.6 + other-modules: + System.FS.BlockIO.Internal + System.FS.BlockIO.Internal.Fcntl elif os(windows) hs-source-dirs: src-windows diff --git a/blockio/src-linux/System/FS/BlockIO/Internal.hs b/blockio/src-linux/System/FS/BlockIO/Internal.hs index 7bff61874..899516e1a 100644 --- a/blockio/src-linux/System/FS/BlockIO/Internal.hs +++ b/blockio/src-linux/System/FS/BlockIO/Internal.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} - module System.FS.BlockIO.Internal ( ioHasBlockIO ) where @@ -7,10 +6,12 @@ module System.FS.BlockIO.Internal ( import qualified System.FS.API as FS import System.FS.API (FsPath, Handle (..), HasFS) import System.FS.BlockIO.API (Advice (..), FileOffset, HasBlockIO) +import qualified System.FS.BlockIO.Internal.Fcntl as Fcntl import qualified System.FS.BlockIO.IO.Internal as IOI import System.FS.IO (HandleIO) import qualified System.FS.IO.Handle as FS -import qualified System.Posix.Fcntl as Fcntl +import qualified System.Posix.Fcntl as Fcntl (Advice (..), fileAdvise, + fileAllocate) import qualified System.Posix.Files as Unix import qualified System.Posix.Unistd as Unix diff --git a/blockio/src-linux/System/FS/BlockIO/Internal/Fcntl.hsc b/blockio/src-linux/System/FS/BlockIO/Internal/Fcntl.hsc new file mode 100644 index 000000000..8ab9a58f0 --- /dev/null +++ b/blockio/src-linux/System/FS/BlockIO/Internal/Fcntl.hsc @@ -0,0 +1,38 @@ +{-# 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 + +#if MIN_VERSION_unix(2,8,7) + +import System.Posix.Fcntl (fileSetCaching) + +#else + +-- 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`. +#define _GNU_SOURCE + +#include + +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 fd) val = do + r <- throwErrnoIfMinus1 "fileSetCaching" (c_fcntl_read fd #{const F_GETFL}) + let r' | val = fromIntegral r .&. complement opt_val + | otherwise = fromIntegral r .|. opt_val + throwErrnoIfMinus1_ "fileSetCaching" (c_fcntl_write fd #{const F_SETFL} r') + where + opt_val = #{const O_DIRECT} +#endif diff --git a/blockio/src-macos/System/FS/BlockIO/Internal.hs b/blockio/src-macos/System/FS/BlockIO/Internal.hs index 7da24ebc7..76e719ab3 100644 --- a/blockio/src-macos/System/FS/BlockIO/Internal.hs +++ b/blockio/src-macos/System/FS/BlockIO/Internal.hs @@ -5,11 +5,11 @@ module System.FS.BlockIO.Internal ( import qualified System.FS.API as FS import System.FS.API (FsPath, Handle (..), HasFS) import System.FS.BlockIO.API (Advice (..), FileOffset, HasBlockIO) +import qualified System.FS.BlockIO.Internal.Fcntl as Unix import qualified System.FS.BlockIO.IO.Internal as IOI import qualified System.FS.BlockIO.Serial as Serial import System.FS.IO (HandleIO) import qualified System.FS.IO.Handle as FS -import qualified System.Posix.Fcntl as Unix import qualified System.Posix.Files as Unix import qualified System.Posix.Unistd as Unix diff --git a/blockio/src-macos/System/FS/BlockIO/Internal/Fcntl.hsc b/blockio/src-macos/System/FS/BlockIO/Internal/Fcntl.hsc new file mode 100644 index 000000000..f870b73eb --- /dev/null +++ b/blockio/src-macos/System/FS/BlockIO/Internal/Fcntl.hsc @@ -0,0 +1,25 @@ +{-# 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 + +#if MIN_VERSION_unix(2,8,7) + +import System.Posix.Fcntl (fileSetCaching) + +#else + +#include + +import Foreign.C (throwErrnoIfMinus1_) +import System.Posix.Internals +import System.Posix.Types (Fd (Fd)) + +-- | For simplification, we considered that MacOS HAS_F_NOCACHE and !HAS_O_DIRECT +fileSetCaching :: Fd -> Bool -> IO () +fileSetCaching (Fd fd) val = do + throwErrnoIfMinus1_ "fileSetCaching" (c_fcntl_write fd #{const F_NOCACHE} (if val then 0 else 1)) +#endif