wip, tombs count calculation

Makefile

@@ -71,7 +71,7 @@ symlinks: $(BIN_DIR)
 >	done
 > ln -sfn ../hbs2-git3/bf6/git-hbs2 bin/git-hbs2
 > ln -sfn ../hbs2-git3/bf6/hbs2-git bin/hbs2-git
-> ln -sfn ../bf6/hbs23 bin/hbs23
+> ln -sfn ../bf6/hbs2 bin/hbs2
 
 
 .PHONY: build

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

@@ -1252,9 +1252,14 @@ ncqFsckOne :: MonadUnliftIO m => FilePath -> m [NCQFsckIssue]
 ncqFsckOne fp = do
   mmaped <- liftIO $ mmapFileByteString fp Nothing
 
+  notice $ "file" <+> pretty (takeFileName fp) <+> pretty (BS.length mmaped)
+
   toff <- newTVarIO 0
   issuesQ <- newTQueueIO
 
+  ttombs <- newTVarIO 0
+  ttotal <- newTVarIO 0
+
   let
     emit :: forall m . MonadIO m => NCQFsckIssue -> m ()
     emit = atomically . writeTQueue issuesQ
@@ -1271,6 +1276,10 @@ ncqFsckOne fp = do
                                | prefix == ncqTombPrefix  -> (True, Just T)
                                | otherwise                -> (False, Nothing)
 
+        atomically do
+          when (prefix == ncqTombPrefix) $ modifyTVar ttombs succ
+          modifyTVar ttotal succ
+
         let contentOk = case pt of
                 Just B -> hash == hashObject @HbSync rest2
                 _      -> True
@@ -1294,6 +1303,12 @@ ncqFsckOne fp = do
   unless (fromIntegral (BS.length mmaped) == lastOff) do
     emit (NCQFsckIssue fp lastOff FsckInvalidFileSize)
 
+  tombs <- readTVarIO ttombs <&> realToFrac
+  total <- readTVarIO ttotal <&> realToFrac
+  let ttr = if total /= 0 then tombs / total else 0 :: Fixed E3
+
+  notice $ "tombs/total" <+> pretty ttr <+> pretty tombs <> "/" <> pretty total
+
   atomically $ STM.flushTQueue issuesQ
 
 

hbs2/hbs2.cabal

@@ -58,7 +58,7 @@ common shared-properties
                      , TypeFamilies
 
 
-executable hbs2
+executable hbs2-obsolete
     import:           shared-properties
     main-is:          Main.hs
     other-modules: