commit 7fc62d7c86e3eab1131081064ede575594024b16
Author: Ben Sima <ben@bensima.com>
Date: Wed Nov 26 06:15:49 2025
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>
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index f0036d15..7416604b 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