From 263347f9fca3d1f13cf407e7e0850f4fbd4cf7a7 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Sun, 13 Jul 2025 09:04:56 +0300 Subject: [PATCH] wip --- hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs index 64f21561..e72f3d42 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs @@ -388,7 +388,7 @@ ncqStorageRun2 ncq@NCQStorage2{..} = flip runContT pure do closeFd fh -- notice $ yellow "indexing" <+> pretty fname idx <- ncqRunTaskNoMatterWhat ncq (ncqIndexFile ncq (DataFile fk)) - ncqStateUpdate ncq [F 0 fk] + ncqRunTaskNoMatterWhat ncq $ ncqStateUpdate ncq [F 0 fk] -- ncqAddTrackedFile ncq (DataFile fk) nwayHashMMapReadOnly idx >>= \case Nothing -> err $ "can't open index" <+> pretty idx @@ -412,7 +412,8 @@ ncqStorageRun2 ncq@NCQStorage2{..} = flip runContT pure do mq <- newEmptyTMVarIO spawnJob $ do - merged <- ncqStorageMergeStep ncq + -- merged <- ncqStorageMergeStep ncq + let merged = True atomically $ putTMVar mq merged -- TODO: detect-dead-merge @@ -457,6 +458,8 @@ ncqStorageRun2 ncq@NCQStorage2{..} = flip runContT pure do pure w else do appendTailSection fh >> liftIO (fileSynchronise fh) + -- FIXME: slow! + liftIO (ncqStateUpdate ncq [F 0 fk]) atomically do writeTVar ncqStorageSyncReq False modifyTVar' ncqSyncNo succ @@ -758,16 +761,17 @@ ncqStateUpdate :: MonadUnliftIO m => NCQStorage2 -> [StateOP] -> m Bool ncqStateUpdate me@NCQStorage2{..} ops' = flip runContT pure $ callCC \exit -> do t1 <- fromIntegral <$> liftIO getTimeCoarse + keys0 <- readTVarIO ncqTrackedFiles <&> HPSQ.keys + ops <- for ops' $ \case f@(F _ fk) -> do - let idxFile = ncqGetFileName me (toFileName $ IndexFile fk) + -- let idxFile = ncqGetFileName me (toFileName $ IndexFile fk) let datFile = ncqGetFileName me (toFileName $ DataFile fk) - e1 <- doesFileExist idxFile e2 <- doesFileExist datFile - unless (e1 && e2) do - err $ "ncqStateUpdate invariant fail" <+> pretty idxFile <+> pretty datFile + unless e2 do + err $ "ncqStateUpdate invariant fail" <+> pretty datFile exit False ts <- liftIO (getFileStatus datFile) <&> @@ -798,7 +802,9 @@ ncqStateUpdate me@NCQStorage2{..} ops' = flip runContT pure $ callCC \exit -> do modifyTVar' ncqStateUsage (IntMap.alter doAlter k0) - pure c + k1 <- readTVar ncqTrackedFiles <&> HPSQ.keys + + pure (c && k1 /= keys0) when changed (lift $ ncqDumpCurrentState me)