path: root/Omni/Jr/Web.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- : dep warp
-- : dep servant-server
-- : dep lucid
-- : dep servant-lucid
-- : dep http-api-data
module Omni.Jr.Web
  ( run,
    defaultPort,
  )
where

import Alpha
import qualified Data.Text as Text
import qualified Lucid
import qualified Network.Wai.Handler.Warp as Warp
import qualified Omni.Task.Core as TaskCore
import Servant
import qualified Servant.HTML.Lucid as Lucid
import Web.FormUrlEncoded (FromForm (..), parseUnique)

defaultPort :: Warp.Port
defaultPort = 8080

type API =
  Get '[Lucid.HTML] HomePage
    :<|> "tasks" :> Get '[Lucid.HTML] TaskListPage
    :<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
    :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] TaskDetailPage

newtype HomePage = HomePage ()

newtype TaskListPage = TaskListPage [TaskCore.Task]

data TaskDetailPage
  = TaskDetailFound TaskCore.Task [TaskCore.Task]
  | TaskDetailNotFound Text

newtype StatusForm = StatusForm TaskCore.Status

instance FromForm StatusForm where
  fromForm form = do
    statusText <- parseUnique "status" form
    case readMaybe (Text.unpack statusText) of
      Just s -> Right (StatusForm s)
      Nothing -> Left "Invalid status"

instance Lucid.ToHtml HomePage where
  toHtmlRaw = Lucid.toHtml
  toHtml (HomePage ()) =
    Lucid.doctypehtml_ <| do
      Lucid.head_ <| do
        Lucid.title_ "Jr Web UI"
        Lucid.meta_ [Lucid.charset_ "utf-8"]
        Lucid.meta_
          [ Lucid.name_ "viewport",
            Lucid.content_ "width=device-width, initial-scale=1"
          ]
      Lucid.body_ <| do
        Lucid.h1_ "Jr Web UI"
        Lucid.p_ <| Lucid.a_ [Lucid.href_ "/tasks"] "View Tasks"

instance Lucid.ToHtml TaskListPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (TaskListPage tasks) =
    Lucid.doctypehtml_ <| do
      Lucid.head_ <| do
        Lucid.title_ "Tasks - Jr Web UI"
        Lucid.meta_ [Lucid.charset_ "utf-8"]
        Lucid.meta_
          [ Lucid.name_ "viewport",
            Lucid.content_ "width=device-width, initial-scale=1"
          ]
        Lucid.style_ styles
      Lucid.body_ <| do
        Lucid.h1_ "Tasks"
        Lucid.div_ [Lucid.class_ "task-list"] <| do
          traverse_ renderTask tasks
    where
      styles :: Text
      styles =
        "* { box-sizing: border-box; } \
        \body { font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, sans-serif; \
        \       margin: 0; padding: 16px; background: #f5f5f5; } \
        \h1 { margin: 0 0 16px 0; } \
        \.task-list { display: flex; flex-direction: column; gap: 8px; } \
        \.task-card { background: white; border-radius: 8px; padding: 16px; \
        \             box-shadow: 0 1px 3px rgba(0,0,0,0.1); } \
        \.task-header { display: flex; flex-wrap: wrap; align-items: center; gap: 8px; margin-bottom: 8px; } \
        \.task-id { font-family: monospace; color: #0066cc; text-decoration: none; \
        \           font-size: 14px; padding: 4px 0; } \
        \.task-id:hover { text-decoration: underline; } \
        \.badge { display: inline-block; padding: 4px 8px; border-radius: 4px; \
        \         font-size: 12px; font-weight: 500; } \
        \.badge-open { background: #fef3c7; color: #92400e; } \
        \.badge-inprogress { background: #dbeafe; color: #1e40af; } \
        \.badge-review { background: #ede9fe; color: #6b21a8; } \
        \.badge-approved { background: #d1fae5; color: #065f46; } \
        \.badge-done { background: #d1fae5; color: #065f46; } \
        \.priority { font-size: 12px; color: #6b7280; } \
        \.task-title { font-size: 16px; margin: 0; }"

      renderTask :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
      renderTask t =
        Lucid.div_ [Lucid.class_ "task-card"] <| do
          Lucid.div_ [Lucid.class_ "task-header"] <| do
            Lucid.a_
              [ Lucid.class_ "task-id",
                Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
              ]
              (Lucid.toHtml (TaskCore.taskId t))
            statusBadge (TaskCore.taskStatus t)
            Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
          Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))

      statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
      statusBadge status =
        let (cls, label) = case status of
              TaskCore.Open -> ("badge badge-open", "Open")
              TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
              TaskCore.Review -> ("badge badge-review", "Review")
              TaskCore.Approved -> ("badge badge-approved", "Approved")
              TaskCore.Done -> ("badge badge-done", "Done")
         in Lucid.span_ [Lucid.class_ cls] label

