voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip

This commit is contained in:
voidlizard 2025-07-13 09:04:56 +03:00
parent 2f77530e60
commit 263347f9fc
1 changed files with 13 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs
View File

@ -388,7 +388,7 @@ ncqStorageRun2 ncq@NCQStorage2{..} = flip runContT pure do
closeFd fh closeFd fh
-- notice $ yellow "indexing" <+> pretty fname -- notice $ yellow "indexing" <+> pretty fname
idx <- ncqRunTaskNoMatterWhat ncq (ncqIndexFile ncq (DataFile fk)) idx <- ncqRunTaskNoMatterWhat ncq (ncqIndexFile ncq (DataFile fk))
ncqStateUpdate ncq [F 0 fk] ncqRunTaskNoMatterWhat ncq $ ncqStateUpdate ncq [F 0 fk]
-- ncqAddTrackedFile ncq (DataFile fk) -- ncqAddTrackedFile ncq (DataFile fk)
nwayHashMMapReadOnly idx >>= \case nwayHashMMapReadOnly idx >>= \case
Nothing -> err $ "can't open index" <+> pretty idx Nothing -> err $ "can't open index" <+> pretty idx
@ -412,7 +412,8 @@ ncqStorageRun2 ncq@NCQStorage2{..} = flip runContT pure do
mq <- newEmptyTMVarIO mq <- newEmptyTMVarIO
spawnJob $ do spawnJob $ do
merged <- ncqStorageMergeStep ncq -- merged <- ncqStorageMergeStep ncq
let merged = True
atomically $ putTMVar mq merged atomically $ putTMVar mq merged
-- TODO: detect-dead-merge -- TODO: detect-dead-merge
@ -457,6 +458,8 @@ ncqStorageRun2 ncq@NCQStorage2{..} = flip runContT pure do
pure w pure w
else do else do
appendTailSection fh >> liftIO (fileSynchronise fh) appendTailSection fh >> liftIO (fileSynchronise fh)
-- FIXME: slow!
liftIO (ncqStateUpdate ncq [F 0 fk])
atomically do atomically do
writeTVar ncqStorageSyncReq False writeTVar ncqStorageSyncReq False
modifyTVar' ncqSyncNo succ modifyTVar' ncqSyncNo succ
@ -758,16 +761,17 @@ ncqStateUpdate :: MonadUnliftIO m => NCQStorage2 -> [StateOP] -> m Bool
ncqStateUpdate me@NCQStorage2{..} ops' = flip runContT pure $ callCC \exit -> do ncqStateUpdate me@NCQStorage2{..} ops' = flip runContT pure $ callCC \exit -> do
t1 <- fromIntegral <$> liftIO getTimeCoarse t1 <- fromIntegral <$> liftIO getTimeCoarse
keys0 <- readTVarIO ncqTrackedFiles <&> HPSQ.keys
ops <- for ops' $ \case ops <- for ops' $ \case
f@(F _ fk) -> do 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) let datFile = ncqGetFileName me (toFileName $ DataFile fk)
e1 <- doesFileExist idxFile
e2 <- doesFileExist datFile e2 <- doesFileExist datFile
unless (e1 && e2) do unless e2 do
err $ "ncqStateUpdate invariant fail" <+> pretty idxFile <+> pretty datFile err $ "ncqStateUpdate invariant fail" <+> pretty datFile
exit False exit False
ts <- liftIO (getFileStatus datFile) <&> ts <- liftIO (getFileStatus datFile) <&>
@ -798,7 +802,9 @@ ncqStateUpdate me@NCQStorage2{..} ops' = flip runContT pure $ callCC \exit -> do
modifyTVar' ncqStateUsage (IntMap.alter doAlter k0) modifyTVar' ncqStateUsage (IntMap.alter doAlter k0)
pure c k1 <- readTVar ncqTrackedFiles <&> HPSQ.keys
pure (c && k1 /= keys0)
when changed (lift $ ncqDumpCurrentState me) when changed (lift $ ncqDumpCurrentState me)