{-# 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"