instance Lucid.ToHtml TaskDetailPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (TaskDetailNotFound tid) =
    Lucid.doctypehtml_ <| do
      Lucid.head_ <| do
        Lucid.title_ "Task Not Found - Jr Web UI"
        Lucid.meta_ [Lucid.charset_ "utf-8"]
        Lucid.meta_
          [ Lucid.name_ "viewport",
            Lucid.content_ "width=device-width, initial-scale=1"
          ]
        Lucid.style_ detailStyles
      Lucid.body_ <| do
        Lucid.h1_ "Task Not Found"
        Lucid.p_ <| do
          "The task "
          Lucid.code_ (Lucid.toHtml tid)
          " could not be found."
        Lucid.p_ <| Lucid.a_ [Lucid.href_ "/tasks"] "← Back to Tasks"
  toHtml (TaskDetailFound task allTasks) =
    Lucid.doctypehtml_ <| do
      Lucid.head_ <| do
        Lucid.title_ <| Lucid.toHtml (TaskCore.taskId task <> " - Jr Web UI")
        Lucid.meta_ [Lucid.charset_ "utf-8"]
        Lucid.meta_
          [ Lucid.name_ "viewport",
            Lucid.content_ "width=device-width, initial-scale=1"
          ]
        Lucid.style_ detailStyles
      Lucid.body_ <| do
        Lucid.p_ <| Lucid.a_ [Lucid.href_ "/tasks"] "← Back to Tasks"

        Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task)

        Lucid.div_ [Lucid.class_ "task-detail"] <| do
          Lucid.div_ [Lucid.class_ "detail-row"] <| do
            Lucid.span_ [Lucid.class_ "detail-label"] "ID:"
            Lucid.code_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskId task))

          Lucid.div_ [Lucid.class_ "detail-row"] <| do
            Lucid.span_ [Lucid.class_ "detail-label"] "Type:"
            Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.taskType task)))

          Lucid.div_ [Lucid.class_ "detail-row"] <| do
            Lucid.span_ [Lucid.class_ "detail-label"] "Status:"
            Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadge (TaskCore.taskStatus task)

          Lucid.div_ [Lucid.class_ "detail-row"] <| do
            Lucid.span_ [Lucid.class_ "detail-label"] "Priority:"
            Lucid.span_ [Lucid.class_ "detail-value"] <| do
              Lucid.toHtml (tshow (TaskCore.taskPriority task))
              Lucid.span_ [Lucid.class_ "priority-desc"] (Lucid.toHtml (priorityDesc (TaskCore.taskPriority task)))

          case TaskCore.taskNamespace task of
            Nothing -> pure ()
            Just ns ->
              Lucid.div_ [Lucid.class_ "detail-row"] <| do
                Lucid.span_ [Lucid.class_ "detail-label"] "Namespace:"
                Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml ns)

          case TaskCore.taskParent task of
            Nothing -> pure ()
            Just pid ->
              Lucid.div_ [Lucid.class_ "detail-row"] <| do
                Lucid.span_ [Lucid.class_ "detail-label"] "Parent:"
                Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "detail-value task-link"] (Lucid.toHtml pid)

          Lucid.div_ [Lucid.class_ "detail-row"] <| do
            Lucid.span_ [Lucid.class_ "detail-label"] "Created:"
            Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.taskCreatedAt task)))

          Lucid.div_ [Lucid.class_ "detail-row"] <| do
            Lucid.span_ [Lucid.class_ "detail-label"] "Updated:"
            Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.taskUpdatedAt task)))

          let deps = TaskCore.taskDependencies task
          unless (null deps) <| do
            Lucid.div_ [Lucid.class_ "detail-section"] <| do
              Lucid.h3_ "Dependencies"
              Lucid.ul_ [Lucid.class_ "dep-list"] <| do
                traverse_ renderDependency deps

          case TaskCore.taskDescription task of
            Nothing -> pure ()
            Just desc ->
              Lucid.div_ [Lucid.class_ "detail-section"] <| do
                Lucid.h3_ "Description"
                Lucid.pre_ [Lucid.class_ "description"] (Lucid.toHtml desc)

          let children = filter (maybe False (TaskCore.matchesId (TaskCore.taskId task)) <. TaskCore.taskParent) allTasks
          unless (null children) <| do
            Lucid.div_ [Lucid.class_ "detail-section"] <| do
              Lucid.h3_ "Child Tasks"
              Lucid.ul_ [Lucid.class_ "child-list"] <| do
                traverse_ renderChild children

        Lucid.div_ [Lucid.class_ "status-form"] <| do
          Lucid.h3_ "Update Status"
          Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/status")] <| do
            Lucid.select_ [Lucid.name_ "status", Lucid.class_ "status-select"] <| do
              statusOption TaskCore.Open (TaskCore.taskStatus task)
              statusOption TaskCore.InProgress (TaskCore.taskStatus task)
              statusOption TaskCore.Review (TaskCore.taskStatus task)
              statusOption TaskCore.Approved (TaskCore.taskStatus task)
              statusOption TaskCore.Done (TaskCore.taskStatus task)
            Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Submit"
    where
      priorityDesc :: TaskCore.Priority -> Text
      priorityDesc p = case p of
        TaskCore.P0 -> " (Critical)"
        TaskCore.P1 -> " (High)"
        TaskCore.P2 -> " (Medium)"
        TaskCore.P3 -> " (Low)"
        TaskCore.P4 -> " (Backlog)"

      statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
      statusBadge status =
        let (cls, label) = case status of
              TaskCore.Open -> ("badge badge-open", "Open")
              TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
              TaskCore.Review -> ("badge badge-review", "Review")
              TaskCore.Approved -> ("badge badge-approved", "Approved")
              TaskCore.Done -> ("badge badge-done", "Done")
         in Lucid.span_ [Lucid.class_ cls] label

      statusOption :: (Monad m) => TaskCore.Status -> TaskCore.Status -> Lucid.HtmlT m ()
      statusOption opt current =
        let attrs = if opt == current then [Lucid.value_ (tshow opt), Lucid.selected_ "selected"] else [Lucid.value_ (tshow opt)]
         in Lucid.option_ attrs (Lucid.toHtml (tshow opt))

      renderDependency :: (Monad m) => TaskCore.Dependency -> Lucid.HtmlT m ()
      renderDependency dep =
        Lucid.li_ <| do
          Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.depId dep), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.depId dep))
          Lucid.span_ [Lucid.class_ "dep-type"] <| Lucid.toHtml (" [" <> tshow (TaskCore.depType dep) <> "]")

      renderChild :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
      renderChild child =
        Lucid.li_ <| do
          Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.taskId child), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.taskId child))
          Lucid.span_ [Lucid.class_ "child-title"] <| Lucid.toHtml (" - " <> TaskCore.taskTitle child)
          Lucid.span_ [Lucid.class_ "child-status"] <| Lucid.toHtml (" [" <> tshow (TaskCore.taskStatus child) <> "]")

