fix: remove traverseBlobRef

src/Database/LSMTree/Internal/Entry.hs

@@ -3,7 +3,6 @@ module Database.LSMTree.Internal.Entry (
   , hasBlob
   , onValue
   , onBlobRef
-  , traverseBlobRef
   , NumEntries (..)
   , unNumEntries
     -- * Value resolution/merging
@@ -48,17 +47,6 @@ onBlobRef def g = \case
     Mupdate{}           -> def
     Delete              -> def
 
-traverseBlobRef ::
-     Applicative t
-  => (blobref -> t blobref')
-  -> Entry v blobref
-  -> t (Entry v blobref')
-traverseBlobRef f = \case
-  Insert v -> pure (Insert v)
-  InsertWithBlob v blobref -> InsertWithBlob v <$> f blobref
-  Mupdate v -> pure (Mupdate v)
-  Delete -> pure Delete
-
 instance Bifunctor Entry where
   first f = \case
       Insert v            -> Insert (f v)

src/Database/LSMTree/Internal/Paths.hs

@@ -30,9 +30,8 @@ module Database.LSMTree.Internal.Paths (
   , toChecksumsFile
   , fromChecksumsFile
     -- * Checksums for WriteBuffer files
-  , checksumFileNamesForWriteBufferFiles
   , toChecksumsFileForWriteBufferFiles
-  , fromChecksumsFileForWriteBufferFiles
+  -- , fromChecksumsFileForWriteBufferFiles
     -- * ForRunFiles abstraction
   , ForKOps (..)
   , ForBlob (..)
@@ -45,16 +44,16 @@ module Database.LSMTree.Internal.Paths (
   , forRunIndexRaw
     -- * WriteBuffer paths
   , WriteBufferFsPaths (WrapRunFsPaths, WriteBufferFsPaths, writeBufferDir, writeBufferNumber)
-  , pathsForWriteBufferFiles
+  -- , pathsForWriteBufferFiles
   , writeBufferKOpsPath
   , writeBufferBlobPath
   , writeBufferChecksumsPath
   , writeBufferFilePathWithExt
-    -- * ForWriteBufferFiles abstraction
-  , ForWriteBufferFiles (..)
-  , forWriteBufferKOpsRaw
-  , forWriteBufferBlobRaw
-  , writeBufferFileExts
+  --   -- * ForWriteBufferFiles abstraction
+  -- , ForWriteBufferFiles (..)
+  -- , forWriteBufferKOpsRaw
+  -- , forWriteBufferBlobRaw
+  -- , writeBufferFileExts
   ) where
 
 import           Control.Applicative (Applicative (..))
@@ -72,6 +71,8 @@ import           Prelude hiding (Applicative (..))
 import qualified System.FilePath.Posix
 import qualified System.FilePath.Windows
 import           System.FS.API
+import Data.Bifunctor (Bifunctor(..))
+import Data.Function ((&))
 
 
 
@@ -228,7 +229,7 @@ runFileExts = ForRunFiles {
     }
 
 {-------------------------------------------------------------------------------
-  Checksums
+  Checksums For Run Files
 -------------------------------------------------------------------------------}
 
 checksumFileNamesForRunFiles :: ForRunFiles CRC.ChecksumsFileName
@@ -243,18 +244,6 @@ fromChecksumsFile file = for checksumFileNamesForRunFiles $ \name ->
       Just crc -> Right crc
       Nothing  -> Left ("key not found: " <> show name)
 
-checksumFileNamesForWriteBufferFiles :: ForWriteBufferFiles CRC.ChecksumsFileName
-checksumFileNamesForWriteBufferFiles = fmap (CRC.ChecksumsFileName . BS.pack) writeBufferFileExts
-
-toChecksumsFileForWriteBufferFiles :: ForWriteBufferFiles CRC.CRC32C -> CRC.ChecksumsFile
-toChecksumsFileForWriteBufferFiles = Map.fromList . toList . liftA2 (,) checksumFileNamesForWriteBufferFiles
-
-fromChecksumsFileForWriteBufferFiles :: CRC.ChecksumsFile -> Either String (ForWriteBufferFiles CRC.CRC32C)
-fromChecksumsFileForWriteBufferFiles file = for checksumFileNamesForWriteBufferFiles $ \name ->
-    case Map.lookup name file of
-      Just crc -> Right crc
-      Nothing  -> Left ("key not found: " <> show name)
-
 {-------------------------------------------------------------------------------
   Marker newtypes for individual elements of the ForRunFiles and the
   ForWriteBufferFiles abstractions
@@ -314,15 +303,17 @@ pattern WriteBufferFsPaths {writeBufferDir, writeBufferNumber} = WrapRunFsPaths
 
 {-# COMPLETE WriteBufferFsPaths #-}
 
--- | Paths to all files associated with this run, except 'runChecksumsPath'.
-pathsForWriteBufferFiles :: WriteBufferFsPaths -> ForWriteBufferFiles FsPath
-pathsForWriteBufferFiles fsPaths = fmap (writeBufferFilePathWithExt fsPaths) writeBufferFileExts
+writeBufferKOpsExt :: String
+writeBufferKOpsExt = unForKOps . forRunKOps $ runFileExts
+
+writeBufferBlobExt :: String
+writeBufferBlobExt = unForBlob . forRunBlob $ runFileExts
 
 writeBufferKOpsPath :: WriteBufferFsPaths -> FsPath
-writeBufferKOpsPath = unForKOps . forWriteBufferKOps . pathsForWriteBufferFiles
+writeBufferKOpsPath = flip writeBufferFilePathWithExt writeBufferKOpsExt
 
 writeBufferBlobPath :: WriteBufferFsPaths -> FsPath
-writeBufferBlobPath = unForBlob . forWriteBufferBlob . pathsForWriteBufferFiles
+writeBufferBlobPath = flip writeBufferFilePathWithExt writeBufferBlobExt
 
 writeBufferChecksumsPath :: WriteBufferFsPaths -> FsPath
 writeBufferChecksumsPath = flip writeBufferFilePathWithExt "checksums"
@@ -331,28 +322,16 @@ writeBufferFilePathWithExt :: WriteBufferFsPaths -> String -> FsPath
 writeBufferFilePathWithExt (WriteBufferFsPaths dir n) ext =
     dir </> mkFsPath [show n] <.> ext
 
-writeBufferFileExts :: ForWriteBufferFiles String
-writeBufferFileExts = ForWriteBufferFiles
-  { forWriteBufferKOps = forRunKOps runFileExts
-  , forWriteBufferBlob = forRunBlob runFileExts
-  }
 
 {-------------------------------------------------------------------------------
-  ForWriteBuffer abstraction
+  Checksums For Run Files
 -------------------------------------------------------------------------------}
 
--- | Stores someting for each run file (except the checksums file), allowing to
--- easily do something for all of them without mixing them up.
-data ForWriteBufferFiles a = ForWriteBufferFiles { forWriteBufferKOps :: !(ForKOps a), forWriteBufferBlob :: !(ForBlob a) }
-    deriving stock (Show, Foldable, Functor, Traversable)
-
-forWriteBufferKOpsRaw :: ForWriteBufferFiles a -> a
-forWriteBufferKOpsRaw = unForKOps . forWriteBufferKOps
-
-forWriteBufferBlobRaw :: ForWriteBufferFiles a -> a
-forWriteBufferBlobRaw = unForBlob . forWriteBufferBlob
-
-instance Applicative ForWriteBufferFiles where
-  pure x = ForWriteBufferFiles (ForKOps x) (ForBlob x)
-  ForWriteBufferFiles (ForKOps f1) (ForBlob f2) <*> ForWriteBufferFiles (ForKOps x1) (ForBlob x2) =
-    ForWriteBufferFiles (ForKOps $ f1 x1) (ForBlob $ f2 x2)
+toChecksumsFileForWriteBufferFiles :: (ForKOps CRC.CRC32C, ForBlob CRC.CRC32C) -> CRC.ChecksumsFile
+toChecksumsFileForWriteBufferFiles checksums =
+  Map.fromList . toList $ checksums & bimap
+    ((toChecksumsFileName writeBufferKOpsExt,) . unForKOps)
+    ((toChecksumsFileName writeBufferBlobExt,) . unForBlob)
+  where
+    toChecksumsFileName :: String -> CRC.ChecksumsFileName
+    toChecksumsFileName = CRC.ChecksumsFileName . BS.pack

src/Database/LSMTree/Internal/WriteBufferWriter.hs

@@ -25,11 +25,7 @@ import           Database.LSMTree.Internal.Entry (Entry)
 import           Database.LSMTree.Internal.PageAcc (PageAcc)
 import qualified Database.LSMTree.Internal.PageAcc as PageAcc
 import qualified Database.LSMTree.Internal.PageAcc1 as PageAcc
-import           Database.LSMTree.Internal.Paths (ForWriteBufferFiles (..),
-                     WriteBufferFsPaths, forWriteBufferBlobRaw,
-                     forWriteBufferKOpsRaw, pathsForWriteBufferFiles,
-                     toChecksumsFileForWriteBufferFiles,
-                     writeBufferChecksumsPath)
+import           Database.LSMTree.Internal.Paths (WriteBufferFsPaths, writeBufferChecksumsPath, ForKOps (..), ForBlob (..), writeBufferKOpsPath, writeBufferBlobPath, toChecksumsFileForWriteBufferFiles)
 import           Database.LSMTree.Internal.RawOverflowPage (RawOverflowPage)
 import           Database.LSMTree.Internal.RawPage (RawPage)
 import           Database.LSMTree.Internal.Serialise (SerialisedKey,
@@ -78,7 +74,8 @@ data WriteBufferWriter m h = WriteBufferWriter
     -- | The byte offset within the blob file for the next blob to be written.
     writerBlobOffset :: !(PrimVar (PrimState m) Word64),
     -- | The (write mode) file handles.
-    writerHandles    :: !(ForWriteBufferFiles (ChecksumHandle (PrimState m) h)),
+    writerKOpsHandle :: !(ForKOps (ChecksumHandle (PrimState m) h)),
+    writerBlobHandle :: !(ForBlob (ChecksumHandle (PrimState m) h)),
     writerHasFS      :: !(HasFS m h),
     writerHasBlockIO :: !(HasBlockIO m h)
   }
@@ -104,8 +101,8 @@ new ::
 new hfs hbio fsPaths = do
   writerPageAcc <- ST.stToIO PageAcc.newPageAcc
   writerBlobOffset <- newPrimVar 0
-  writerHandles <-
-    traverse (makeHandle hfs) (pathsForWriteBufferFiles fsPaths)
+  writerKOpsHandle <- ForKOps <$> makeHandle hfs (writeBufferKOpsPath fsPaths)
+  writerBlobHandle <- ForBlob <$> makeHandle hfs (writeBufferBlobPath fsPaths)
   return WriteBufferWriter
     { writerFsPaths    = fsPaths,
       writerHasFS      = hfs,
@@ -134,16 +131,19 @@ unsafeFinalise ::
 unsafeFinalise dropCaches WriteBufferWriter {..} = do
   -- write final bits
   mPage <- ST.stToIO $ flushPageIfNonEmpty writerPageAcc
-  for_ mPage $ writeRawPage writerHasFS (forWriteBufferKOps writerHandles)
-  checksums <- toChecksumsFileForWriteBufferFiles <$> traverse readChecksum writerHandles
+  for_ mPage $ writeRawPage writerHasFS writerKOpsHandle
+  kOpsChecksum <- traverse readChecksum writerKOpsHandle
+  blobChecksum <- traverse readChecksum writerBlobHandle
+  let checksums = toChecksumsFileForWriteBufferFiles (kOpsChecksum, blobChecksum)
   FS.withFile writerHasFS (writeBufferChecksumsPath writerFsPaths) (FS.WriteMode FS.MustBeNew) $ \h -> do
     CRC.writeChecksumsFile' writerHasFS h checksums
     FS.hDropCacheAll writerHasBlockIO h
   -- drop the KOps and blobs files from the cache if asked for
   when dropCaches $ do
-    dropCache writerHasBlockIO (forWriteBufferKOpsRaw writerHandles)
-    dropCache writerHasBlockIO (forWriteBufferBlobRaw writerHandles)
-  for_ writerHandles $ closeHandle writerHasFS
+    dropCache writerHasBlockIO (unForKOps writerKOpsHandle)
+    dropCache writerHasBlockIO (unForBlob writerBlobHandle)
+  closeHandle writerHasFS (unForKOps writerKOpsHandle)
+  closeHandle writerHasFS (unForBlob writerBlobHandle)
   return (writerHasFS, writerHasBlockIO, writerFsPaths)
 
 
@@ -163,16 +163,16 @@ addKeyOp ::
   -> m ()
 addKeyOp WriteBufferWriter{..} key op = do
   -- TODO: consider optimisation described in 'Database.LSMTree.Internal.RunBuilder.addKeyOp'.
-  op' <- traverse (copyBlob writerHasFS writerBlobOffset (forWriteBufferBlob writerHandles)) op
+  op' <- traverse (copyBlob writerHasFS writerBlobOffset writerBlobHandle) op
   if PageAcc.entryWouldFitInPage key op
     then do
       mPage <- ST.stToIO $ addSmallKeyOp writerPageAcc key op'
-      for_ mPage $ writeRawPage writerHasFS (forWriteBufferKOps writerHandles)
+      for_ mPage $ writeRawPage writerHasFS writerKOpsHandle
     else do
       (pages, overflowPages) <- ST.stToIO $ addLargeKeyOp writerPageAcc key op'
       -- TODO: consider optimisation described in 'Database.LSMTree.Internal.RunBuilder.addKeyOp'.
-      for_ pages $ writeRawPage writerHasFS (forWriteBufferKOps writerHandles)
-      writeRawOverflowPages writerHasFS (forWriteBufferKOps writerHandles) overflowPages
+      for_ pages $ writeRawPage writerHasFS writerKOpsHandle
+      writeRawOverflowPages writerHasFS writerKOpsHandle overflowPages
 
 -- | See 'Database.LSMTree.Internal.RunAcc.addSmallKeyOp'.
 addSmallKeyOp ::