view-process-log is self-contained

This commit is contained in:
Filip Gralinski 2021-08-09 22:07:44 +02:00
parent 088dd75a3e
commit b432fdd0e5

View File

@ -13,7 +13,6 @@ import Yesod.WebSockets
import Handler.Runner import Handler.Runner
import System.Exit import System.Exit
import Handler.JWT
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as DTE import qualified Data.Text.Encoding as DTE
@ -146,26 +145,52 @@ getViewProgressWithWebSocketsJsonR jobId = do
getViewProgressLogR :: Int -> Handler Html getViewProgressLogR :: Int -> Handler Html
getViewProgressLogR jobId = do getViewProgressLogR jobId = do
webSockets $ consoleApp jobId webSockets $ consoleApp jobId
p <- widgetToPageContent logWidget p <- widgetToPageContent logSelfContainedWidget
hamletToRepHtml [hamlet| hamletToRepHtml [hamlet|
<html> <html>
<head> <head>
<title> <title>
#{pageTitle p} #{pageTitle p}
<style>
#outwindow {
border: 1px solid black;
margin-bottom: 1em;
color: white;
background-color: black;
padding: 10pt;
}
#outwindow pre {
color: white;
background-color: black;
}
#wait {
animation: blink 1s linear infinite;
}
@keyframes blink {
0% {
opacity: 0;
}
50% {
opacity: .5;
}
100% {
opacity: 1;
}
}
^{pageHead p} ^{pageHead p}
<body> <body>
^{pageBody p} ^{pageBody p}
|] |]
logHtmlContent :: WidgetFor site ()
logWidget = do logHtmlContent = [whamlet|
[whamlet|
<div #outwindow> <div #outwindow>
<div #output> <div #output>
<div #wait> <div #wait>
... PLEASE WAIT ... ... PLEASE WAIT ...
|] |]
toWidget [lucius|
logCssContent = [lucius|
#outwindow { #outwindow {
border: 1px solid black; border: 1px solid black;
margin-bottom: 1em; margin-bottom: 1em;
@ -192,7 +217,9 @@ logWidget = do
} }
} }
|] |]
toWidget [julius|
logJsContent :: JavascriptUrl url
logJsContent = [julius|
var url = document.URL, var url = document.URL,
output = document.getElementById("output"), output = document.getElementById("output"),
wait = document.getElementById("wait"), wait = document.getElementById("wait"),
@ -216,6 +243,21 @@ logWidget = do
|] |]
logWidget :: WidgetFor site ()
logWidget = do
logHtmlContent
toWidget logCssContent
toWidget logJsContent
logSelfContainedWidget :: WidgetFor site ()
logSelfContainedWidget = do
logHtmlContent
-- for some reason, CSS content be put directly in the HTML
-- so it was copied & pasted
-- toWidgetHead logCssContent
toWidgetBody logJsContent
getViewProgressWithWebSocketsR :: Int -> Handler Html getViewProgressWithWebSocketsR :: Int -> Handler Html
getViewProgressWithWebSocketsR jobId = do getViewProgressWithWebSocketsR jobId = do
webSockets $ consoleApp jobId webSockets $ consoleApp jobId