server: add a very simple relint button

1 files changed, 16 insertions, 2 deletions

diff --git a/server/HtmlOrphans.hs b/server/HtmlOrphans.hs
index 9b09f1d..9475045 100644
--- a/server/HtmlOrphans.hs
+++ b/server/HtmlOrphans.hs
@@ -20,7 +20,7 @@ import           CheckMap        (MapResult (..))
 import           Data.List.Extra (escapeJSON)
 import qualified Data.Map        as M
 import           Handlers        (AdminOverview (..))
-import           Lucid           (HtmlT, ToHtml)
+import           Lucid           (HtmlT, ToHtml, button_, onclick_)
 import           Lucid.Base      (ToHtml (toHtml))
 import           Lucid.Html5     (a_, body_, class_, code_, div_, em_, h1_, h2_,
                                   h3_, h4_, h5_, head_, href_, html_, id_, li_,
@@ -53,7 +53,21 @@ instance ToHtml JobStatus where
         p_ "(please note that this site won't auto-reload, you'll have to refresh it yourself)"
       Linted res _rev -> do
         h1_ "Linter Result"
+        button_ [onclick_ "relint()", class_ "btn btn-primary", id_ "relint_button"] "relint"
         toHtml res
+        script_
+          "function relint() {\n\
+          \  var xhr = new XMLHttpRequest ();\n\
+          \  xhr.open('POST', 'relint', true);\n\
+          \  xhr.onreadystatechange = (e) => {if (xhr.status == 200) {\n\
+          \    console.log(e);\n\
+          \    let btn = document.getElementById('relint_button');\n\
+          \    btn.innerText = 'pending … (please reload)';\n\
+          \    btn.disabled = true;\n\
+          \    btn.class = 'btn btn-disabled';\n\
+          \  }}\n\
+          \  xhr.send(null);\n\
+          \}"
       Failed err -> do
         h1_ "System Error"
         p_ $ "error: " <> toHtml err
@@ -62,7 +76,7 @@ instance ToHtml JobStatus where
 instance ToHtml AdminOverview where
   toHtml (AdminOverview state) = htmldoc $ do
     h1_ "Map List"
-    flip M.foldMapWithKey (view unState state) $ \org jobs -> do
+    forM_ (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