summaryrefslogtreecommitdiff
path: root/server/HtmlOrphans.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/HtmlOrphans.hs')
-rw-r--r--server/HtmlOrphans.hs25
1 files changed, 13 insertions, 12 deletions
diff --git a/server/HtmlOrphans.hs b/server/HtmlOrphans.hs
index 8b2df52..0472f24 100644
--- a/server/HtmlOrphans.hs
+++ b/server/HtmlOrphans.hs
@@ -26,8 +26,9 @@ import Lucid.Html5 (a_, body_, class_, code_, div_, em_, h1_, h2_,
h3_, h4_, h5_, head_, href_, html_, id_, li_,
link_, main_, p_, rel_, script_, span_, src_,
title_, type_, ul_)
-import Server (JobStatus (..), RemoteRef (reporef, repourl),
- prettySha, unState)
+import Server (JobStatus (..), Org (orgSlug),
+ RemoteRef (reporef, repourl), prettySha,
+ unState)
import Text.Dot (showDot)
import Types (Hint (Hint), Level (..))
@@ -62,16 +63,16 @@ instance ToHtml JobStatus where
instance ToHtml AdminOverview where
toHtml (AdminOverview state) = htmldoc $ do
h1_ "Map List"
- if null (view unState state)
- then em_ "(nothing yet)"
- else ul_ . flip M.foldMapWithKey (view unState state) $
- \sha1 (ref, status) -> li_ $ do
- case status of
- Pending -> badge Info "pending"
- (Linted res) -> toHtml $ maximumLintLevel res
- (Failed _) -> badge Error "system error"
- " "; a_ [href_ ("/status/"+|prettySha sha1|+"/")] $ do
- mono $ toHtml $ reporef ref; " on "; mono $ toHtml $ repourl ref
+ flip M.foldMapWithKey (view unState state) $ \org jobs -> do
+ h2_ (toHtml $ orgSlug org)
+ if null jobs then em_ "(nothing yet)"
+ else flip M.foldMapWithKey jobs $ \sha1 (ref, status) -> li_ $ do
+ case status of
+ Pending -> badge Info "pending"
+ (Linted res) -> toHtml $ maximumLintLevel res
+ (Failed _) -> badge Error "system error"
+ " "; a_ [href_ ("/status/"+|orgSlug org|+"/"+|prettySha sha1|+"/")] $ do
+ mono $ toHtml $ reporef ref; " on "; mono $ toHtml $ repourl ref
badge :: Monad m => Level -> HtmlT m () -> HtmlT m ()