wip, fixed merge

O(E(K)) > O(ENTRY) => skip entry

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

@@ -203,12 +203,6 @@ ncqTryLoadState me@NCQStorage3{..} = do
       pure True
 
 
-ncqTombEntrySize :: NCQSize
-ncqTombEntrySize = ncqSLen + ncqKeyLen + ncqPrefixLen
-
-ncqIsTombEntrySize :: Integral a => a -> Bool
-ncqIsTombEntrySize s = fromIntegral s <= ncqTombEntrySize
-{-# INLINE ncqIsTombEntrySize #-}
 
 ncqEntryUnwrap :: ByteString
                -> (ByteString, Either ByteString (NCQSectionType, ByteString))

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

@@ -53,7 +53,7 @@ ncqFossilMergeStep me@NCQStorage3{..}  = withSem ncqServiceSem $ flip runContT p
 
   r@(sumSize, f1, f2) <- ContT $ maybe1 r' (pure False)
 
-  debug $ "for compacting" <+> pretty f1 <+> pretty f2  <+> pretty r <+> pretty ncqMaxLog
+  debug $ yellow "for compacting" <+> pretty f1 <+> pretty f2  <+> pretty r <+> pretty ncqMaxLog
 
   when (fromIntegral sumSize > ncqMaxLog) $ exit False
 
@@ -75,13 +75,21 @@ ncqFossilMergeStep me@NCQStorage3{..}  = withSem ncqServiceSem $ flip runContT p
         ncqLocate_ False me k >>= \case
           Nothing  -> pure False
           Just (InMemory{}) -> pure False
-          Just (InFossil fk o1 _) -> do
-            let skip = fk > fik || (fk == fik && o1 < fromIntegral o)
+          Just (InFossil fk oi si) -> do
+            let skip = fk > fik || (fk == fik && o < fromIntegral oi)
             let beWritten = not skip
+
+            -- let c = if skip then green else id
+            -- when (si == ncqTombEntrySize) do
+            --   debug $ red "fucking TOMB found!"
+            --               <+> pretty k
+            --               <+> viaShow (fk, oi, fik, o)
+            --               <+> "write" <+> c (pretty beWritten)
+
             atomically do
               here <- readTVar already <&> HS.member k
               let proceed = not here && beWritten
-              when proceed (modifyTVar already (HS.insert k))
+              modifyTVar already (HS.insert k)
               pure proceed
 
     appendTailSection fd

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

@@ -94,29 +94,28 @@ ncqStorageRun3 ncq@NCQStorage3{..} = flip runContT pure do
 
   -- spawnActivity (ncqStateUpdateLoop ncq)
 
-  spawnActivity $ postponed 10 $ forever do
-
-    ema <- readTVarIO ncqWriteEMA
-
-    when ( ema < ncqIdleThrsh ) do
-      ncqSweepObsoleteStates ncq
-
-    -- FIXME: timeout-hardcode
-    pause @'Seconds 60
-
   spawnActivity $ forever do
     pause @'Seconds 30
     ema <- readTVarIO ncqWriteEMA
     debug $ "EMA" <+> pretty (realToFrac @_ @(Fixed E3) ema)
 
   spawnActivity $ postponed 10 $ forever do
-    ema <- readTVarIO ncqWriteEMA
+    lsInit <- ncqLiveKeys ncq <&> HS.size
+    void $ race (pause @'Seconds 60) do
+      flip fix lsInit $ \next ls0 -> do
+        (lsA,lsB) <- atomically do
+          ema <- readTVar ncqWriteEMA
+          ls1 <- ncqLiveKeysSTM ncq <&> HS.size
 
-    when ( ema < ncqIdleThrsh ) do
+          if  ls1 /= ls0 && ema < ncqIdleThrsh then
+            pure (ls0,ls1)
+          else
+            STM.retry
+
+        debug $ "do sweep" <+> pretty lsA <+> pretty lsB
+        ncqSweepObsoleteStates ncq
         ncqSweepFiles ncq
-
-    -- FIXME: timeout-hardcode
-    pause @'Seconds 60
+        next lsB
 
   spawnActivity $ postponed 10 $ compactLoop 10 300 do
     ncqIndexCompactStep ncq

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

@@ -15,15 +15,17 @@ import System.Posix.Files qualified as PFS
 import Control.Monad.Trans.Maybe
 import Data.HashMap.Strict qualified as HM
 
-ncqLiveKeys :: forall m . MonadUnliftIO m => NCQStorage3 -> m (HashSet FileKey)
-ncqLiveKeys NCQStorage3{..} = do
+ncqLiveKeysSTM :: NCQStorage3 -> STM (HashSet FileKey)
+ncqLiveKeysSTM NCQStorage3{..} = do
 
-  merged <- atomically do
   s0     <- readTVar ncqState
-    readTVar ncqStateUse <&> (s0<>) . foldMap fst . HM.elems
+  merged <- readTVar ncqStateUse <&> (s0<>) . foldMap fst . HM.elems
 
   pure $ HS.fromList $ universeBi @_ @FileKey merged
 
+ncqLiveKeys :: forall m . MonadIO m => NCQStorage3 -> m (HashSet FileKey)
+ncqLiveKeys  ncq = atomically $ ncqLiveKeysSTM  ncq
+
 ncqSweepFiles :: forall m . MonadUnliftIO m => NCQStorage3 -> m ()
 ncqSweepFiles me@NCQStorage3{..} = withSem ncqServiceSem do
 

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

@@ -190,3 +190,12 @@ instance Pretty NCQState where
 
       pf (P (PData (DataFile a) s)) = "fp" <+> pretty a <+> pretty s
 
+
+
+ncqTombEntrySize :: NCQSize
+ncqTombEntrySize = ncqSLen + ncqKeyLen + ncqPrefixLen
+
+ncqIsTombEntrySize :: Integral a => a -> Bool
+ncqIsTombEntrySize s = fromIntegral s <= ncqTombEntrySize
+{-# INLINE ncqIsTombEntrySize #-}
+

hbs2-tests/test/NCQ3.hs

@@ -389,7 +389,7 @@ ncq3Tests = do
 
         let tnum = sum [ 1 | x <- tombs, x ]
 
-        notice $ "should be deleted" <+> pretty (HS.size deleted) <+> "/" <+> pretty tnum
+        notice $ "should be deleted" <+> pretty (HS.size deleted) <+> "/" <+> pretty tnum <+> "of" <+> pretty n
 
       ncqWithStorage3 dir $ \sto@NCQStorage3{..} -> do