From 4249f984442cf6ffbc6beb5abaa8b53761dd5760 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Tue, 1 Oct 2024 08:31:38 +0300
Subject: [PATCH] wip

---
 .../assets/css/custom.css                     |  3 ++
 .../HBS2/Git/Web/Html/Issue.hs                | 46 +++++++++++++++++--
 .../HBS2/Git/Web/Html/Root.hs                 |  7 +++
 3 files changed, 52 insertions(+), 4 deletions(-)

diff --git a/hbs2-git-dashboard/hbs2-git-dashboard-assets/assets/css/custom.css b/hbs2-git-dashboard/hbs2-git-dashboard-assets/assets/css/custom.css
index 101d5f28..615261b4 100644
--- a/hbs2-git-dashboard/hbs2-git-dashboard-assets/assets/css/custom.css
+++ b/hbs2-git-dashboard/hbs2-git-dashboard-assets/assets/css/custom.css
@@ -84,6 +84,9 @@ article {
   color: var(--pico-secondary-hover);
 }
 
+.copyable-text {
+}
+
 .copy-button .icon {
   width: 1.125rem;
   height: 1.125rem;
diff --git a/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/Web/Html/Issue.hs b/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/Web/Html/Issue.hs
index 04e94972..24a39fe2 100644
--- a/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/Web/Html/Issue.hs
+++ b/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/Web/Html/Issue.hs
@@ -20,7 +20,6 @@ import Lucid.Base
 import Lucid.Html5 hiding (for_)
 
 
-
 data IssueOptionalArg w t = IssueOptionalArg w t
 
 issueOptionalArg :: Fixme -> FixmeAttrName -> IssueOptionalArg Fixme FixmeAttrName
@@ -49,6 +48,21 @@ issuePage repo@(RepoLww lww) f = rootPage do
 
   let txt = fixmePlain fxm & fmap coerce & Text.intercalate "\n"
 
+  let mbFile = fixmeGet "file" fxm
+
+  mbBlob <- runMaybeT do
+              blobHashText <- fixmeGet "blob" fxm & toMPlus
+              debug $ red "BLOB HASH TEXT" <+> pretty blobHashText
+              hash <- coerce blobHashText
+                             & Text.unpack
+                             & fromStringMay @GitHash
+                             & toMPlus
+              debug $ red "BLOB" <+> pretty hash
+              lift (lift $ selectBlobInfo (BlobHash hash))
+                 >>= toMPlus
+
+  debug $ "BLOB INFO" <> line <> pretty (fmap blobHash mbBlob)
+
   main_ [class_ "container-fluid"] do
     div_ [class_ "wrapper"] do
       aside_ [class_ "sidebar"] do
@@ -71,16 +85,40 @@ issuePage repo@(RepoLww lww) f = rootPage do
           table_ do
             tr_ do
               td_ [colspan_ "2"] do
+                let fkKey = coerce @_ @Text $ fixmeKey fxm
                 strong_ [style_ "margin-right: 1ch;"] $ toHtml (coerce @_ @Text $ fixmeTag fxm)
-                span_ [style_ "margin-right: 1ch;"] $ toHtml (H $ fixmeKey fxm)
+                span_ [ style_ "margin-right: 1ch;"
+                      -- FIXME: make-underlined-on-hover
+                      --  $assigned fastpok
+                      , class_ "copyable-text"
+                      , onClickCopyText $ Text.take 10 fkKey
+                      ] $ toHtml (H $ fixmeKey fxm)
+                " "
                 span_ [] $ toHtml (coerce @_ @Text $ fixmeTitle fxm)
 
             toHtml (issueOptionalArg fxm "workflow")
-            toHtml (issueOptionalArg fxm "file")
-            toHtml (issueOptionalArg fxm "commit")
             toHtml (issueOptionalArg fxm "committer-name")
+            toHtml (issueOptionalArg fxm "commit")
+
+
+            maybe1 mbFile none $ \file -> do
+              tr_ do
+                th_ $ strong_ [] $ "file"
+
+                case mbBlob of
+                  Nothing -> do
+                    td_ do
+                      toHtml $ show $ pretty file
+                  Just (BlobInfo{}) -> do
+                    td_ do
+                      a_ [ href_ "#" ] do
+                        toHtml $ show $ pretty file
+
+            -- toHtml (issueOptionalArg fxm "file")
 
         section_ [class_ "lim-text"] do
           toHtmlRaw $ renderMarkdown txt
 
 
+
+
diff --git a/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/Web/Html/Root.hs b/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/Web/Html/Root.hs
index a3d06c02..8c00e411 100644
--- a/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/Web/Html/Root.hs
+++ b/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/Web/Html/Root.hs
@@ -44,6 +44,13 @@ set @data-tooltip to 'Copy'
 |]
 
 
+onClickCopyText :: Text -> Attribute
+onClickCopyText s =
+  hyper_ [qc|on click writeText('{s}') into the navigator's clipboard
+set @data-tooltip to 'Copied!'
+|]
+
+
 instance ToHtml RepoBrief where
   toHtml (RepoBrief txt) = toHtmlRaw (renderMarkdown' txt)
   toHtmlRaw (RepoBrief txt) = toHtmlRaw (renderMarkdown' txt)