wip. pinned refs

hbs2-git/hbs2-git-dashboard-assets/assets/css/custom.css

@@ -89,9 +89,9 @@ nav.left {
 }
 
 nav.left .info-block {
-  margin-bottom: 2rem;
-  padding-left: 1em;
-  padding-right: 1.2em;
+  margin-bottom: 1.5rem;
+  padding-left: 0.85rem;
+  padding-right: 0.85rem;
 }
 
 section#repo-data {
@@ -191,7 +191,7 @@ div .repo-list-item {
 .attr {
   display: flex;
   flex-direction: row;
-  gap: 2rem;
+  gap: 1rem;
   margin-bottom: 0.5em;
   padding-right: 1rem;
   font-size: 0.85rem;
@@ -199,12 +199,17 @@ div .repo-list-item {
 
 .attrname,  {
   flex: 1;
-  margin-right: 0.5em;
+  margin-right: 0.5rem;
+}
+
+div.attrname a img {
+  margin-right: 0.15rem;
+  display: inline;
 }
 
 .attrval {
-  flex-basis: 80%;
   text-align: right;
+  flex-basis: 8rem;
 }
 
 .onleft {
@@ -225,7 +230,6 @@ div .repo-list-item {
   font-size: 0.85rem;
 }
 
-
 .info-block a {
   font-size: inherit;
   color: inherit;

hbs2-git/hbs2-git-dashboard-assets/assets/icon/license.svg

@@ -0,0 +1,6 @@
+<svg xmlns="http://www.w3.org/2000/svg" class="icon icon-tabler icon-tabler-license" width="20" height="20" viewBox="0 0 24 24" stroke-width="1.5" stroke="#000000" fill="none" stroke-linecap="round" stroke-linejoin="round">
+  <path stroke="none" d="M0 0h24v24H0z" fill="none"/>
+  <path d="M15 21h-9a3 3 0 0 1 -3 -3v-1h10v2a2 2 0 0 0 4 0v-14a2 2 0 1 1 2 2h-2m2 -4h-11a3 3 0 0 0 -3 3v11" />
+  <path d="M9 7l4 0" />
+  <path d="M9 11l4 0" />
+</svg>

hbs2-git/hbs2-git-dashboard-assets/assets/icon/pinned-light.svg

@@ -0,0 +1,6 @@
+<svg xmlns="http://www.w3.org/2000/svg" class="icon icon-tabler icon-tabler-pinned" width="20" height="20" viewBox="0 0 24 24" stroke-width="1.5" stroke="#000000" fill="none" stroke-linecap="round" stroke-linejoin="round">
+  <path stroke="none" d="M0 0h24v24H0z" fill="none"/>
+  <path d="M9 4v6l-2 4v2h10v-2l-2 -4v-6" />
+  <path d="M12 16l0 5" />
+  <path d="M8 4l8 0" />
+</svg>

hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Web/Html/Root.hs

@@ -795,8 +795,12 @@ repoSomeBlob :: (DashBoardPerks m, MonadReader DashBoardEnv m)
          -> GitHash
          -> HtmlT m ()
 
-repoSomeBlob lww syn blob = do
-  toHtml "JOPAKITA"
+repoSomeBlob lww syn hash = do
+
+  bi <- lift (selectBlobInfo (BlobHash hash))
+                      >>= orThrow (itemNotFound hash)
+
+  doRenderBlob (pure mempty) lww bi
 
 repoBlob :: (DashBoardPerks m, MonadReader DashBoardEnv m)
          => LWWRefKey 'HBS2Basic
@@ -805,13 +809,9 @@ repoBlob :: (DashBoardPerks m, MonadReader DashBoardEnv m)
          -> BlobInfo
          -> HtmlT m ()
 
-repoBlob lww co tree BlobInfo{..} = do
+repoBlob lww co tree bi@BlobInfo{..} = do
   locator <- lift $ selectTreeLocator co tree
 
-  let repo = show $ pretty lww
-  let co_ = show $ pretty co
-  let tree_ = show $ pretty tree
-
   table_ [] do
     tr_ do
       td_ [class_ "tree-locator", colspan_ "3"] do
@@ -835,10 +835,9 @@ repoBlob lww co tree BlobInfo{..} = do
 
       td_ [colspan_ "3"] mempty
 
+  doRenderBlob (pure mempty) lww bi
 
-  let fallback _ = mempty
-
-
+doRenderBlob fallback lww BlobInfo{..} = do
   fromMaybe mempty <$> runMaybeT do
 
     guard (blobSize < 10485760)
@@ -877,7 +876,6 @@ repoBlob lww co tree BlobInfo{..} = do
               let code = renderText (Lucid.formatHtmlBlock fo tokens)
               toHtmlRaw code
 
-
 raiseStatus :: forall m . MonadIO m => Status -> Text -> m ()
 raiseStatus s t = throwIO (StatusError s t)
 
@@ -901,11 +899,11 @@ instance ToHtml (ShortRef (LWWRefKey 'HBS2Basic)) where
 
 
 pattern PinnedRefBlob :: forall {c}. Text -> Text -> GitHash -> Syntax c
-pattern PinnedRefBlob syn name hash <- ListVal [ SymbolVal "markdown"
-                                              , SymbolVal (Id syn)
-                                              , LitStrVal name
-                                              , asGitHash -> Just hash
-                                              ]
+pattern PinnedRefBlob syn name hash <- ListVal [ SymbolVal "blob"
+                                               , SymbolVal (Id syn)
+                                               , LitStrVal name
+                                               , asGitHash -> Just hash
+                                               ]
 {-# COMPLETE PinnedRefBlob #-}
 
 asGitHash :: forall c . Syntax c -> Maybe GitHash
@@ -937,6 +935,8 @@ repoPage tab lww params = rootPage do
   let public = headMay [ s | ListVal [ SymbolVal "public:", SymbolVal (Id s) ] <- meta ]
   let pinned = [ (name,r) | ListVal [ SymbolVal "pinned:", r@(PinnedRefBlob _ name _) ] <- meta ] & take 5
 
+  debug $ red "META" <+> pretty meta
+
   div_ [class_ "container main"] $ do
     nav_ [class_ "left"] $ do
 
@@ -965,30 +965,42 @@ repoPage tab lww params = rootPage do
         when (Text.length manifest > 100) do
             div_ [ class_ "attr" ] do
               div_ [ class_ "attrname"] do
-                a_ [ href_ (toURL (RepoPage ManifestTab lww))] "Manifest"
+                a_ [ href_ (toURL (RepoPage ManifestTab lww))] do
+                  img_ [src_ "/icon/license.svg"]
+                  "Manifest"
 
         when (rlRepoForks > 0) do
           div_ [ class_ "attr" ] do
             div_ [ class_ "attrname"] do
-              a_ [ hxGet_ (toURL (RepoForksHtmx lww))
-                 , hxTarget_ "#repo-tab-data"
-                 ] "Forks"
+                a_ [ hxGet_ (toURL (RepoForksHtmx lww))
+                   , hxTarget_ "#repo-tab-data"
+                   ] do
+                      img_ [src_ "/icon/git-fork.svg"]
+                      "Forks"
+
             div_ [ class_ "attrval"] $ toHtml (show $ rlRepoForks)
 
         div_ [ class_ "attr" ] do
           div_ [ class_ "attrname"] do
-            a_ [ href_ (toURL (RepoPage (CommitsTab Nothing) lww))] "Commits"
+              a_ [ href_ (toURL (RepoPage (CommitsTab Nothing) lww))] do
+                img_ [src_ "/icon/git-commit.svg"]
+                "Commits"
+
           div_ [ class_ "attrval"] $ toHtml (show $ rlRepoCommits)
 
-        for_ pinned $ \(name,ref) ->  do
+        for_ pinned $ \(_,ref) ->  do
           div_ [ class_ "attr" ] do
-            div_ [ class_ "attrname"] $ do
               case ref of
-                -- WTF
                 PinnedRefBlob s n hash -> do
-                  a_ [ href_ "#"
-                     , hxGet_ (toURL (RepoSomeBlob lww s hash))
-                     ] $ toHtml n
+                  div_ [ class_ "attrname"] $ do
+                      a_ [ href_ "#"
+                         , hxGet_ (toURL (RepoSomeBlob lww s hash))
+                         , hxTarget_ "#repo-tab-data"
+                         ] do
+                            img_ [src_ "/icon/pinned-light.svg"]
+                            toHtml (Text.take 12 n)
+
+                  div_ [ class_ "attrval"] $ toHtml $ ShortRef hash
 
       for_ mbHead $ \rh -> do
 
@@ -998,7 +1010,7 @@ repoPage tab lww params = rootPage do
                              | otherwise    = what
 
         div_ [class_ "info-block" ] do
-            h6_ [] "heads"
+            strong_ [] "heads"
             for_ (view repoHeadHeads rh) $ \(branch,v) -> do
               div_ [ class_ "attrval onleft"] do
                   a_ [ href_ (toURL (RepoPage (CommitsTab (Just v))  lww ))
@@ -1006,7 +1018,7 @@ repoPage tab lww params = rootPage do
                            $ toHtml branch
 
         div_ [class_ "info-block" ] do
-            h6_ [] "tags"
+            strong_ [] "tags"
             for_ (view repoHeadTags rh) $ \(tag,v) -> do
                 div_ [ class_ "attrval onleft"] do
                     a_ [href_ (toURL (RepoPage (CommitsTab (Just v)) lww ))]