From 77fa0bfefb6c3c1adb74d20e8049d8b1c5038675 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Sat, 28 Sep 2024 12:33:13 +0300 Subject: [PATCH] wip, issues pages --- fixme-new/app/FixmeMain.hs | 65 ---- fixme-new/lib/Fixme/State.hs | 23 ++ hbs2-git-dashboard/app/GitDashBoard.hs | 33 +- .../HBS2/Git/DashBoard/Fixme.hs | 32 +- .../HBS2/Git/DashBoard/State.hs | 4 +- .../HBS2/Git/Web/Html/Root.hs | 282 +++++++++++++----- hbs2-peer/lib/HBS2/Peer/Proto/LWWRef.hs | 4 +- 7 files changed, 281 insertions(+), 162 deletions(-) diff --git a/fixme-new/app/FixmeMain.hs b/fixme-new/app/FixmeMain.hs index cdcce401..a99f1abc 100644 --- a/fixme-new/app/FixmeMain.hs +++ b/fixme-new/app/FixmeMain.hs @@ -1,73 +1,8 @@ module Main where -import Fixme --- import Fixme.Run import Fixme.Run -import System.Environment - --- TODO: fixme-new --- $author: Dmitry Zuikov --- $milestone: undefined --- $priority: ASAP --- после майских: --- 1. fixme переезжает в дерево hbs2, конкретно в hbs2-git - --- 2. fixme преобразуется в утилиту для генерации отчётов по репозиторию git --- --- 3. fixme генерирует поток фактов про репозиторий git, включая записи todo/fixme --- --- 4. fixme начинает генерировать PR-ы в формате git (у гита есть простенькие пулл-реквесты!) --- и умеет постить их куда там их следует постить --- --- 5. fixme получает ограничитель глубины сканирования и фильтр бранчей, --- что бы не окочуриваться на больших проектах --- --- 6. fixme генерирует настройки по умолчанию, включая .gitignore --- --- 7. fixme позволяет явно задавать лог изменений статуса, беря его как из --- .fixme/log так и откуда скажут --- --- 8. fixme интегрируется в hbs2-git-dashboard --- --- 9. fixme временно получает название fixme2 или nfixme или hfixme (не решил пока), --- потом возвращается к старому названию --- --- 10. fixme умеет постить записи в своём формате в hbs2 или же умеет любые источники дампить в своём формате так, --- что бы hbs2-git мог запостить их в соответствующий рефчан --- --- 11. fixme оформляет либу для экстракции фактов из git, которую будет использовать и hbs2-git-dashboard --- --- 12. hbs2-git-dashboard понимает и уважает каталог настроек .fixme , а стейт берёт прямо оттуда - --- открытые вопросы: - --- hbs2-git использует fixme или fixme использует hbs2 - --- переводить fixme на fuzzy-parse или нет (скорее, да) - --- переводить ли suckless-conf на fuzzy-parse сейчас (или хрен пока с ним) - --- встроить ли jq внутрь или лучше дать доступ к sql запросам по json main :: IO () main = do - - -- TODO: discover-config - -- - -- TODO: local-config-has-same-name-with-binary - -- - -- TODO: per-user-config-has-same-name-with-binary - -- - -- TODO: per-user-config-added-after-per-project-config - - -- TODO: scan-all-sources - -- for-source-from-con - runFixmeCLI runCLI --- FIXME: test-fixme --- $workflow: wip --- $assigned: voidlizard --- --- Тестовый тикет с параметрами - diff --git a/fixme-new/lib/Fixme/State.hs b/fixme-new/lib/Fixme/State.hs index 12823d9a..fa2dea05 100644 --- a/fixme-new/lib/Fixme/State.hs +++ b/fixme-new/lib/Fixme/State.hs @@ -6,6 +6,7 @@ module Fixme.State , withState , cleanupDatabase , listFixme + , countFixme , insertFixme , insertFixmeExported , modifyFixme @@ -319,6 +320,28 @@ selectFixmeKey s = do sqliteToAeson :: FromJSON a => Text -> Maybe a sqliteToAeson = Aeson.decode . LBS.fromStrict . Text.encodeUtf8 + +countFixme :: (FixmePerks m, MonadReader FixmeEnv m) => m Int +countFixme = do + + let present = [qc|coalesce(json_extract(s1.blob, '$.deleted'),'false') <> 'true' |] :: String + + let sql = [qc| + with s1 as ( + select cast (json_insert(json_group_object(o.k, o.v), '$.w', max(o.w)) as text) as blob + from object o + group by o.o + ) + select count(s1.blob) from s1 + where + {present} + |] + + debug $ pretty sql + + withState $ select_ @_ @(Only Int) sql + <&> maybe 0 fromOnly . headMay + listFixme :: (FixmePerks m, MonadReader FixmeEnv m, HasPredicate q) => q -> m [Fixme] diff --git a/hbs2-git-dashboard/app/GitDashBoard.hs b/hbs2-git-dashboard/app/GitDashBoard.hs index 0ca60efd..8277a1be 100644 --- a/hbs2-git-dashboard/app/GitDashBoard.hs +++ b/hbs2-git-dashboard/app/GitDashBoard.hs @@ -23,6 +23,7 @@ import HBS2.Git.DashBoard.State.Index import HBS2.Git.DashBoard.State.Commits import HBS2.Git.DashBoard.Types import HBS2.Git.DashBoard.Fixme +import HBS2.Git.DashBoard.Manifest import HBS2.Git.Web.Html.Root import HBS2.Peer.CLI.Detect @@ -230,16 +231,8 @@ runDashboardWeb WebOptions{..} = do lwws' <- captureParam @String "lww" <&> fromStringMay @(LWWRefKey 'HBS2Basic) flip runContT pure do lww <- lwws' & orFall (status status404) - - item <- lift (selectRepoList ( mempty - & set repoListByLww (Just lww) - & set repoListLimit (Just 1)) - ) - <&> listToMaybe - >>= orFall (status status404) - - lift $ html =<< renderTextT (thisRepoManifest item) - + TopInfoBlock{..} <- getTopInfoBlock lww + lift $ html (LT.fromStrict manifest) get (routePattern (RepoRefs "lww")) do lwws' <- captureParam @String "lww" <&> fromStringMay @(LWWRefKey 'HBS2Basic) @@ -299,6 +292,12 @@ runDashboardWeb WebOptions{..} = do lift $ renderHtml (repoForks lww) -- lift $ renderHtml (toHtml $ show $ pretty lww) + get (routePattern (RepoFixmeHtmx "lww")) do + lwws' <- captureParam @String "lww" <&> fromStringMay @(LWWRefKey 'HBS2Basic) + flip runContT pure do + lww <- lwws' & orFall (status status404) + lift $ renderHtml (repoFixme lww) + get (routePattern (RepoCommits "lww")) do lwws' <- captureParam @String "lww" <&> fromStringMay @(LWWRefKey 'HBS2Basic) @@ -602,15 +601,21 @@ theDict = do entry $ bindMatch "debug:test-with-fixme" $ nil_ $ \case [SignPubKeyLike s] -> lift do - r <- runInFixme (RepoLww (LWWRefKey s)) (listFixme ()) - & try @_ @SomeException - >>= orThrowPassIO - + r <- listFixme (RepoLww (LWWRefKey s)) () for_ r $ \f -> do liftIO $ print $ pretty f _ -> throwIO $ BadFormException @C nil + entry $ bindMatch "debug:count-fixme" $ nil_ $ \case + [SignPubKeyLike s] -> lift do + r <- countFixme (RepoLww (LWWRefKey s)) + liftIO $ print $ pretty r + + _ -> throwIO $ BadFormException @C nil + + + main :: IO () main = do argz <- getArgs diff --git a/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/Fixme.hs b/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/Fixme.hs index 8880d255..ff73363e 100644 --- a/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/Fixme.hs +++ b/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/Fixme.hs @@ -1,9 +1,18 @@ module HBS2.Git.DashBoard.Fixme - ( F.listFixme - , F.HasPredicate(..) + ( F.HasPredicate(..) , F.SelectPredicate(..) , runInFixme + , countFixme + , listFixme , RunInFixmeError(..) + , Fixme(..) + , FixmeKey(..) + , FixmeTitle(..) + , FixmeTag(..) + , FixmePlainLine(..) + , FixmeAttrName(..) + , FixmeAttrVal(..) + , FixmeOpts(..) ) where import HBS2.Git.DashBoard.Prelude @@ -13,11 +22,13 @@ import HBS2.Git.DashBoard.State import HBS2.OrDie import Fixme.State qualified as F +import Fixme.State (HasPredicate(..)) import Fixme.Types import Fixme.Config -import DBPipe.SQLite (withDB, shutdown) +import DBPipe.SQLite (shutdown) +import Data.Either import Data.Generics.Product.Fields (field) data RunInFixmeError = @@ -49,9 +60,6 @@ runInFixme repo m = do let fenvNew = fenv & set (field @"fixmeEnvWorkDir") twd & set (field @"fixmeEnvOpts") fo - -- TODO: close-fixme-database-garanteed - -- похоже, что надо будет фиксить db-pipe - flip runContT pure do dbe <- lift $ withFixmeEnv fenvNew $ F.withState ask @@ -67,4 +75,16 @@ runInFixme repo m = do m +listFixme :: (DashBoardPerks m, MonadReader DashBoardEnv m, HasPredicate q) => RepoLww -> q -> m [Fixme] +listFixme repo q = do + runInFixme repo $ F.listFixme q + & try @_ @RunInFixmeError + <&> fromRight mempty + +countFixme :: (DashBoardPerks m, MonadReader DashBoardEnv m) => RepoLww -> m (Maybe Int) +countFixme repo = do + runInFixme repo $ F.countFixme + & try @_ @RunInFixmeError + <&> either (const Nothing) Just + diff --git a/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/State.hs b/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/State.hs index d6d3c7fc..6f1d2200 100644 --- a/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/State.hs +++ b/hbs2-git-dashboard/hbs2-git-dashboard-core/HBS2/Git/DashBoard/State.hs @@ -156,7 +156,7 @@ newtype RepoHeadTx = RepoHeadTx HashRef newtype RepoName = RepoName Text deriving stock (Eq,Show,Generic) - deriving newtype (ToField,FromField,ToHtml,IsString) + deriving newtype (ToField,FromField,ToHtml,IsString,Pretty) newtype RepoBrief = RepoBrief Text deriving stock (Generic) @@ -172,7 +172,7 @@ newtype RepoCommitsNum = RepoCommitsNum Int deriving newtype (ToField,FromField,Show,Pretty) newtype RepoLww = RepoLww (LWWRefKey 'HBS2Basic) - deriving stock (Generic) + deriving stock (Generic,Ord,Eq) deriving newtype (ToField,FromField,Pretty) instance Show RepoLww where 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 8f5d46aa..06fb1485 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 @@ -9,6 +9,7 @@ import HBS2.Git.DashBoard.Types import HBS2.Git.DashBoard.State import HBS2.Git.DashBoard.State.Commits import HBS2.Git.DashBoard.Manifest +import HBS2.Git.DashBoard.Fixme as Fixme import HBS2.OrDie @@ -67,6 +68,7 @@ data RepoListPage = RepoListPage data RepoPageTabs = CommitsTab (Maybe GitHash) | ManifestTab | TreeTab (Maybe GitHash) + | IssuesTab | ForksTab deriving stock (Eq,Ord,Show) @@ -88,6 +90,8 @@ newtype RepoManifest repo = RepoManifest repo newtype RepoCommits repo = RepoCommits repo +newtype RepoFixmeHtmx repo = RepoFixmeHtmx repo + data RepoCommitsQ repo off lim = RepoCommitsQ repo off lim data RepoCommitDefault repo commit = RepoCommitDefault repo commit @@ -115,6 +119,7 @@ instance Pretty RepoPageTabs where ManifestTab{} -> "manifest" TreeTab{} -> "tree" ForksTab{} -> "forks" + IssuesTab{} -> "issues" instance FromStringMaybe RepoPageTabs where fromStringMay = \case @@ -122,6 +127,7 @@ instance FromStringMaybe RepoPageTabs where "manifest" -> pure ManifestTab "tree" -> pure (TreeTab Nothing) "forks" -> pure ForksTab + "issues" -> pure IssuesTab _ -> pure (CommitsTab Nothing) instance ToRoutePattern RepoListPage where @@ -256,10 +262,20 @@ instance ToURL (RepoForksHtmx (LWWRefKey 'HBS2Basic)) where where repo = show $ pretty k +instance ToRoutePattern (RepoFixmeHtmx String) where + routePattern (RepoFixmeHtmx r) = + path ["/", "htmx", "fixme", toArg r] & toPattern + +instance ToURL (RepoFixmeHtmx RepoLww) where + toURL (RepoFixmeHtmx k) = path ["/", "htmx", "fixme", repo] + where + repo = show $ pretty k + instance ToRoutePattern (RepoForksHtmx String) where routePattern (RepoForksHtmx r) = path ["/", "htmx", "forks", toArg r] & toPattern + myCss :: Monad m => HtmlT m () myCss = do link_ [rel_ "stylesheet", href_ (path ["css/custom.css"])] @@ -422,10 +438,10 @@ parsedManifest RepoListItem{..} = do Just x -> parseManifest (snd x) Nothing -> pure (mempty, coerce rlRepoBrief) -thisRepoManifest :: (DashBoardPerks m, MonadReader DashBoardEnv m) => RepoListItem -> HtmlT m () -thisRepoManifest it@RepoListItem{..} = do - (_, manifest) <- lift $ parsedManifest it - toHtmlRaw (renderMarkdown' manifest) +thisRepoManifest :: (DashBoardPerks m, MonadReader DashBoardEnv m) => RepoHead -> HtmlT m () +thisRepoManifest rh = do + (_, man) <- lift $ parseManifest rh + toHtmlRaw (renderMarkdown' man) repoRefs :: (DashBoardPerks m, MonadReader DashBoardEnv m) => LWWRefKey 'HBS2Basic @@ -885,12 +901,122 @@ instance ToHtml (ShortRef (LWWRefKey 'HBS2Basic)) where toHtmlRaw (ShortRef a) = toHtml (shortRef 14 3 (show $ pretty a)) -repoPage :: (MonadIO m, DashBoardPerks m, MonadReader DashBoardEnv m) - => RepoPageTabs - -> LWWRefKey 'HBS2Basic - -> [(Text,Text)] - -> HtmlT m () -repoPage tab lww params = rootPage do +newtype H a = H a + +instance ToHtml (H FixmeKey) where + toHtmlRaw (H k) = toHtmlRaw $ take 10 $ show $ pretty k + toHtml (H k) = toHtml $ take 10 $ show $ pretty k + +instance ToHtml (H FixmeTag) where + toHtmlRaw (H k) = toHtmlRaw $ coerce @_ @Text k + toHtml (H k) = toHtml $ coerce @_ @Text k + +instance ToHtml (H FixmeTitle) where + toHtmlRaw (H k) = toHtmlRaw $ coerce @_ @Text k + toHtml (H k) = toHtml $ coerce @_ @Text k + +repoFixme :: (MonadReader DashBoardEnv m, DashBoardPerks m) => LWWRefKey HBS2Basic -> HtmlT m () +repoFixme lww = do + + fme <- lift $ listFixme (RepoLww lww) () + + table_ [] do + for_ fme $ \fixme -> do + tr_ [class_ "commit-brief-title"] $ do + td_ [class_ "mono", width_ "10"] do + a_ [] $ toHtml (H $ fixmeKey fixme) + td_ [width_ "10"] do + strong_ [] $ toHtml (H $ fixmeTag fixme) + td_ [] do + toHtml (H $ fixmeTitle fixme) + tr_ [class_ "commit-brief-details"] $ do + td_ [colspan_ "3"] do + small_ "seconday shit" + + +data TopInfoBlock = + TopInfoBlock + { author :: Maybe Text + , public :: Maybe Text + , forksNum :: RepoForks + , commitsNum :: RepoCommitsNum + , manifest :: Text + , fixme :: Maybe MyRefChan + , fixmeCnt :: Int + , pinned :: [(Text, Syntax C)] + , repoHeadRef :: RepoHeadRef + , repoHead :: Maybe RepoHead + , repoName :: RepoName + } + +repoTopInfoBlock :: (MonadIO m, DashBoardPerks m, MonadReader DashBoardEnv m) + => LWWRefKey 'HBS2Basic + -> TopInfoBlock + -> HtmlT m () + +repoTopInfoBlock lww TopInfoBlock{..} = do + div_ [class_ "info-block" ] do + + summary_ [class_ "sidebar-title"] $ small_ $ strong_ "About" + ul_ [class_ "mb-0"] do + for_ author $ \a -> do + li_ $ small_ do + "Author: " + toHtml a + + for_ public $ \p -> do + li_ $ small_ do + "Public: " + toHtml p + + when (Text.length manifest > 100) do + li_ $ small_ do + a_ [class_ "secondary", href_ (toURL (RepoPage ManifestTab lww))] do + span_ [class_ "inline-icon-wrapper"] $ svgIcon IconLicense + "Manifest" + + for_ fixme $ \_ -> do + li_ $ small_ do + a_ [ class_ "secondary" + , href_ (toURL (RepoPage IssuesTab lww)) ] do + span_ [class_ "inline-icon-wrapper"] $ svgIcon IconFixme + toHtml $ show fixmeCnt + " Issues" + + when (forksNum > 0) do + li_ $ small_ do + a_ [class_ "secondary" + , href_ "#" + , hxGet_ (toURL (RepoForksHtmx lww)) + , hxTarget_ "#repo-tab-data" + ] do + span_ [class_ "inline-icon-wrapper"] $ svgIcon IconGitFork + toHtml $ show forksNum + " forks" + + li_ $ small_ do + a_ [class_ "secondary" + , href_ (toURL (RepoPage (CommitsTab Nothing) lww)) + ] do + span_ [class_ "inline-icon-wrapper"] $ svgIcon IconGitCommit + toHtml $ show commitsNum + " commits" + + for_ pinned $ \(_,ref) -> do + case ref of + PinnedRefBlob s n hash -> small_ do + li_ $ a_ [class_ "secondary" + , href_ "#" + , hxGet_ (toURL (RepoSomeBlob lww s hash)) + , hxTarget_ "#repo-tab-data" + ] do + span_ [class_ "inline-icon-wrapper"] $ svgIcon IconPinned + toHtml (Text.take 12 n) + " " + toHtml $ ShortRef hash + + +getTopInfoBlock lww = do it@RepoListItem{..} <- lift (selectRepoList ( mempty & set repoListByLww (Just lww) @@ -901,7 +1027,7 @@ repoPage tab lww params = rootPage do sto <- asks _sto mhead <- lift $ readRepoHeadFromTx sto (coerce rlRepoTx) - let mbHead = snd <$> mhead + let repoHead = snd <$> mhead (meta, manifest) <- lift $ parsedManifest it @@ -912,7 +1038,25 @@ repoPage tab lww params = rootPage do allowed <- lift $ checkFixmeAllowed (RepoLww lww) let fixme = headMay [ x | allowed, FixmeRefChanP x <- meta ] - debug $ red "META" <+> pretty meta + fixmeCnt <- lift (Fixme.countFixme (RepoLww lww)) + <&> fromMaybe 0 + + let forksNum = rlRepoForks + let commitsNum = rlRepoCommits + let repoHeadRef = rlRepoHead + let repoName = rlRepoName + + pure $ TopInfoBlock{..} + +repoPage :: (MonadIO m, DashBoardPerks m, MonadReader DashBoardEnv m) + => RepoPageTabs + -> LWWRefKey 'HBS2Basic + -> [(Text,Text)] + -> HtmlT m () + +repoPage IssuesTab lww _ = rootPage do + + topInfoBlock@TopInfoBlock{..} <- getTopInfoBlock lww main_ [class_ "container-fluid"] do div_ [class_ "wrapper"] do @@ -923,70 +1067,60 @@ repoPage tab lww params = rootPage do let txt = toHtml (ShortRef lww) a_ [href_ url, class_ "secondary"] txt - -- div_ [class_ "info-block" ] do - -- a_ [ href_ "/"] do - -- span_ [class_ "inline-icon-wrapper"] $ svgIcon IconArrowUturnLeft - -- "back to projects" + repoTopInfoBlock lww topInfoBlock + + div_ [class_ "content"] $ do + + -- article_ [class_ "py-0"] $ nav_ [ariaLabel_ "breadcrumb", class_ "repo-menu"] $ ul_ do + + -- let menuTabClasses isActive = if isActive then "tab contrast" else "tab" + -- menuTab t misc name = li_ do + -- a_ ([class_ $ menuTabClasses $ isActiveTab tab t] <> misc <> [tabClick]) do + -- name + + -- menuTab (CommitsTab Nothing) + -- [ href_ "#" + -- , hxGet_ (toURL (RepoCommits lww)) + -- , hxTarget_ "#repo-tab-data" + -- ] "commits" + + -- menuTab (TreeTab Nothing) + -- [ href_ "#" + -- , hxGet_ (toURL (RepoRefs lww)) + -- , hxTarget_ "#repo-tab-data" + -- ] "tree" + + section_ do + strong_ $ toHtml (show $ "Issues ::" <+> pretty repoName) + + div_ [ id_ "repo-tab-data" + , hxTrigger_ "load" + , hxTarget_ "#repo-tab-data" + , hxGet_ (toURL (RepoFixmeHtmx (RepoLww lww))) + ] do + pure () + + div_ [id_ "repo-tab-data-embedded"] mempty + + +repoPage tab lww params = rootPage do + + sto <- asks _sto + + topInfoBlock@TopInfoBlock{..} <- getTopInfoBlock lww + + main_ [class_ "container-fluid"] do + div_ [class_ "wrapper"] do + aside_ [class_ "sidebar"] do div_ [class_ "info-block" ] do + let url = toURL (RepoPage (CommitsTab Nothing) lww) + let txt = toHtml (ShortRef lww) + a_ [href_ url, class_ "secondary"] txt - summary_ [class_ "sidebar-title"] $ small_ $ strong_ "About" - ul_ [class_ "mb-0"] do - for_ author $ \a -> do - li_ $ small_ do - "Author: " - toHtml a + repoTopInfoBlock lww topInfoBlock - for_ public $ \p -> do - li_ $ small_ do - "Public: " - toHtml p - - when (Text.length manifest > 100) do - li_ $ small_ do - a_ [class_ "secondary", href_ (toURL (RepoPage ManifestTab lww))] do - span_ [class_ "inline-icon-wrapper"] $ svgIcon IconLicense - "Manifest" - - for_ fixme $ \_ -> do - li_ $ small_ do - a_ [class_ "secondary"] do - span_ [class_ "inline-icon-wrapper"] $ svgIcon IconFixme - "Issues" - - when (rlRepoForks > 0) do - li_ $ small_ do - a_ [class_ "secondary" - , href_ "#" - , hxGet_ (toURL (RepoForksHtmx lww)) - , hxTarget_ "#repo-tab-data" - ] do - span_ [class_ "inline-icon-wrapper"] $ svgIcon IconGitFork - toHtml $ show rlRepoForks - " forks" - - li_ $ small_ do - a_ [class_ "secondary" - , href_ (toURL (RepoPage (CommitsTab Nothing) lww)) - ] do - span_ [class_ "inline-icon-wrapper"] $ svgIcon IconGitCommit - toHtml $ show rlRepoCommits - " commits" - - for_ pinned $ \(_,ref) -> do - case ref of - PinnedRefBlob s n hash -> small_ do - li_ $ a_ [class_ "secondary" - , href_ "#" - , hxGet_ (toURL (RepoSomeBlob lww s hash)) - , hxTarget_ "#repo-tab-data" - ] do - span_ [class_ "inline-icon-wrapper"] $ svgIcon IconPinned - toHtml (Text.take 12 n) - " " - toHtml $ ShortRef hash - - for_ mbHead $ \rh -> do + for_ repoHead $ \rh -> do let theHead = headMay [ v | (GitRef "HEAD", v) <- view repoHeadRefs rh ] @@ -1031,7 +1165,7 @@ repoPage tab lww params = rootPage do ] "tree" section_ do - strong_ $ toHtml rlRepoName + strong_ $ toHtml repoName div_ [id_ "repo-tab-data"] do @@ -1046,7 +1180,7 @@ repoPage tab lww params = rootPage do maybe (repoRefs lww) (\t -> repoTree lww t t) tree ManifestTab -> do - thisRepoManifest it + for_ repoHead $ thisRepoManifest CommitsTab{} -> do let predicate = Right (fromQueryParams params) diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/LWWRef.hs b/hbs2-peer/lib/HBS2/Peer/Proto/LWWRef.hs index f9914c68..cd7fe769 100644 --- a/hbs2-peer/lib/HBS2/Peer/Proto/LWWRef.hs +++ b/hbs2-peer/lib/HBS2/Peer/Proto/LWWRef.hs @@ -52,11 +52,13 @@ newtype LWWRefKey s = } deriving stock (Generic) - instance RefMetaData (LWWRefKey s) deriving stock instance IsRefPubKey s => Eq (LWWRefKey s) +instance IsRefPubKey s => Ord (LWWRefKey s) where + compare a b = compare (serialise a) (serialise b) + instance IsRefPubKey e => Serialise (LWWRefKey e) instance IsRefPubKey s => Hashable (LWWRefKey s) where