index:now and merge:now flags

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

@@ -406,10 +406,11 @@ ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do
   writer      <- makeWriter indexQ
   indexer     <- makeIndexer writer indexQ
   merge       <- makeMerge
+  flagWatcher <- makeFlagWatcher
 
   mapM_ waitCatch [writer,indexer,merge]
   -- mapM_ waitCatch [writer,indexer,refsWriter] -- ,indexer,refsWriter]
-  mapM_ cancel  [reader]
+  mapM_ cancel  [reader,flagWatcher]
 
   where
 
@@ -425,6 +426,27 @@ ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do
         s <- readTVar ncqStopped
         unless s STM.retry
 
+
+    makeFlagWatcher = do
+      let flags = ncqGetFileName ncq ".flags"
+      let needIndexFlag = flags </> "index:now"
+      let needMergeFlag = flags </> "merge:now"
+
+      ContT $ withAsync $ fix \again -> do
+        pause @'Seconds 1
+        needIndex <- doesPathExist needIndexFlag
+        needMerge <- doesPathExist needMergeFlag
+
+        when needIndex do
+          rm needIndexFlag
+          ncqIndexRightNow ncq
+
+        when needMerge do
+          rm needMergeFlag
+          ncqStorageMerge ncq
+
+        again
+
     makeReader = do
       cap <- getNumCapabilities
       reader <- ContT $ withAsync $ untilStopped do
@@ -1035,6 +1057,10 @@ ncqStorageOpen fp' = do
 
       ncq@NCQStorage{..} <- ncqStorageInit_ False fp
 
+      let flagz = ncqGetFileName ncq ".flags"
+
+      mkdir flagz
+
       ncqReadTrackedFiles ncq
       ncqFixIndexes ncq
       ncqLoadIndexes ncq