Add task detail view with status form

Task-Id: t-1o2g8gugkr1.3 Amp-Thread-ID:
https://ampcode.com/threads/T-dc8aefa0-840e-412d-bc09-9c446be48117
Co-authored-by: Amp <amp@ampcode.com>

1 files changed, 216 insertions, 1 deletions

diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index f0036d1..7416604 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -7,6 +7,7 @@
 -- : dep servant-server
 -- : dep lucid
 -- : dep servant-lucid
+-- : dep http-api-data
 module Omni.Jr.Web
   ( run,
     defaultPort,
@@ -14,11 +15,13 @@ module Omni.Jr.Web
 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
@@ -26,11 +29,26 @@ 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 ()) =
@@ -109,11 +127,193 @@ instance Lucid.ToHtml TaskListPage where
               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
+server = homeHandler :<|> taskListHandler :<|> taskDetailHandler :<|> taskStatusHandler
   where
     homeHandler :: Servant.Handler HomePage
     homeHandler = pure (HomePage ())
@@ -123,6 +323,21 @@ server = homeHandler :<|> taskListHandler
       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