wip

hbs2-git3/app/Main.hs

@@ -694,6 +694,29 @@ theDict = do
                 liftIO $ print $ pretty hash <+> pretty ssize
                 go (succ n)
 
+        entry $ bindMatch "test:reflog:index:search:binary:test:2" $ nil_ $ const $ lift do
+          r <- newTQueueIO
+          enumEntries $ \e -> do
+            let ha = GitHash $ coerce $ BS.take 20 e
+            atomically $ writeTQueue r ha
+
+          hashes <- atomically $ STM.flushTQueue r
+          liftIO $ print (length hashes)
+
+          mmaped <- listObjectIndexFiles <&> fmap fst
+                       >>= \xs -> for xs $ \x -> liftIO $  mmapFileByteString x Nothing
+
+          already_ <- newTVarIO (mempty :: HashSet GitHash)
+
+          for_ hashes $ \h -> do
+            forConcurrently_ mmaped $ \bs -> do
+              here <- readTVarIO already_ <&> HS.member h
+              unless here do
+                found <- binarySearchBS 56 ( BS.take 20 . BS.drop 4 ) (coerce h) bs
+                when (isJust found) do
+                  atomically $ modifyTVar already_ (HS.insert h)
+                  notice $ pretty h <+> "True"
+
         entry $ bindMatch "test:reflog:index:search:binary:test" $ nil_ $ const $ lift do
 
             files <- listObjectIndexFiles
@@ -738,7 +761,7 @@ theDict = do
 
           answ_ <- newEmptyTMVarIO
 
-          atomically $ writeTQueue rq  (hash,answ_)
+          atomically $ writeTQueue rq  (coerce hash, const True, answ_)
 
           answ <- atomically $ readTMVar answ_
 

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

@@ -50,9 +50,6 @@ readLogFileLBS _ action = flip fix 0 \go n -> do
 
 indexPath :: forall m . ( Git3Perks m
                         , MonadReader Git3Env m
-                        , HasClientAPI PeerAPI UNIX m
-                        , HasClientAPI RefLogAPI UNIX m
-                        , HasStorage m
                         ) => m FilePath
 indexPath = do
   reflog <- getGitRemoteKey >>= orThrow Git3ReflogNotSet
@@ -60,9 +57,6 @@ indexPath = do
 
 listObjectIndexFiles :: forall m . ( Git3Perks m
                                    , MonadReader Git3Env m
-                                   , HasClientAPI PeerAPI UNIX m
-                                   , HasClientAPI RefLogAPI UNIX m
-                                   , HasStorage m
                                    ) => m [(FilePath, Natural)]
 
 listObjectIndexFiles = do
@@ -73,13 +67,25 @@ listObjectIndexFiles = do
            z <- fileSize f  <&> fromIntegral
            pure (f,z)
 
-startReflogIndexQueryQueue :: forall m . ( Git3Perks m
+
-                                         , MonadReader Git3Env m
+
-                                         , HasClientAPI PeerAPI UNIX m
+enumEntries :: forall m . ( Git3Perks m
-                                         , HasClientAPI RefLogAPI UNIX m
+                          , MonadReader Git3Env m
-                                         , HasStorage m
+                          ) => ( BS.ByteString -> m () ) -> m ()
-                                         )
+
-                       => TQueue (GitHash, TMVar [HashRef])
+enumEntries action = do
+  files <- listObjectIndexFiles <&> fmap fst
+  forConcurrently_ files $ \f -> do
+    bs <- liftIO $ mmapFileByteString f Nothing
+    scanBS bs action
+
+startReflogIndexQueryQueue :: forall a m . ( Git3Perks m
+                                           , MonadReader Git3Env m
+                                           , HasClientAPI PeerAPI UNIX m
+                                           , HasClientAPI RefLogAPI UNIX m
+                                           , HasStorage m
+                                           )
+                       => TQueue (BS.ByteString, BS.ByteString -> a, TMVar (Maybe a))
                        -> m  ()
 
 startReflogIndexQueryQueue rq = flip runContT pure do
@@ -94,21 +100,19 @@ startReflogIndexQueryQueue rq = flip runContT pure do
   mmaped <- liftIO $ for files (liftIO . flip mmapFileByteString Nothing)
 
   forever $ liftIO do
-    (githash, answ) <- atomically $ readTQueue rq
+    (s, f, answ) <- atomically $ readTQueue rq
-
-    let s = coerce githash
 
     found <- forConcurrently mmaped $ \bs -> runMaybeT do
                -- FIXME: size-hardcodes
                w <- binarySearchBS 56 ( BS.take 20 . BS.drop 4 ) s bs
                       >>= toMPlus
 
-               let v = BS.drop ( w * 56 ) bs & BS.take 32
+               let v = BS.drop ( w * 56 ) bs
 
-               pure $ coerce @_ @HashRef v
+               pure $ f v
-
-    atomically $ writeTMVar answ ( catMaybes found )
 
+    let what = headMay (catMaybes found)
+    atomically $ writeTMVar answ what
 
 writeReflogIndex :: forall m . ( Git3Perks m
                                , MonadReader Git3Env m