diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,15 @@ # Revision history for blockio +## 0.1.1.0 -- 2025-12-03 + +* NON-BREAKING: Support `unix-2.8.6` by vendoring code related to file caching + from the `unix` package. See PR + [#805](https://github.com/IntersectMBO/lsm-tree/pull/805). + ## 0.1.0.1 -- 2025-07-15 -* Include the README in the distributed files. +* PATCH: Include the README in the distributed files. See PR + [#787](https://github.com/IntersectMBO/lsm-tree/pull/787). ## 0.1.0.0 -- 2025-07-15 diff --git a/blockio.cabal b/blockio.cabal --- a/blockio.cabal +++ b/blockio.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: blockio -version: 0.1.0.1 +version: 0.1.1.0 synopsis: Perform batches of disk I/O operations. description: Perform batches of disk I\/O operations. Performing batches of disk I\/O can @@ -46,7 +46,7 @@ type: git location: https://github.com/IntersectMBO/lsm-tree subdir: blockio - tag: blockio-0.1.0.1 + tag: blockio-0.1.1.0 common warnings ghc-options: @@ -93,8 +93,10 @@ 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 @@ 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/src-linux/System/FS/BlockIO/Internal.hs b/src-linux/System/FS/BlockIO/Internal.hs --- a/src-linux/System/FS/BlockIO/Internal.hs +++ b/src-linux/System/FS/BlockIO/Internal.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} - module System.FS.BlockIO.Internal ( ioHasBlockIO ) where @@ -7,10 +6,12 @@ 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/src-linux/System/FS/BlockIO/Internal/Fcntl.hsc b/src-linux/System/FS/BlockIO/Internal/Fcntl.hsc new file mode 100644 --- /dev/null +++ b/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/src-macos/System/FS/BlockIO/Internal.hs b/src-macos/System/FS/BlockIO/Internal.hs --- a/src-macos/System/FS/BlockIO/Internal.hs +++ b/src-macos/System/FS/BlockIO/Internal.hs @@ -5,11 +5,11 @@ 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/src-macos/System/FS/BlockIO/Internal/Fcntl.hsc b/src-macos/System/FS/BlockIO/Internal/Fcntl.hsc new file mode 100644 --- /dev/null +++ b/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