detailStyles :: Text
detailStyles =
  "* { box-sizing: border-box; } \
  \body { font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, sans-serif; \
  \       margin: 0; padding: 16px; background: #f5f5f5; max-width: 800px; } \
  \h1 { margin: 16px 0; } \
  \h3 { margin: 16px 0 8px 0; color: #374151; } \
  \.task-detail { background: white; border-radius: 8px; padding: 16px; \
  \               box-shadow: 0 1px 3px rgba(0,0,0,0.1); } \
  \.detail-row { display: flex; padding: 8px 0; border-bottom: 1px solid #e5e7eb; } \
  \.detail-row:last-child { border-bottom: none; } \
  \.detail-label { font-weight: 600; width: 120px; color: #6b7280; } \
  \.detail-value { flex: 1; } \
  \.detail-section { margin-top: 16px; padding-top: 16px; border-top: 1px solid #e5e7eb; } \
  \.task-link { color: #0066cc; text-decoration: none; font-family: monospace; } \
  \.task-link:hover { text-decoration: underline; } \
  \.dep-list, .child-list { margin: 8px 0; padding-left: 20px; } \
  \.dep-list li, .child-list li { margin: 4px 0; } \
  \.dep-type { color: #6b7280; font-size: 14px; } \
  \.child-title { color: #374151; } \
  \.child-status { color: #6b7280; font-size: 14px; } \
  \.description { background: #f9fafb; padding: 12px; border-radius: 4px; \
  \               font-family: monospace; font-size: 14px; white-space: pre-wrap; margin: 0; } \
  \.priority-desc { color: #6b7280; margin-left: 4px; } \
  \.badge { display: inline-block; padding: 4px 8px; border-radius: 4px; \
  \         font-size: 12px; font-weight: 500; } \
  \.badge-open { background: #fef3c7; color: #92400e; } \
  \.badge-inprogress { background: #dbeafe; color: #1e40af; } \
  \.badge-review { background: #ede9fe; color: #6b21a8; } \
  \.badge-approved { background: #d1fae5; color: #065f46; } \
  \.badge-done { background: #d1fae5; color: #065f46; } \
  \.status-form { margin-top: 24px; background: white; border-radius: 8px; padding: 16px; \
  \               box-shadow: 0 1px 3px rgba(0,0,0,0.1); } \
  \.status-select { padding: 8px 12px; border: 1px solid #d1d5db; border-radius: 4px; \
  \                 font-size: 14px; margin-right: 8px; } \
  \.submit-btn { padding: 8px 16px; background: #0066cc; color: white; border: none; \
  \              border-radius: 4px; font-size: 14px; cursor: pointer; } \
  \.submit-btn:hover { background: #0052a3; }"

