wtf/wip

hbs2-git3/lib/HBS2/Git3/State/Index.hs

@@ -18,6 +18,7 @@ import Data.Maybe
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
 
+import Control.Concurrent.STM qualified as STM
 import Codec.Compression.Zstd.Lazy qualified as ZstdL
 import Streaming.Prelude qualified as S
 import Streaming hiding (run,chunksOf)
@@ -101,27 +102,13 @@ startReflogIndexQueryQueue rq = flip runContT pure do
 
   mmaped <- liftIO $ for files (liftIO . flip mmapFileByteString Nothing)
 
-  -- r <- newTVarIO (mempty :: HashMap N.ByteString N.ByteString)
-
-  -- -- FIXME: may-explode
-  -- liftIO $ forConcurrently_ mmaped $ \bs -> do
-  --   scanBS bs $ \segment -> do
-  --     let ha = BS.take 20 segment & coerce
-  --     atomically $ modifyTVar r (HM.insert ha segment)
-
-  -- forever do
-  --   (s, f, answ) <- atomically $ readTQueue rq
-  --   found <- readTVarIO r <&> HM.lookup s
-
-  --   atomically do
-  --     case found of
-  --       Nothing -> writeTMVar answ Nothing
-  --       Just x  -> writeTMVar answ (Just (f x))
-
   forever $ liftIO do
-    (s, f, answ) <- atomically $ readTQueue rq
+    requests <- atomically do
+                   _ <- peekTQueue rq
+                   STM.flushTQueue rq
 
-    found <- forConcurrently mmaped $ \bs -> runMaybeT do
+    for_ requests $ \(s,f,answ) -> do
+      found <- for mmaped $ \bs -> runMaybeT do
                  -- FIXME: size-hardcodes
                  w <- binarySearchBS 56 ( BS.take 20 . BS.drop 4 ) s bs
                         >>= toMPlus