diff --git a/hbs2-storage-ncq/hbs2-storage-ncq.cabal b/hbs2-storage-ncq/hbs2-storage-ncq.cabal index f851dfd8..690aad9e 100644 --- a/hbs2-storage-ncq/hbs2-storage-ncq.cabal +++ b/hbs2-storage-ncq/hbs2-storage-ncq.cabal @@ -74,6 +74,7 @@ library HBS2.Storage.NCQ3.Internal.Files HBS2.Storage.NCQ3.Internal.Fossil HBS2.Storage.NCQ3.Internal.Flags + HBS2.Storage.NCQ3.Internal.Fsync HBS2.Storage.NCQ HBS2.Storage.NCQ.Types -- other-modules: diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fsync.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fsync.hs new file mode 100644 index 00000000..6dbd7765 --- /dev/null +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fsync.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE CPP #-} +module HBS2.Storage.NCQ3.Internal.Fsync where + +import Foreign.C.Types +import System.Posix.Types +import System.Posix.Unistd (fileSynchronise) + +foreign import capi unsafe "unistd.h fsync" + c_fsync :: CInt -> IO CInt + +#if defined(darwin_HOST_OS) +foreign import capi unsafe "fcntl.h fcntl" + c_fcntl :: CInt -> CInt -> CInt -> IO CInt + +foreign import capi unsafe "fcntl.h value F_FULLFSYNC" + f_FULLFSYNC :: CInt +#endif + +fileSynchronisePortable :: Fd -> IO () +fileSynchronisePortable fd@(Fd fdi) = do +#if defined(darwin_HOST_OS) + c_fcntl fdi f_FULLFSYNC 0 +#else + fileSynchronise fd +#endif +{-# INLINE fileSynchronisePortable #-} + + diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs index a840bc1d..cecae900 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs @@ -12,6 +12,7 @@ import HBS2.Storage.NCQ3.Internal.Sweep import HBS2.Storage.NCQ3.Internal.MMapCache import HBS2.Storage.NCQ3.Internal.Fossil import HBS2.Storage.NCQ3.Internal.Flags +import HBS2.Storage.NCQ3.Internal.Fsync import Control.Concurrent.STM qualified as STM import Control.Monad.Trans.Cont @@ -31,6 +32,8 @@ import System.Posix.IO.ByteString as Posix import System.Posix.Types as Posix import System.Posix.Unistd +{- HLINT ignore "Eta reduce" -} + ncqStorageStop :: forall m . MonadUnliftIO m => NCQStorage -> m () ncqStorageStop NCQStorage{..} = do atomically $ writeTVar ncqStopReq True @@ -267,7 +270,7 @@ ncqStorageRun ncq@NCQStorage{..} = withSem ncqRunSem $ flip runContT pure do else do ss <- appendTailSection fh - liftIO (fileSynchronise fh) + liftIO (fileSynchronisePortable fh) -- ss <- liftIO (PFS.getFdStatus fh) <&> fromIntegral . PFS.fileSize