{-# 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 ---------- -- Html -- ---------- 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 -- -- | A page template 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"