voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

highlight HEAD branch

This commit is contained in:
Dmitry Zuikov 2024-04-23 12:14:13 +03:00
parent ea95a52a6b
commit 179f85545b
1 changed files with 25 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -827,11 +827,14 @@ repoPage tab lww params = rootPage do
sto <- asks _sto sto <- asks _sto
mhead <- lift $ readRepoHeadFromTx sto (coerce rlRepoTx) mhead <- lift $ readRepoHeadFromTx sto (coerce rlRepoTx)
let mbHead = snd <$> mhead
(meta, manifest) <- lift $ parsedManifest it (meta, manifest) <- lift $ parsedManifest it
let author = headMay [ s | ListVal [ SymbolVal "author:", LitStrVal s ] <- meta ] let author = headMay [ s | ListVal [ SymbolVal "author:", LitStrVal s ] <- meta ]
let public = headMay [ s | ListVal [ SymbolVal "public:", SymbolVal (Id s) ] <- meta ] let public = headMay [ s | ListVal [ SymbolVal "public:", SymbolVal (Id s) ] <- meta ]
div_ [class_ "container main"] $ do div_ [class_ "container main"] $ do
nav_ [class_ "left"] $ do nav_ [class_ "left"] $ do
@ -846,20 +849,29 @@ repoPage tab lww params = rootPage do
div_ [ class_ "attrname"] "public:" div_ [ class_ "attrname"] "public:"
div_ [ class_ "attrval"] $ toHtml p div_ [ class_ "attrval"] $ toHtml p
div_ [class_ "info-block" ] do
for_ (snd <$> mhead) $ \rh -> do
h6_ [] "heads"
for_ (view repoHeadHeads rh) $ \(branch,v) -> do
div_ [ class_ "attrval onleft"] do
a_ [ href_ (toURL (RepoPage (CommitsTab (Just v)) lww ))
] $ toHtml branch
div_ [class_ "info-block" ] do for_ mbHead $ \rh -> do
for_ (snd <$> mhead) $ \rh -> do
h6_ [] "tags" let theHead = headMay [ v | (GitRef "HEAD", v) <- view repoHeadRefs rh ]
for_ (view repoHeadTags rh) $ \(tag,v) -> do
div_ [ class_ "attrval onleft"] do let checkHead v what | v == theHead = strong_ what
a_ [href_ (toURL (RepoPage (CommitsTab (Just v)) lww ))] $ toHtml tag | otherwise = what
div_ [class_ "info-block" ] do
h6_ [] "heads"
for_ (view repoHeadHeads rh) $ \(branch,v) -> do
div_ [ class_ "attrval onleft"] do
a_ [ href_ (toURL (RepoPage (CommitsTab (Just v)) lww ))
] do checkHead (Just v)
$ toHtml branch
div_ [class_ "info-block" ] do
h6_ [] "tags"
for_ (view repoHeadTags rh) $ \(tag,v) -> do
div_ [ class_ "attrval onleft"] do
a_ [href_ (toURL (RepoPage (CommitsTab (Just v)) lww ))]
do checkHead (Just v) $
toHtml tag
main_ do main_ do