From 129641a5f5fa12103d02569fffd2e43a43203959 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Sun, 21 Apr 2024 08:49:00 +0300
Subject: [PATCH] wip

---
 hbs2-git/hbs2-git-dashboard/GitDashBoard.hs   | 22 +++++++++++--------
 .../src/HBS2/Git/Web/Html/Root.hs             |  4 ++--
 2 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/hbs2-git/hbs2-git-dashboard/GitDashBoard.hs b/hbs2-git/hbs2-git-dashboard/GitDashBoard.hs
index 09b33cc3..02cfe522 100644
--- a/hbs2-git/hbs2-git-dashboard/GitDashBoard.hs
+++ b/hbs2-git/hbs2-git-dashboard/GitDashBoard.hs
@@ -13,6 +13,8 @@ import HBS2.Polling
 import HBS2.Peer.RPC.API.Storage
 import HBS2.Peer.RPC.Client.StorageClient
 
+import HBS2.Git.Data.Tx.Git
+import HBS2.Git.Data.RepoHead
 import HBS2.Git.Local
 import HBS2.Git.Local.CLI
 
@@ -212,7 +214,7 @@ runDashboardWeb wo = do
                  <&> listToMaybe
                  >>= orFall (status status404)
 
-      lift $ html =<< renderTextT (repoManifest item)
+      lift $ html =<< renderTextT (thisRepoManifest item)
 
 
   get "/repo/:lww/refs" do
@@ -267,16 +269,18 @@ gitShowRefs what = do
   path <- repoDataPath what
   let cmd = [qc|git --git-dir {path} show-ref|]
 
-  -- FIXME: extract-method
-  gitRunCommand cmd
-    >>= orThrowUser ("can't read git repo" <+> pretty path)
-    <&> LBS8.lines
-    <&> fmap LBS8.words
-    <&> mapMaybe \case
-         [val,name] -> (GitRef (LBS8.toStrict name),) <$> fromStringMay @GitHash (LBS8.unpack val)
-         _          -> Nothing
+  sto <- asks _sto
 
+  fromMaybe mempty <$> runMaybeT do
 
+    (_,hd) <- lift (selectRepoList (mempty & set repoListByLww (Just what) & set repoListLimit (Just 1)))
+                <&> listToMaybe
+                >>= toMPlus
+                <&> rlRepoTx
+                >>= readRepoHeadFromTx sto . coerce
+                >>= toMPlus
+
+    pure $ view repoHeadRefs hd
 
 
 runScotty :: DashBoardPerks m => DashBoardM m ()
diff --git a/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Web/Html/Root.hs b/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Web/Html/Root.hs
index 44c24bc8..536db30a 100644
--- a/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Web/Html/Root.hs
+++ b/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Web/Html/Root.hs
@@ -190,8 +190,8 @@ parsedManifest RepoListItem{..} = do
   pure (meta, manifest)
 
 
-repoManifest :: (DashBoardPerks m, MonadReader DashBoardEnv m) => RepoListItem -> HtmlT m ()
-repoManifest it@RepoListItem{..} = do
+thisRepoManifest :: (DashBoardPerks m, MonadReader DashBoardEnv m) => RepoListItem -> HtmlT m ()
+thisRepoManifest it@RepoListItem{..} = do
   (_, manifest) <- lift $ parsedManifest it
   toHtmlRaw (renderMarkdown' manifest)