Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 8 additions & 4 deletions blockio/blockio.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -93,17 +93,21 @@ 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
build-depends: blockio-uring ^>=0.1

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
Expand Down
5 changes: 3 additions & 2 deletions blockio/src-linux/System/FS/BlockIO/Internal.hs
Original file line number Diff line number Diff line change
@@ -1,16 +1,17 @@
{-# LANGUAGE CPP #-}

module System.FS.BlockIO.Internal (
ioHasBlockIO
) where

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

Expand Down
38 changes: 38 additions & 0 deletions blockio/src-linux/System/FS/BlockIO/Internal/Fcntl.hsc
Original file line number Diff line number Diff line change
@@ -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 <fcntl.h>

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
2 changes: 1 addition & 1 deletion blockio/src-macos/System/FS/BlockIO/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
25 changes: 25 additions & 0 deletions blockio/src-macos/System/FS/BlockIO/Internal/Fcntl.hsc
Original file line number Diff line number Diff line change
@@ -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 <fcntl.h>

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