{-# LANGUAGE OverloadedStrings #-}
module Web.JobsUi.Html where
import Web.JobsUi.Internal.Types
import Data.Time
import Data.Foldable
import Control.Monad
import qualified Data.Text as T
import qualified Lucid as H
import Lucid.Html5 hiding (for_)
import Text.Time.Pretty
displayJobsList :: Jobs -> Html
displayJobsList Jobs{..} = do
div_ [ class_ "jobs three columns" ] $ do
h3_ "Jobs"
ul_ [ class_ "jobs-list" ] $ do
for_ waiting $ \job ->
displayJobInList Waiting job
for_ running $ \job ->
displayJobInList Running job
for_ done $ \job ->
displayJobInList Done job
displayJobInList :: JobStatus -> Job -> Html
displayJobInList status job@Job{..} =
li_ [ class_ $ ppJobStatus job status ] $
a_ [ href_ $ T.pack $ "/job/" <> show jobId, class_ $ ppJobStatus job status ] $
H.toHtml $ "Job #" <> show jobId
ppJobStatus :: Job -> JobStatus -> T.Text
ppJobStatus Job{..} = \case
Waiting -> "waiting-job"
Running -> "running-job"
Done -> case jobFinished of
Nothing -> "done-job"
Just Error{} -> "failed-job"
Just Success{} -> "success-job"
displayJob :: JobStatus -> Job -> Html
displayJob status job@Job{..} = do
div_ [ class_ "job nine columns" ] $ do
when (status /= Done) $
form_ [ action_ $ T.pack $ "/job/" <> show (getJobId jobId) <> "/cancel" ] $
input_ [ class_ "cancel-btn", type_ "submit", value_ "Cancel Job" ]
h3_ $ H.toHtml $ "Job #" <> show jobId
table_ [ class_ "jobinfo" ] $ do
tr_ $ do
th_ [ scope_ "col" ] ""
th_ [ scope_ "col" ] ""
tr_ $ do
td_ $ "Type"
td_ $ H.toHtml $ getJobType job
tr_ $ do
td_ "Status"
td_ [class_ $ ppJobStatus job status] $ H.toHtml $ show status
tr_ $ do
td_ "Queued Time"
td_ $ H.toHtml $ myFormatTime jobTimeQueued
case (jobTimeStarted, jobTimeEnded) of
(Nothing, Nothing) -> pure ()
(Just ts, Nothing) ->
tr_ $ do
td_ "Start Time"
td_ $ H.toHtml $ myFormatTime ts
(Nothing, Just te) ->
tr_ $ do
td_ "End Time"
td_ $ H.toHtml $ myFormatTime te
(Just ts, Just te) -> do
tr_ $ do
td_ "Start Time"
td_ $ H.toHtml $ myFormatTime ts
tr_ $ do
td_ "End Time"
td_ $ H.toHtml $ myFormatTime te
tr_ $ do
td_ "Finished"
td_ $ H.toHtml $
prettyTimeAuto (zonedTimeToUTC ts) (zonedTimeToUTC te)
table_ [ class_ "params" ] $ do
th_ [ scope_ "col" ] ""
th_ [ scope_ "col" ] ""
for_ (zip (jiInputs jobInfo) (getJobParams job)) displayParam
case jobFinished of
Nothing -> pure ()
Just (Success str) -> do
div_ [ class_ "result" ] $ do
h5_ [ class_ $ ppJobStatus job status ] "Succeeded:"
pre_ $ H.toHtml str
Just (Error str) -> do
div_ [ class_ "result" ] $ do
h5_ [ class_ $ ppJobStatus job status ] "Failed:"
pre_ $ H.toHtml str
myFormatTime :: ZonedTime -> Html
myFormatTime = H.toHtml . formatTime defaultTimeLocale "%Y-%m-%d %T %Z"
displayParam :: (Param, T.Text) -> Html
displayParam (Param{..}, val) =
tr_ $ do
td_ $ label_ $ H.toHtml paramDesc
td_ $ case paramInputType of
TextInput ->
input_ [ disabled_ "", value_ val ]
TextOptions _ ->
select_ [ disabled_ "", value_ val ] $
option_ [ value_ val, selected_ "" ] $ H.toHtml val
template :: T.Text -> Html -> Html
template subtitle body =
doctypehtml_ $ do
head_ $ do
meta_ [ charset_ "utf-8" ]
title_ $ H.toHtml $ T.intercalate " - " [title, subtitle]
meta_ [ name_ "viewport", content_ "width=device-width, initial-scale=1" ]
link_ [ rel_ "stylesheet", type_ "text/css", href_ "/css/normalize.css" ]
link_ [ rel_ "stylesheet", type_ "text/css", href_ "/css/skeleton.css" ]
link_ [ rel_ "stylesheet", type_ "text/css", href_ "/css/jobs-ui.css" ]
body_ $ do
div_ [class_ "container"] $ do
div_ [ class_ "top row" ] $ do
header_ [ class_ "seven columns" ] $ do
h1_ $ a_ [ href_ "/" ] $ H.toHtml title
ul_ [ class_ "navigation" ] $
li_ $
form_ [ action_ "/job/create" ] $
input_ [ type_ "submit", value_ "Create New Job" ]
div_ [id_ "main", class_ "row" ] body
title :: T.Text
title = "Jobs UI"