From 0e156d97abcca7b55246ef763fa3742419ad2740 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Wed, 24 Apr 2024 15:05:14 +0300 Subject: [PATCH] wip. pinned refs --- .../assets/css/custom.css | 18 +++-- .../assets/icon/license.svg | 6 ++ .../assets/icon/pinned-light.svg | 6 ++ .../src/HBS2/Git/Web/Html/Root.hs | 70 +++++++++++-------- 4 files changed, 64 insertions(+), 36 deletions(-) create mode 100644 hbs2-git/hbs2-git-dashboard-assets/assets/icon/license.svg create mode 100644 hbs2-git/hbs2-git-dashboard-assets/assets/icon/pinned-light.svg diff --git a/hbs2-git/hbs2-git-dashboard-assets/assets/css/custom.css b/hbs2-git/hbs2-git-dashboard-assets/assets/css/custom.css index bf4de352..fd827dab 100644 --- a/hbs2-git/hbs2-git-dashboard-assets/assets/css/custom.css +++ b/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; diff --git a/hbs2-git/hbs2-git-dashboard-assets/assets/icon/license.svg b/hbs2-git/hbs2-git-dashboard-assets/assets/icon/license.svg new file mode 100644 index 00000000..995ee894 --- /dev/null +++ b/hbs2-git/hbs2-git-dashboard-assets/assets/icon/license.svg @@ -0,0 +1,6 @@ + + + + + + diff --git a/hbs2-git/hbs2-git-dashboard-assets/assets/icon/pinned-light.svg b/hbs2-git/hbs2-git-dashboard-assets/assets/icon/pinned-light.svg new file mode 100644 index 00000000..59c4e50d --- /dev/null +++ b/hbs2-git/hbs2-git-dashboard-assets/assets/icon/pinned-light.svg @@ -0,0 +1,6 @@ + + + + + + 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 214f3ea9..afd529ff 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 @@ -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 ))]