wip

hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs

@@ -40,8 +40,10 @@ ncqStorageOpen fp upd = do
   let ncqIdleThrsh       = 50.0
   let ncqPostponeService = 20
   let ncqSweepTime       = 30.00
-  let ncqMergeTimeA      = 10.00
-  let ncqMergeTimeB      = 60.00
+  let ncqMergeTimeA      = 20.00
+  let ncqMergeTimeB      = 120.00
+  let ncqCompactTimeA    = 10.00
+  let ncqCompactTimeB    = 60.00
   let ncqSalt            = "EstEFasxrCFqsGDxcY4haFcha9e4ZHRzsPbGUmDfdxLk"
 
   cap <- getNumCapabilities
@@ -65,6 +67,7 @@ ncqStorageOpen fp upd = do
   ncqSyncReq        <- newTVarIO False
   ncqSweepReq       <- newTVarIO False
   ncqMergeReq       <- newTVarIO False
+  ncqCompactReq     <- newTVarIO False
   ncqOnRunWriteIdle <- newTVarIO none
   ncqSyncNo         <- newTVarIO 0
   ncqState          <- newTVarIO mempty

hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs

@@ -242,9 +242,11 @@ ncqStorageRun ncq@NCQStorage{..} = withSem ncqRunSem $ flip runContT pure do
 
   spawnActivity $ postponed ncqPostponeService
     $ compactLoop ncqMergeReq  ncqMergeTimeA ncqMergeTimeB $ withSem ncqServiceSem do
-        a <- ncqFossilMergeStep ncq
-        b <- ncqIndexCompactStep ncq
-        pure $ a || b
+        ncqFossilMergeStep ncq
+
+  spawnActivity $ postponed ncqPostponeService
+    $ compactLoop ncqCompactReq ncqCompactTimeA ncqCompactTimeB $ withSem ncqServiceSem do
+        ncqIndexCompactStep ncq
 
   flip fix RunNew $ \loop s -> do
     -- debug $ viaShow s
@@ -434,12 +436,14 @@ ncqStorageRun ncq@NCQStorage{..} = withSem ncqRunSem $ flip runContT pure do
       ncqClearFlag flag
       compacted <- lift what
 
-      when compacted mzero
+      when compacted do
+        ncqSetFlag ncqSweepReq
+        mzero
 
       k0 <- readTVarIO ncqStateKey
       void $ lift $ race (pause @'Seconds t2) do
         flip fix k0 $ \waitState k1 -> do
-          pause @'Seconds 60
+          pause @'Seconds t2
           k2 <- readTVarIO ncqStateKey
           when (k2 == k1) $  waitState k2
 

hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs

@@ -91,6 +91,8 @@ data NCQStorage =
   , ncqSweepTime       :: Timeout 'Seconds
   , ncqMergeTimeA      :: Timeout 'Seconds
   , ncqMergeTimeB      :: Timeout 'Seconds
+  , ncqCompactTimeA    :: Timeout 'Seconds
+  , ncqCompactTimeB    :: Timeout 'Seconds
   , ncqFsync           :: Int
   , ncqWriteQLen       :: Int
   , ncqWriteBlock      :: Int
@@ -118,6 +120,7 @@ data NCQStorage =
   , ncqSyncReq         :: TVar Bool
   , ncqSweepReq        :: TVar Bool
   , ncqMergeReq        :: TVar Bool
+  , ncqCompactReq      :: TVar Bool
   , ncqOnRunWriteIdle  :: TVar (IO ())
   , ncqSyncNo          :: TVar Int
   , ncqServiceSem      :: TSem