api :: Proxy API
api = Proxy

server :: Server API
server = homeHandler :<|> taskListHandler :<|> taskDetailHandler :<|> taskStatusHandler
  where
    homeHandler :: Servant.Handler HomePage
    homeHandler = pure (HomePage ())

    taskListHandler :: Servant.Handler TaskListPage
    taskListHandler = do
      tasks <- liftIO TaskCore.loadTasks
      pure (TaskListPage tasks)

    taskDetailHandler :: Text -> Servant.Handler TaskDetailPage
    taskDetailHandler tid = do
      tasks <- liftIO TaskCore.loadTasks
      case TaskCore.findTask tid tasks of
        Nothing -> pure (TaskDetailNotFound tid)
        Just task -> pure (TaskDetailFound task tasks)

    taskStatusHandler :: Text -> StatusForm -> Servant.Handler TaskDetailPage
    taskStatusHandler tid (StatusForm newStatus) = do
      liftIO <| TaskCore.updateTaskStatus tid newStatus []
      tasks <- liftIO TaskCore.loadTasks
      case TaskCore.findTask tid tasks of
        Nothing -> pure (TaskDetailNotFound tid)
        Just task -> pure (TaskDetailFound task tasks)

app :: Application
app = serve api server

run :: Warp.Port -> IO ()
run port = do
  putText <| "Starting Jr web server on port " <> tshow port
  Warp.run port app