summaryrefslogtreecommitdiff
path: root/server/HtmlOrphans.hs
diff options
context:
space:
mode:
authorstuebinm2022-02-16 03:07:35 +0100
committerstuebinm2022-03-19 19:26:32 +0100
commit3e0026151485858de6025f27eebe1f941329687a (patch)
treeb98daf620f731c760844bebdc28963453e3e7465 /server/HtmlOrphans.hs
parentac81f4a118cc7a067ff26d8f4fd30410cac07e3c (diff)
server: repositores & orgs fixed in config
a very simple setup that might be usable for divoc and similar small events
Diffstat (limited to 'server/HtmlOrphans.hs')
-rw-r--r--server/HtmlOrphans.hs24
1 files changed, 13 insertions, 11 deletions
diff --git a/server/HtmlOrphans.hs b/server/HtmlOrphans.hs
index 4d03234..8b2df52 100644
--- a/server/HtmlOrphans.hs
+++ b/server/HtmlOrphans.hs
@@ -19,18 +19,21 @@ import CheckDir (DirResult (..), MissingAsset (MissingAsset),
import CheckMap (MapResult (..))
import Data.List.Extra (escapeJSON)
import qualified Data.Map as M
+import Handlers (AdminOverview (..))
import Lucid (HtmlT, ToHtml)
import Lucid.Base (ToHtml (toHtml))
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 (AdminOverview (..), JobStatus (..),
- RemoteRef (reporef, repourl), jobs, registry)
+import Server (JobStatus (..), RemoteRef (reporef, repourl),
+ prettySha, unState)
import Text.Dot (showDot)
import Types (Hint (Hint), Level (..))
+import Fmt
+
mono :: Monad m => HtmlT m () -> HtmlT m ()
mono = code_ [class_ "small text-muted"]
@@ -59,16 +62,15 @@ instance ToHtml JobStatus where
instance ToHtml AdminOverview where
toHtml (AdminOverview state) = htmldoc $ do
h1_ "Map List"
- if null (view registry state)
+ if null (view unState state)
then em_ "(nothing yet)"
- else ul_ . flip M.foldMapWithKey (view registry state)
- $ \uuid ref -> li_ $ do
- case M.lookup ref (view jobs state) of
- Just Pending -> badge Info "pending"
- Just (Linted res) -> toHtml $ maximumLintLevel res
- Just (Failed _) -> badge Error "system error"
- Nothing -> toHtml Fatal
- " "; a_ [href_ ("/status/"<>show uuid)] $ do
+ 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