blockio: move IOCtxParams out of API and export it from IO instead

It's specific to the `IO` implementation

Author: jorisdral

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

@@ -63,7 +63,6 @@ import qualified Options.Applicative as O
 import           Prelude hiding (lookup)
 import qualified System.Clock as Clock
 import qualified System.FS.API as FS
-import qualified System.FS.BlockIO.API as FS
 import qualified System.FS.BlockIO.IO as FsIO
 import qualified System.FS.IO as FsIO
 import           System.IO
@@ -422,7 +421,7 @@ doSetup' gopts opts = do
     let hasFS :: FS.HasFS IO FsIO.HandleIO
         hasFS = FsIO.ioHasFS mountPoint
 
-    hasBlockIO <- FsIO.ioHasBlockIO hasFS FS.defaultIOCtxParams
+    hasBlockIO <- FsIO.ioHasBlockIO hasFS FsIO.defaultIOCtxParams
 
     let name = LSM.toSnapshotName "bench"
 
@@ -584,7 +583,7 @@ doRun gopts opts = do
     let hasFS :: FS.HasFS IO FsIO.HandleIO
         hasFS = FsIO.ioHasFS mountPoint
 
-    hasBlockIO <- FsIO.ioHasBlockIO hasFS FS.defaultIOCtxParams
+    hasBlockIO <- FsIO.ioHasBlockIO hasFS FsIO.defaultIOCtxParams
 
     let name = LSM.toSnapshotName "bench"
 

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

@@ -33,7 +33,7 @@ asyncHasBlockIO ::
   -> (FsPath -> IO ())
   -> (FsPath -> FsPath -> IO ())
   -> HasFS IO HandleIO
-  -> API.IOCtxParams
+  -> IOI.IOCtxParams
   -> IO (API.HasBlockIO IO HandleIO)
 asyncHasBlockIO hSetNoCache hAdvise hAllocate tryLockFile hSynchronise synchroniseDirectory createHardLink hasFS ctxParams = do
   ctx <- I.initIOCtx (ctxParamsConv ctxParams)
@@ -49,8 +49,8 @@ asyncHasBlockIO hSetNoCache hAdvise hAllocate tryLockFile hSynchronise synchroni
     , API.createHardLink
     }
 
-ctxParamsConv :: API.IOCtxParams -> I.IOCtxParams
-ctxParamsConv API.IOCtxParams{API.ioctxBatchSizeLimit, API.ioctxConcurrencyLimit} =
+ctxParamsConv :: IOI.IOCtxParams -> I.IOCtxParams
+ctxParamsConv IOI.IOCtxParams{IOI.ioctxBatchSizeLimit, IOI.ioctxConcurrencyLimit} =
     I.IOCtxParams {
         I.ioctxBatchSizeLimit   = ioctxBatchSizeLimit
       , I.ioctxConcurrencyLimit = ioctxConcurrencyLimit

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

@@ -6,8 +6,7 @@ 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,
-                     IOCtxParams)
+import           System.FS.BlockIO.API (Advice (..), FileOffset, HasBlockIO)
 import qualified System.FS.BlockIO.IO.Internal as IOI
 import           System.FS.IO (HandleIO)
 import qualified System.FS.IO.Handle as FS
@@ -23,7 +22,7 @@ import qualified System.FS.BlockIO.Async as Async
 
 ioHasBlockIO ::
      HasFS IO HandleIO
-  -> IOCtxParams
+  -> IOI.IOCtxParams
   -> IO (HasBlockIO IO HandleIO)
 #if SERIALBLOCKIO
 ioHasBlockIO hfs _params =

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

@@ -4,8 +4,7 @@ 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,
-                     IOCtxParams)
+import           System.FS.BlockIO.API (Advice (..), FileOffset, HasBlockIO)
 import qualified System.FS.BlockIO.IO.Internal as IOI
 import qualified System.FS.BlockIO.Serial as Serial
 import           System.FS.IO (HandleIO)
@@ -21,7 +20,7 @@ import qualified System.Posix.Unistd as Unix
 -- The recommended choice would be to use the POSIX AIO API.
 ioHasBlockIO ::
      HasFS IO HandleIO
-  -> IOCtxParams
+  -> IOI.IOCtxParams
   -> IO (HasBlockIO IO HandleIO)
 ioHasBlockIO hfs _params =
     Serial.serialHasBlockIO

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

@@ -6,9 +6,7 @@ import           Control.Exception (throwIO)
 import           Control.Monad (unless)
 import qualified System.FS.API as FS
 import           System.FS.API (FsPath, Handle (..), HasFS)
