Merge pull request #732 from IntersectMBO/jdral/remove-fcntl-nocache

Remove `blockio:fcntl-nocache` in favour of the `unix` package

Author: jorisdral

bench/macro/lsm-tree-bench-lookups.hs

@@ -3,6 +3,7 @@
 module Main ( main ) where
 
 import           Control.DeepSeq
+import           Control.Exception (bracket)
 import           Control.Monad
 import           Control.Monad.Class.MonadST
 import           Control.Monad.Primitive
@@ -198,18 +199,18 @@ benchmarks !caching = withFS $ \hfs hbio -> do
                 (x1 + x2, y1 + y2)
     _bprepLookups <-
       benchmark "benchPrepLookups"
-                "Calculate batches of keys, and prepare lookups for each batch. This is roughly doing the same amount of work as benchIndexSearches. Net time/allocation is the result of subtracting the cost of benchGenKeyBatches."
+                "Calculate batches of keys, and prepare lookups for each batch. This is roughly doing the same amount of work as benchBloomQueries and benchIndexSearches. Net time/allocation is the result of subtracting the cost of benchGenKeyBatches."
                 (benchPrepLookups arenaManager blooms indexes handles keyRng0) benchmarkNumLookups
                 bgenKeyBatches
     _blookupsIO <-
       benchmark "benchLookupsIO"
                 "Calculate batches of keys, and perform disk lookups for each batch. This is roughly doing the same as benchPrepLookups, but also performing the disk I/O and resolving values. Net time/allocation is the result of subtracting the cost of benchGenKeyBatches."
                 (\n -> do
                     let wb_unused = WB.empty
-                    wbblobs_unused <- WBB.new hfs (FS.mkFsPath [])
-                    benchLookupsIO hbio arenaManager benchmarkResolveSerialisedValue
-                                   wb_unused wbblobs_unused runs blooms indexes handles
-                                   keyRng0 n)
+                    bracket (WBB.new hfs (FS.mkFsPath ["wbblobs_unused"])) releaseRef $ \wbblobs_unused ->
+                      benchLookupsIO hbio arenaManager benchmarkResolveSerialisedValue
+                                     wb_unused wbblobs_unused runs blooms indexes handles
+                                     keyRng0 n)
                 benchmarkNumLookups
                 bgenKeyBatches
     --TODO: consider adding benchmarks that also use the write buffer

blockio/blockio.cabal

@@ -82,20 +82,15 @@ library
   if os(linux)
     hs-source-dirs: src-linux
     other-modules:  System.FS.BlockIO.Internal
-    build-depends:
-      , blockio:fcntl-nocache
-      , unix                   ^>=2.8
+    build-depends:  unix ^>=2.8.7
 
     if !flag(serialblockio)
       other-modules: System.FS.BlockIO.Async
       build-depends: blockio-uring ^>=0.1
 
   elif os(osx)
     hs-source-dirs: src-macos
-    build-depends:
-      , blockio:fcntl-nocache
-      , unix                   ^>=2.8
-
+    build-depends:  unix ^>=2.8.7
     other-modules:  System.FS.BlockIO.Internal
 
   elif os(windows)
@@ -106,24 +101,11 @@ library
   if flag(serialblockio)
     cpp-options: -DSERIALBLOCKIO
 
-library fcntl-nocache
-  import:             language, warnings
-  visibility:         private
-  hs-source-dirs:     src-fcntl-nocache
-
-  if os(windows)
-    buildable: False
-
-  exposed-modules:    System.Posix.Fcntl.NoCache
-  build-depends:      base <5
-  build-tool-depends: hsc2hs:hsc2hs
-
 test-suite test
   import:         language, warnings
   type:           exitcode-stdio-1.0
   hs-source-dirs: test
   main-is:        Main.hs
-  other-modules:  Test.System.Posix.Fcntl.NoCache
   build-depends:
     , async
     , base              <5
@@ -138,9 +120,6 @@ test-suite test
     , temporary
     , vector
 
-  if !os(windows)
-    build-depends: blockio:fcntl-nocache
-
   ghc-options:    -threaded
 
 library sim

blockio/src-fcntl-nocache/System/Posix/Fcntl/NoCache.hsc

@@ -12,7 +12,6 @@ import           System.FS.BlockIO.API (Advice (..), FileOffset, HasBlockIO,
 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.NoCache as Unix
 import qualified System.Posix.Files as Unix
 import qualified System.Posix.Unistd as Unix
 
@@ -53,7 +52,7 @@ ioHasBlockIO hfs  params =
 
 hSetNoCache :: Handle HandleIO -> Bool -> IO ()
 hSetNoCache h b =
-  FS.withOpenHandle "hSetNoCache" (handleRaw h) (flip Unix.writeFcntlNoCache b)
+  FS.withOpenHandle "hSetNoCache" (handleRaw h) (flip Fcntl.fileSetCaching (not b))
 
 hAdvise :: Handle HandleIO -> FileOffset -> FileOffset -> Advice -> IO ()
 hAdvise h off len advice = FS.withOpenHandle "hAdvise" (handleRaw h) $ \fd ->

blockio/src-linux/System/FS/BlockIO/Internal.hs

@@ -10,7 +10,7 @@ import           System.FS.BlockIO.API (Advice (..), FileOffset, HasBlockIO,
 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.NoCache as Unix
+import qualified System.Posix.Fcntl as Unix
 import qualified System.Posix.Files as Unix
 import qualified System.Posix.Unistd as Unix
 
@@ -36,7 +36,7 @@ ioHasBlockIO hfs _params =
 
 hSetNoCache :: Handle HandleIO -> Bool -> IO ()
 hSetNoCache h b =
-  FS.withOpenHandle "hSetNoCache" (handleRaw h) (flip Unix.writeFcntlNoCache b)
+  FS.withOpenHandle "hSetNoCache" (handleRaw h) (flip Unix.fileSetCaching (not b))
 
 -- TODO: it is unclear if MacOS supports @posix_fadvise(2)@, and it's hard to
 -- check because there are no manual pages online. For now, it's just hardcoded

blockio/src-macos/System/FS/BlockIO/Internal.hs

@@ -33,15 +33,12 @@ import           Test.Tasty
 import           Test.Tasty.HUnit
 import           Test.Tasty.QuickCheck (testProperty)
 
-import qualified Test.System.Posix.Fcntl.NoCache
-
 main :: IO ()
 main = defaultMain tests
 
 tests :: TestTree
 tests = testGroup "blockio:test" [
-      Test.System.Posix.Fcntl.NoCache.tests
-    , testCase "example_initClose" example_initClose
+      testCase "example_initClose" example_initClose
     , testCase "example_closeIsIdempotent" example_closeIsIdempotent
     , testProperty "prop_readWrite" prop_readWrite
     , testProperty "prop_submitToClosedCtx" prop_submitToClosedCtx

blockio/test/Main.hs

@@ -1,7 +1,7 @@
 index-state:
   -- Bump this if you need newer packages from Hackage
-  -- quickcheck-lockstep-0.7.0
-  , hackage.haskell.org 2025-05-09T15:42:47Z
+  -- unix-2.8.7.0
+  , hackage.haskell.org 2025-05-10T14:12:28Z
 
 packages:
   .