commit 273208a8ffd714eb9cda51d557dbc62ff3009932
Author: Ben Sima <ben@bensima.com>
Date: Thu Nov 27 10:50:32 2025
HTMX interactive forms - status updates and filters
The build passes. The HTMX interactive forms for status updates
and filt
1. **Status update dropdown on task detail** (lines 176-197):
`statusBad
2. **Filter form on /tasks** (lines 322-378): The form has
`hx-get='/par
The only fix needed was changing `data TaskListPartial` to `newtype
Task
Task-Id: t-151.2
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 17849f4d..3c24d71c 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -58,13 +58,19 @@ type API =
:> QueryParam "namespace" Text
:> Get '[Lucid.HTML] TaskListPage
:<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
- :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> PostRedirect
+ :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
:<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> PostRedirect
:<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage
:<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect
:<|> "tasks" :> Capture "id" Text :> "reject" :> ReqBody '[FormUrlEncoded] RejectForm :> PostRedirect
:<|> "partials" :> "recent-activity" :> Get '[Lucid.HTML] RecentActivityPartial
:<|> "partials" :> "ready-count" :> Get '[Lucid.HTML] ReadyCountPartial
+ :<|> "partials"
+ :> "task-list"
+ :> QueryParam "status" Text
+ :> QueryParam "priority" Text
+ :> QueryParam "namespace" Text
+ :> Get '[Lucid.HTML] TaskListPartial
data CSS
@@ -103,6 +109,10 @@ newtype RecentActivityPartial = RecentActivityPartial [TaskCore.Task]
newtype ReadyCountPartial = ReadyCountPartial Int
+data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text
+
+newtype TaskListPartial = TaskListPartial [TaskCore.Task]
+
newtype RejectForm = RejectForm (Maybe Text)
instance FromForm RejectForm where
@@ -163,6 +173,29 @@ statusBadge status =
TaskCore.Done -> ("badge badge-done", "Done")
in Lucid.span_ [Lucid.class_ cls] label
+statusBadgeWithForm :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
+statusBadgeWithForm status tid =
+ Lucid.div_ [Lucid.id_ "status-badge-container", Lucid.class_ "status-badge-container"] <| do
+ statusBadge status
+ Lucid.select_
+ [ Lucid.name_ "status",
+ Lucid.class_ "status-select-inline",
+ Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/status"),
+ Lucid.makeAttribute "hx-target" "#status-badge-container",
+ Lucid.makeAttribute "hx-swap" "outerHTML"
+ ]
+ <| do
+ statusOptionHtmx TaskCore.Open status
+ statusOptionHtmx TaskCore.InProgress status
+ statusOptionHtmx TaskCore.Review status
+ statusOptionHtmx TaskCore.Approved status
+ statusOptionHtmx TaskCore.Done status
+ where
+ statusOptionHtmx :: (Monad m2) => TaskCore.Status -> TaskCore.Status -> Lucid.HtmlT m2 ()
+ statusOptionHtmx opt current =
+ let attrs = [Lucid.value_ (tshow opt)] <> [Lucid.selected_ "selected" | opt == current]
+ in Lucid.option_ attrs (Lucid.toHtml (tshow opt))
+
renderTaskCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
renderTaskCard t =
Lucid.a_
@@ -287,45 +320,61 @@ instance Lucid.ToHtml TaskListPage where
Lucid.h1_ <| Lucid.toHtml ("Tasks (" <> tshow (length tasks) <> ")")
Lucid.div_ [Lucid.class_ "filter-form"] <| do
- Lucid.form_ [Lucid.method_ "GET", Lucid.action_ "/tasks"] <| do
- Lucid.div_ [Lucid.class_ "filter-row"] <| do
- Lucid.div_ [Lucid.class_ "filter-group"] <| do
- Lucid.label_ [Lucid.for_ "status"] "Status:"
- Lucid.select_ [Lucid.name_ "status", Lucid.id_ "status", Lucid.class_ "filter-select"] <| do
- Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterStatus filters)) "All"
- statusFilterOption TaskCore.Open (filterStatus filters)
- statusFilterOption TaskCore.InProgress (filterStatus filters)
- statusFilterOption TaskCore.Review (filterStatus filters)
- statusFilterOption TaskCore.Approved (filterStatus filters)
- statusFilterOption TaskCore.Done (filterStatus filters)
-
- Lucid.div_ [Lucid.class_ "filter-group"] <| do
- Lucid.label_ [Lucid.for_ "priority"] "Priority:"
- Lucid.select_ [Lucid.name_ "priority", Lucid.id_ "priority", Lucid.class_ "filter-select"] <| do
- Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterPriority filters)) "All"
- priorityFilterOption TaskCore.P0 (filterPriority filters)
- priorityFilterOption TaskCore.P1 (filterPriority filters)
- priorityFilterOption TaskCore.P2 (filterPriority filters)
- priorityFilterOption TaskCore.P3 (filterPriority filters)
- priorityFilterOption TaskCore.P4 (filterPriority filters)
-
- Lucid.div_ [Lucid.class_ "filter-group"] <| do
- Lucid.label_ [Lucid.for_ "namespace"] "Namespace:"
- Lucid.input_
- [ Lucid.type_ "text",
- Lucid.name_ "namespace",
- Lucid.id_ "namespace",
- Lucid.class_ "filter-input",
- Lucid.placeholder_ "e.g. Omni/Jr",
- Lucid.value_ (fromMaybe "" (filterNamespace filters))
- ]
+ Lucid.form_
+ [ Lucid.method_ "GET",
+ Lucid.action_ "/tasks",
+ Lucid.makeAttribute "hx-get" "/partials/task-list",
+ Lucid.makeAttribute "hx-target" "#task-list",
+ Lucid.makeAttribute "hx-push-url" "/tasks",
+ Lucid.makeAttribute "hx-trigger" "submit, change from:select"
+ ]
+ <| do
+ Lucid.div_ [Lucid.class_ "filter-row"] <| do
+ Lucid.div_ [Lucid.class_ "filter-group"] <| do
+ Lucid.label_ [Lucid.for_ "status"] "Status:"
+ Lucid.select_ [Lucid.name_ "status", Lucid.id_ "status", Lucid.class_ "filter-select"] <| do
+ Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterStatus filters)) "All"
+ statusFilterOption TaskCore.Open (filterStatus filters)
+ statusFilterOption TaskCore.InProgress (filterStatus filters)
+ statusFilterOption TaskCore.Review (filterStatus filters)
+ statusFilterOption TaskCore.Approved (filterStatus filters)
+ statusFilterOption TaskCore.Done (filterStatus filters)
+
+ Lucid.div_ [Lucid.class_ "filter-group"] <| do
+ Lucid.label_ [Lucid.for_ "priority"] "Priority:"
+ Lucid.select_ [Lucid.name_ "priority", Lucid.id_ "priority", Lucid.class_ "filter-select"] <| do
+ Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterPriority filters)) "All"
+ priorityFilterOption TaskCore.P0 (filterPriority filters)
+ priorityFilterOption TaskCore.P1 (filterPriority filters)
+ priorityFilterOption TaskCore.P2 (filterPriority filters)
+ priorityFilterOption TaskCore.P3 (filterPriority filters)
+ priorityFilterOption TaskCore.P4 (filterPriority filters)
+
+ Lucid.div_ [Lucid.class_ "filter-group"] <| do
+ Lucid.label_ [Lucid.for_ "namespace"] "Namespace:"
+ Lucid.input_
+ [ Lucid.type_ "text",
+ Lucid.name_ "namespace",
+ Lucid.id_ "namespace",
+ Lucid.class_ "filter-input",
+ Lucid.placeholder_ "e.g. Omni/Jr",
+ Lucid.value_ (fromMaybe "" (filterNamespace filters))
+ ]
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter"
- Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "clear-btn"] "Clear"
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter"
+ Lucid.a_
+ [ Lucid.href_ "/tasks",
+ Lucid.class_ "clear-btn",
+ Lucid.makeAttribute "hx-get" "/partials/task-list",
+ Lucid.makeAttribute "hx-target" "#task-list",
+ Lucid.makeAttribute "hx-push-url" "/tasks"
+ ]
+ "Clear"
- if null tasks
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
- else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
+ Lucid.div_ [Lucid.id_ "task-list"] <| do
+ if null tasks
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
+ else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
where
maybeSelected :: (Eq a) => Maybe a -> Maybe a -> [Lucid.Attribute]
maybeSelected opt current = [Lucid.selected_ "selected" | opt == current]
@@ -372,7 +421,7 @@ instance Lucid.ToHtml TaskDetailPage where
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.span_ [Lucid.class_ "detail-value"] <| statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
Lucid.div_ [Lucid.class_ "detail-row"] <| do
Lucid.span_ [Lucid.class_ "detail-label"] "Priority:"
@@ -456,17 +505,6 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.class_ "review-link-btn"
]
"Review This Task"
-
- 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
@@ -476,11 +514,6 @@ instance Lucid.ToHtml TaskDetailPage where
TaskCore.P3 -> " (Low)"
TaskCore.P4 -> " (Backlog)"
- statusOption :: (Monad m) => TaskCore.Status -> TaskCore.Status -> Lucid.HtmlT m ()
- statusOption opt current =
- let attrs = [Lucid.value_ (tshow opt)] <> [Lucid.selected_ "selected" | opt == current]
- in Lucid.option_ attrs (Lucid.toHtml (tshow opt))
-
renderDependency :: (Monad m) => TaskCore.Dependency -> Lucid.HtmlT m ()
renderDependency dep =
Lucid.li_ <| do
@@ -727,6 +760,18 @@ instance Lucid.ToHtml ReadyCountPartial where
Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"]
<| Lucid.toHtml ("(" <> tshow count <> " tasks)")
+instance Lucid.ToHtml StatusBadgePartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (StatusBadgePartial status tid) =
+ statusBadgeWithForm status tid
+
+instance Lucid.ToHtml TaskListPartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (TaskListPartial tasks) =
+ if null tasks
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
+ else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
+
-- | Simple markdown renderer for epic descriptions
-- Supports: headers (#, ##, ###), lists (- or *), code blocks (```), inline code (`)
renderMarkdown :: (Monad m) => Text -> Lucid.HtmlT m ()
@@ -858,6 +903,7 @@ server =
:<|> taskRejectHandler
:<|> recentActivityHandler
:<|> readyCountHandler
+ :<|> taskListPartialHandler
where
styleHandler :: Servant.Handler LazyText.Text
styleHandler = pure Style.css
@@ -944,10 +990,10 @@ server =
activities <- liftIO (TaskCore.getActivitiesForTask tid)
pure (TaskDetailFound task tasks activities)
- taskStatusHandler :: Text -> StatusForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
+ taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
taskStatusHandler tid (StatusForm newStatus) = do
liftIO <| TaskCore.updateTaskStatus tid newStatus []
- pure <| addHeader ("/tasks/" <> tid) NoContent
+ pure (StatusBadgePartial newStatus tid)
taskDescriptionHandler :: Text -> DescriptionForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
taskDescriptionHandler tid (DescriptionForm desc) = do
@@ -1001,6 +1047,15 @@ server =
readyTasks <- liftIO TaskCore.getReadyTasks
pure (ReadyCountPartial (length readyTasks))
+ taskListPartialHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPartial
+ taskListPartialHandler maybeStatusText maybePriorityText maybeNamespace = do
+ allTasks <- liftIO TaskCore.loadTasks
+ let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
+ maybePriority = parsePriority =<< emptyToNothing maybePriorityText
+ filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace)
+ filteredTasks = applyFilters filters allTasks
+ pure (TaskListPartial filteredTasks)
+
getReviewInfo :: Text -> IO ReviewInfo
getReviewInfo tid = do
maybeCommit <- findCommitForTask tid