-import qualified System.FS.BlockIO.API as FS
-import           System.FS.BlockIO.API (Advice (..), FileOffset, HasBlockIO,
-                     IOCtxParams)
+import           System.FS.BlockIO.API (Advice (..), FileOffset, HasBlockIO)
 import qualified System.FS.BlockIO.IO.Internal as IOI
 import qualified System.FS.BlockIO.Serial as Serial
 import           System.FS.IO (HandleIO)
@@ -25,7 +23,7 @@ import qualified System.Win32.HardLink as Windows
 -- The recommended choice would be to use the Win32 IOCP API.
 ioHasBlockIO ::
      HasFS IO HandleIO
-  -> IOCtxParams
+  -> IOI.IOCtxParams
   -> IO (HasBlockIO IO HandleIO)
 ioHasBlockIO hfs _params =
     Serial.serialHasBlockIO

blockio/src/System/FS/BlockIO/API.hs

@@ -4,8 +4,6 @@
 module System.FS.BlockIO.API (
     -- * HasBlockIO
     HasBlockIO (..)
-  , IOCtxParams (..)
-  , defaultIOCtxParams
   , IOOp (..)
   , ioopHandle
   , ioopFileOffset
@@ -154,22 +152,6 @@ instance NFData (HasBlockIO m h) where
       rwhnf d `seq` rwhnf e `seq` rwhnf f `seq`
       rwhnf g `seq` rwhnf h `seq` rwhnf i
 
--- | Concurrency parameters for initialising a 'HasBlockIO. Can be ignored by
--- serial implementations.
-data IOCtxParams = IOCtxParams {
-                     ioctxBatchSizeLimit   :: !Int,
-                     ioctxConcurrencyLimit :: !Int
-                   }
-
-instance NFData IOCtxParams where
-  rnf (IOCtxParams x y) = rnf x `seq` rnf y
-
-defaultIOCtxParams :: IOCtxParams
-defaultIOCtxParams = IOCtxParams {
-      ioctxBatchSizeLimit   = 64,
-      ioctxConcurrencyLimit = 64 * 3
-    }
-
 data IOOp s h =
     IOOpRead  !(Handle h) !FileOffset !(MutableByteArray s) !BufferOffset !ByteCount
   | IOOpWrite !(Handle h) !FileOffset !(MutableByteArray s) !BufferOffset !ByteCount

blockio/src/System/FS/BlockIO/IO.hs

@@ -1,24 +1,27 @@
 module System.FS.BlockIO.IO (
     ioHasBlockIO
   , withIOHasBlockIO
+  , IOI.IOCtxParams (..)
+  , IOI.defaultIOCtxParams
   ) where
 
 import           Control.Exception (bracket)
 import           System.FS.API (HasFS)
-import           System.FS.BlockIO.API (HasBlockIO (..), IOCtxParams)
+import           System.FS.BlockIO.API (HasBlockIO (..))
 import qualified System.FS.BlockIO.Internal as I
+import qualified System.FS.BlockIO.IO.Internal as IOI
 import           System.FS.IO (HandleIO)
 
 -- | Platform-dependent IO instantiation of 'HasBlockIO'.
 ioHasBlockIO ::
      HasFS IO HandleIO
-  -> IOCtxParams
+  -> IOI.IOCtxParams
   -> IO (HasBlockIO IO HandleIO)
 ioHasBlockIO = I.ioHasBlockIO
 
 withIOHasBlockIO ::
      HasFS IO HandleIO
-  -> IOCtxParams
+  -> IOI.IOCtxParams
   -> (HasBlockIO IO HandleIO -> IO a)
   -> IO a
 withIOHasBlockIO hfs params action =

blockio/src/System/FS/BlockIO/IO/Internal.hs

@@ -2,11 +2,14 @@
 {-# LANGUAGE UnboxedTuples #-}
 
 module System.FS.BlockIO.IO.Internal (
-    mkClosedError
+    IOCtxParams (..)
+  , defaultIOCtxParams
+  , mkClosedError
   , tryLockFileIO
   , createHardLinkIO
   ) where
 
+import           Control.DeepSeq (NFData (..))
 import           Control.Monad.Class.MonadThrow (MonadCatch (bracketOnError),
                      MonadThrow (..), bracketOnError, try)
 import           GHC.IO.Exception (IOErrorType (ResourceVanished))
@@ -19,6 +22,38 @@ import           System.FS.IO (HandleIO)
 import qualified System.IO as GHC
 import           System.IO.Error (ioeSetErrorString, mkIOError)
 
+{-------------------------------------------------------------------------------
+  IO context
+-------------------------------------------------------------------------------}
+
+-- | Concurrency parameters for initialising the 'IO' context in a 'HasBlockIO'
+-- instance.
+--
+-- [IO context parameters]: These parameters are interpreted differently based
+--  on the underlying platform:
+--
+--  * Linux: Pass the parameters to 'initIOCtx' in the @blockio-uring@ package
+--  * MacOS: Ignore the parameters
+--  * Windows: Ignore the parameters
+--
+--  For more information about what these parameters mean and how to configure
+--  them, see the @blockio-uring@ package.
+data IOCtxParams = IOCtxParams {
+                     ioctxBatchSizeLimit   :: !Int,
+                     ioctxConcurrencyLimit :: !Int
+                   }
+
+instance NFData IOCtxParams where
+  rnf (IOCtxParams x y) = rnf x `seq` rnf y
+
+-- | Default parameters. Some manual tuning of parameters might be required to
+-- achieve higher performance targets (see 'IOCtxParams').
+defaultIOCtxParams :: IOCtxParams
+defaultIOCtxParams = IOCtxParams {
+      ioctxBatchSizeLimit   = 64,
+      ioctxConcurrencyLimit = 64 * 3
+    }
+
 mkClosedError :: HasCallStack => SomeHasFS m -> String -> FsError
 mkClosedError (SomeHasFS hasFS) loc = FS.ioToFsError (FS.mkFsErrorPath hasFS (FS.mkFsPath [])) ioerr
   where ioerr =

blockio/test/Main.hs

@@ -69,14 +69,14 @@ example_initClose :: Assertion
 example_initClose = withSystemTempDirectory "example_initClose" $ \dirPath -> do
     let mount = FS.MountPoint dirPath
         hfs = IO.ioHasFS mount
-    hbio <- IO.ioHasBlockIO hfs FS.defaultIOCtxParams
+    hbio <- IO.ioHasBlockIO hfs IO.defaultIOCtxParams
     close hbio
 
 example_closeIsIdempotent :: Assertion
 example_closeIsIdempotent = withSystemTempDirectory "example_closeIsIdempotent" $ \dirPath -> do
     let mount = FS.MountPoint dirPath
         hfs = IO.ioHasFS mount
-    hbio <- IO.ioHasBlockIO hfs FS.defaultIOCtxParams
+    hbio <- IO.ioHasBlockIO hfs IO.defaultIOCtxParams
     close hbio
     eith <- try @SomeException (close hbio)
     case eith of
@@ -89,7 +89,7 @@ prop_readWrite :: ByteString -> Property
 prop_readWrite bs = ioProperty $ withSystemTempDirectory "prop_readWrite" $ \dirPath -> do
     let mount = FS.MountPoint dirPath
         hfs = IO.ioHasFS mount
-    hbio <- IO.ioHasBlockIO hfs FS.defaultIOCtxParams
+    hbio <- IO.ioHasBlockIO hfs IO.defaultIOCtxParams
     prop <- FS.withFile hfs (FS.mkFsPath ["temp"]) (FS.WriteMode FS.MustBeNew) $ \h -> do
       let n = BS.length bs
       writeBuf <- fromByteStringPinned bs
@@ -108,7 +108,7 @@ prop_submitToClosedCtx :: ByteString -> Property
 prop_submitToClosedCtx bs = ioProperty $ withSystemTempDirectory "prop_a" $ \dir -> do
     let mount = FS.MountPoint dir
         hfs = IO.ioHasFS mount
-    hbio <- IO.ioHasBlockIO hfs FS.defaultIOCtxParams
+    hbio <- IO.ioHasBlockIO hfs IO.defaultIOCtxParams
 
     props <- FS.withFile hfs (FS.mkFsPath ["temp"]) (FS.WriteMode FS.MustBeNew) $ \h -> do
       void $ hPutAllStrict hfs h bs

src/Database/LSMTree.hs

@@ -271,8 +271,9 @@ import           Database.LSMTree.Internal.Unsafe (BlobRefInvalidError (..),
 import qualified Database.LSMTree.Internal.Unsafe as Internal
 import           Prelude hiding (lookup, take, takeWhile)
 import           System.FS.API (FsPath, HasFS (..), MountPoint (..), mkFsPath)
-import           System.FS.BlockIO.API (HasBlockIO (..), defaultIOCtxParams)
-import           System.FS.BlockIO.IO (ioHasBlockIO, withIOHasBlockIO)
+import           System.FS.BlockIO.API (HasBlockIO (..))
+import           System.FS.BlockIO.IO (defaultIOCtxParams, ioHasBlockIO,
+                     withIOHasBlockIO)
 import           System.FS.IO (HandleIO, ioHasFS)
 import           System.Random (randomIO)