diff options
Diffstat (limited to 'server/HtmlOrphans.hs')
| -rw-r--r-- | server/HtmlOrphans.hs | 43 |
1 files changed, 29 insertions, 14 deletions
diff --git a/server/HtmlOrphans.hs b/server/HtmlOrphans.hs index 9475045..b90ea6d 100644 --- a/server/HtmlOrphans.hs +++ b/server/HtmlOrphans.hs @@ -20,11 +20,12 @@ import CheckMap (MapResult (..)) import Data.List.Extra (escapeJSON) import qualified Data.Map as M import Handlers (AdminOverview (..)) -import Lucid (HtmlT, ToHtml, button_, onclick_) +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_, +import Lucid.Html5 (a_, body_, button_, class_, code_, disabled_, + div_, em_, h1_, h2_, h3_, h4_, h5_, head_, + href_, html_, id_, li_, link_, main_, + onclick_, p_, rel_, script_, span_, src_, title_, type_, ul_) import Server (JobStatus (..), Org (orgSlug), RemoteRef (reporef, repourl), prettySha, @@ -48,12 +49,15 @@ htmldoc inner = html_ $ do instance ToHtml JobStatus where toHtml status = htmldoc $ case status of - Pending -> do + Pending _ -> do h1_ "Pending …" p_ "(please note that this site won't auto-reload, you'll have to refresh it yourself)" - Linted res _rev -> do + autoReloadScript + Linted res _rev (pending, _) -> do h1_ "Linter Result" - button_ [onclick_ "relint()", class_ "btn btn-primary", id_ "relint_button"] "relint" + if pending + then button_ [class_ "btn btn-primary btn-disabled", disabled_ "true"] "pending …" + else button_ [onclick_ "relint()", class_ "btn btn-primary", id_ "relint_button"] "relint" toHtml res script_ "function relint() {\n\ @@ -61,17 +65,28 @@ instance ToHtml JobStatus where \ 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\ \}" + autoReloadScript Failed err -> do h1_ "System Error" p_ $ "error: " <> toHtml err p_ "you should probably ping an admin about this or sth" + where + autoReloadScript = script_ + "let ws = new WebSocket('ws://localhost:8080' + window.location.pathname + 'realtime');\n\ + \ws.onmessage = (event) => {\n\ + \ let resp = JSON.parse(event.data);\n\ + \ if (resp == 'RelintPending') {\n\ + \ let btn = document.getElementById('relint_button');\n\ + \ btn.innerText = 'pending …';\n\ + \ btn.disabled = true;\n\ + \ btn.class = 'btn btn-disabled';\n\ + \ } else if (resp == 'Reload') {\n\ + \ location.reload();\n\ + \ }\n\ + \}" instance ToHtml AdminOverview where toHtml (AdminOverview state) = htmldoc $ do @@ -81,9 +96,9 @@ instance ToHtml AdminOverview where 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 rev) -> toHtml $ maximumLintLevel res - (Failed _) -> badge Error "system error" + Pending _ -> badge Info "pending" + (Linted res rev _) -> 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 |