From 3e62d03c9bce26dfce7335b63365f05a50117e67 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Sun, 8 Oct 2023 06:01:14 +0300
Subject: [PATCH] fix bug-git-new-branches-on-second-run

---
 docs/devlog.md                     |  9 ++++++
 hbs2-git/git-hbs2/GitRemoteMain.hs | 46 ++++++++++++++++--------------
 2 files changed, 34 insertions(+), 21 deletions(-)

diff --git a/docs/devlog.md b/docs/devlog.md
index 0ecb5a23..a1b992ae 100644
--- a/docs/devlog.md
+++ b/docs/devlog.md
@@ -1,3 +1,12 @@
+## 2023-10-08
+
+Конечно, грустно, что девлог превратился в черти-что.
+С другой стороны, его можно вывести на новый уровень,
+положив начало dashboard-у.
+
+Продолжаем отлаживать странную проблему, когда гит
+выводит новые референсы только со второй попытки.
+
 ## 2023-10-05
 
 что такое опять
diff --git a/hbs2-git/git-hbs2/GitRemoteMain.hs b/hbs2-git/git-hbs2/GitRemoteMain.hs
index 9d5f66f7..7fe106dd 100644
--- a/hbs2-git/git-hbs2/GitRemoteMain.hs
+++ b/hbs2-git/git-hbs2/GitRemoteMain.hs
@@ -111,14 +111,32 @@ loop args = do
     liftIO $ runApp WithLog (runExport Nothing ref)
     importRefLogNew True ref
 
-  refsNew <- withDB db stateGetActualRefs
-  let possibleHead = listToMaybe $ List.take 1 $ List.sortOn guessHead (fmap fst refsNew)
+  let getHeads upd = do
+        when upd do importRefLogNew False ref
+        refsNew <- withDB db stateGetActualRefs
+        let possibleHead = listToMaybe $ List.take 1 $ List.sortOn guessHead (fmap fst refsNew)
 
-  let hd = refsNew & LBS.pack . show
-                              . pretty
-                              . AsGitRefsFile
-                              . RepoHead possibleHead
-                              . HashMap.fromList
+        let hd = refsNew & LBS.pack . show
+                                    . pretty
+                                    . AsGitRefsFile
+                                    . RepoHead possibleHead
+                                    . HashMap.fromList
+        pure hd
+
+
+  hd <- getHeads True
+
+  refs <- withDB db stateGetActualRefs
+
+  let heads = [ h | h@GitHash{} <- universeBi refs ]
+
+  missed <- try (mapM (gitReadObject Nothing) heads) <&> either (\(_::SomeException) -> True) (const False)
+
+  let force = missed || List.null heads
+
+  when force do
+  -- sync state first
+    traceTime "TIMING: importRefLogNew" $ importRefLogNew True ref
 
   batch <- liftIO $ newTVarIO False
 
@@ -149,19 +167,16 @@ loop args = do
           next
 
       ["list"] -> do
-        importRefLogNew False ref
         for_ (LBS.lines hd) (sendLn . LBS.toStrict)
         sendEol
         next
 
       ["list","for-push"] -> do
-        importRefLogNew False ref
         for_ (LBS.lines hd) (sendLn . LBS.toStrict)
         sendEol
         next
 
       ["fetch", sha1, x] -> do
-        importRefLogNew False ref
         trace $ "fetch" <+> pretty (BS.unpack sha1) <+> pretty (BS.unpack x)
         liftIO $ atomically $ writeTVar batch True
         -- sendEol
@@ -181,17 +196,6 @@ loop args = do
 
       other -> die $ show other
 
-  refs <- withDB db stateGetActualRefs
-
-  let heads = [ h | h@GitHash{} <- universeBi refs ]
-
-  missed <- try (mapM (gitReadObject Nothing) heads) <&> either (\(_::SomeException) -> True) (const False)
-
-  let force = missed || List.null heads
-
-  when force do
-  -- sync state first
-    traceTime "TIMING: importRefLogNew" $ importRefLogNew True ref
 
     shutUp