wip

hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs

@@ -71,12 +71,13 @@ ncqFossilMergeStep me@NCQStorage3{..}  = withSem ncqServiceSem $ flip runContT p
 
     for_ [f1, f2] $ \fi -> do
       let fik = coerce fi
-      writeFiltered me (ncqGetFileName me fi) fd $ \_ _ k _ -> do
+      writeFiltered me (ncqGetFileName me fi) fd $ \o _ k _ -> do
         ncqLocate_ False me k >>= \case
           Nothing  -> pure False
           Just (InMemory{}) -> pure False
-          Just (InFossil fk _ _) -> do
+          Just (InFossil fk o1 _) -> do
-            let beWritten = fik >= fk
+            let skip = fk > fik || (fk == fik && o1 < fromIntegral o)
+            let beWritten = not skip
             atomically do
               here <- readTVar already <&> HS.member k
               let proceed = not here && beWritten
@@ -118,8 +119,8 @@ writeFiltered ncq fn out filt = do
   ncqStorageScanDataFile ncq fn $ \o s k v -> do
     skip <- filt o s k v <&> not
 
-    when skip do
+    -- when skip do
-      debug $ pretty k <+> pretty "skipped"
+    --   debug $ pretty k <+> pretty "skipped"
 
     unless skip $ liftIO do
       void $ appendSection out (LBS.toStrict (makeEntryLBS k v))

hbs2-tests/test/NCQ3.hs

@@ -364,7 +364,7 @@ ncq3Tests = do
 
       let (_, argz) = splitOpts [] syn
       let n = headDef 50000 [ fromIntegral x | LitIntVal x <- argz ]
-      let p0 = headDef 0.25  [ realToFrac x   | LitScientificVal x <- drop 1 argz ]
+      let p0 = headDef 0.55  [ realToFrac x   | LitScientificVal x <- drop 1 argz ]
 
       thashes <- newTVarIO mempty
 
@@ -391,19 +391,20 @@ ncq3Tests = do
 
         notice $ "should be deleted" <+> pretty (HS.size deleted) <+> "/" <+> pretty tnum
 
-        t0 <- getTimeCoarse
+      ncqWithStorage3 dir $ \sto@NCQStorage3{..} -> do
 
-        ncqIndexCompactFull sto
+        notice "wait for compaction"
-        -- ncqCompactStep sto
 
-        t1 <- getTimeCoarse
+        flip runContT pure do
 
-        let dt = timeSpecDeltaSeconds @(Fixed E6) t0 t1
+          void $ ContT $ withAsync $ forever do
-
+            fs <- dirFiles (ncqGetWorkDir sto)
-        notice $ "ncqCompactStep time" <+> pretty dt
+            let n = List.length fs
-
+            ss <- sum <$> mapM getFileSize fs
-      none
+            notice $ "dir size" <+> pretty n <+> pretty (ss `div` megabytes)
+            pause @'Seconds 20
 
+          pause @'Seconds 600
 
 testNCQ3Concurrent1 :: MonadUnliftIO m
          => Bool