wip

hbs2-core/lib/HBS2/Storage/Operations/Delete.hs

@@ -23,5 +23,6 @@ deleteMerkleTree sto root =  do
       S.yield ha
 
     for_ (reverse what) $ \ha -> do
+      -- debug $ "delete" <+> pretty ha
       delBlock sto ha
 

hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs

@@ -1270,7 +1270,7 @@ ncqStorageInit_ check path = do
   ncqIndexed        <- newTVarIO mempty
   ncqMergeReq       <- newTVarIO 0
   ncqCompactReq     <- newTVarIO 0
-  ncqCompactBusy    <- newEmptyTMVarIO
+  ncqCompactBusy    <- newTMVarIO ()
   ncqFsyncNum       <- newTVarIO 0
   ncqLock           <- newTVarIO ncqLock_
 
@@ -1630,6 +1630,7 @@ ncqLinearScanForCompact ncq@NCQStorage{..} action = flip runContT pure do
 
             case HM.lookup kk state of
               Just ts | ts > timeSpecFromFilePrio p -> do
+                notice $ pretty kk <+> pretty (sz + ncqSLen)
                 atomically do
                   modifyTVar profit ( + (sz + ncqSLen) )
                   modifyTVar tombUse (HM.adjust (over _2 succ) kk)

hbs2-tests/test/TCQ.hs

@@ -243,6 +243,19 @@ main = do
 
           pure nil
 
+        entry $ bindMatch "ncq:compact:scan" $ \syn -> lift do
+
+          tcq <- case syn of
+            [ isOpaqueOf @TCQ -> Just tcq ] -> do
+              pure tcq
+
+            e -> throwIO $ BadFormException @C (mkList e)
+
+          ncq <- getNCQ tcq
+          r <- ncqLinearScanForCompact ncq (\_ _ -> none)
+
+          pure $ mkInt r
+
         entry $ bindMatch "ncq:merge" $ \syn -> lift do
 
           tcq <- case syn of