From 1f589cfe5588ac0217f44bc29511072e4ec46cef Mon Sep 17 00:00:00 2001 From: voidlizard Date: Wed, 23 Jul 2025 12:35:48 +0300 Subject: [PATCH] wip --- hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs | 42 +++++++++++++++++++---- hbs2-tests/test/TestNCQ.hs | 2 +- 2 files changed, 36 insertions(+), 8 deletions(-) diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs index e9c1b1a3..6e3d04bd 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs @@ -145,6 +145,21 @@ data TrackedFile = , tfCached :: TVar (Maybe CachedEntry) } +data FactE = EmptyFact + deriving (Eq,Ord,Show,Data,Generic) + +type FactSeq = POSIXTime + +data Fact = + Fact + { factWritten :: Maybe FactSeq + , factE :: FactE + } + deriving (Eq,Ord,Show,Data,Generic) + +instance Hashable FactE +instance Hashable Fact + type TrackedFiles = Vector TrackedFile data NCQStorage2 = @@ -187,6 +202,8 @@ data NCQStorage2 = , ncqMergeTasks :: TVar Int , ncqOnRunWriteIdle :: TVar (IO ()) + , ncqFactFiles :: TVar (HashSet FileKey) + , ncqFacts :: TVar (HashSet Fact) } megabytes :: forall a . Integral a => a @@ -236,6 +253,8 @@ ncqStorageOpen2 fp upd = do ncqSweepSem <- atomically (newTSem 1) ncqMergeTasks <- newTVarIO 0 ncqOnRunWriteIdle <- newTVarIO none + ncqFactFiles <- newTVarIO mempty + ncqFacts <- newTVarIO mempty ncqReadReq <- newTQueueIO @@ -287,8 +306,8 @@ ncqNewUniqFileName me@NCQStorage2{..} pref suff = liftIO $ withSem ncqMiscSem d ncqEmptyKey :: ByteString ncqEmptyKey = BS.replicate ncqKeyLen 0 -ncqGetProbesDir :: NCQStorage2 -> FilePath -ncqGetProbesDir me = ncqGetFileName me ".probes" +ncqGetFactsDir :: NCQStorage2 -> FilePath +ncqGetFactsDir me = ncqGetWorkDir me ".facts" ncqGetNewFossilName :: MonadIO m => NCQStorage2 -> m FilePath ncqGetNewFossilName me = ncqNewUniqFileName me "fossil-" ".data" @@ -299,6 +318,11 @@ ncqGetNewStateName me = ncqNewUniqFileName me "state-" "" ncqGetNewCompactName :: MonadIO m => NCQStorage2 -> m FilePath ncqGetNewCompactName me = ncqNewUniqFileName me "compact-" ".data" +ncqGetNewFactFileName :: MonadIO m => NCQStorage2 -> m FilePath +ncqGetNewFactFileName me = do + ncqNewUniqFileName me (d "fact-") ".f" + where d = ncqGetFactsDir me + ncqStorageStop2 :: MonadUnliftIO m => NCQStorage2 -> m () ncqStorageStop2 NCQStorage2{..} = do atomically $ writeTVar ncqStorageStopReq True @@ -678,7 +702,7 @@ ncqStorageRun2 ncq@NCQStorage2{..} = flip runContT pure do when (n == n0) STM.retry - spawnActivity probesDB + spawnActivity factsDB ContT $ bracket none $ const $ liftIO do @@ -806,13 +830,13 @@ ncqStorageRun2 ncq@NCQStorage2{..} = flip runContT pure do alpha = 0.1 step = 1.00 - probesDB = do - let dir = ncqGetProbesDir ncq - debug $ yellow "probesDB started" <+> pretty dir + factsDB = do + let dir = ncqGetFactsDir ncq + debug $ yellow "factsDB started" <+> pretty dir mkdir dir forever do - debug $ yellow "probesDB wip" + debug $ yellow "factsDB wip" pause @'Seconds 10 @@ -1535,6 +1559,10 @@ ncqSweepStates me@NCQStorage2{..} = withSem ncqSweepSem $ flip runContT pure do ncqSetOnRunWriteIdle :: MonadUnliftIO m => NCQStorage2 -> IO () -> m () ncqSetOnRunWriteIdle NCQStorage2{..} io = atomically (writeTVar ncqOnRunWriteIdle io) +ncqAddFacts :: MonadUnliftIO m => NCQStorage2 -> [FactE] -> m () +ncqAddFacts me facts = do + none + writeFiltered :: forall m . MonadIO m => NCQStorage2 -> FilePath diff --git a/hbs2-tests/test/TestNCQ.hs b/hbs2-tests/test/TestNCQ.hs index e7dbbb42..1fc5a5ce 100644 --- a/hbs2-tests/test/TestNCQ.hs +++ b/hbs2-tests/test/TestNCQ.hs @@ -1781,7 +1781,7 @@ main = do e -> throwIO $ BadFormException @C (mkList e) - entry $ bindMatch "test:ncq2:probes-db1" $ nil_ $ \e -> do + entry $ bindMatch "test:ncq2:facts-db1" $ nil_ $ \e -> do notice "test:ncq2:probes-db1" runTest $ \TestEnv{..} -> do