wip, merge storage

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

@@ -403,7 +403,16 @@ ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do
     makeMerge = do
       me <- ContT $ withAsync $ untilStopped do
         micropause @'Seconds 10
-        debug "MERGE THREAD"
+        req <- readTVarIO ncqMergeReq
+
+        when (req > 0) do
+          debug $ "STARTED MERGE" <+> pretty req
+
+          try @_ @SomeException (ncqStorageMergeStep ncq) >>= \case
+            Right{} -> none
+            Left e -> err ("MERGE ERROR:" <+> viaShow e)
+
+          atomically $ writeTVar ncqMergeReq 0
 
       link me
       pure me

hbs2-tests/test/TCQ.hs

@@ -221,6 +221,19 @@ main = do
 
           pure nil
 
+        entry $ bindMatch "ncq:merge" $ \syn -> lift do
+
+          tcq <- case syn of
+            [ isOpaqueOf @TCQ -> Just tcq ] -> do
+              pure tcq
+
+            e -> throwIO $ BadFormException @C (mkList e)
+
+          ncq <- getNCQ tcq
+          ncqStorageMerge ncq
+
+          pure nil
+
         entry $ bindMatch "ncq:close" $ nil_ \case
           [ isOpaqueOf @TCQ -> Just tcq ] -> lift do
             ncq <- getNCQ tcq