From 3e0026151485858de6025f27eebe1f941329687a Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Wed, 16 Feb 2022 03:07:35 +0100
Subject: server: repositores & orgs fixed in config

a very simple setup that might be usable for divoc and similar small events
---
 server/HtmlOrphans.hs | 24 +++++++++++++-----------
 1 file changed, 13 insertions(+), 11 deletions(-)

(limited to 'server/HtmlOrphans.hs')

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
 
 
-- 
cgit v1.2.3