fix bug-git-new-branches-on-second-run

docs/devlog.md

@@ -1,3 +1,12 @@
+## 2023-10-08
+
+Конечно, грустно, что девлог превратился в черти-что.
+С другой стороны, его можно вывести на новый уровень,
+положив начало dashboard-у.
+
+Продолжаем отлаживать странную проблему, когда гит
+выводит новые референсы только со второй попытки.
+
 ## 2023-10-05
 
 что такое опять

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 getHeads upd = do
-  let possibleHead = listToMaybe $ List.take 1 $ List.sortOn guessHead (fmap fst refsNew)
+        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
+        let hd = refsNew & LBS.pack . show
-                              . pretty
+                                    . pretty
-                              . AsGitRefsFile
+                                    . AsGitRefsFile
-                              . RepoHead possibleHead
+                                    . RepoHead possibleHead
-                              . HashMap.fromList
+                                    . 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