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

1 files changed, 112 insertions, 57 deletions

diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 17849f4..3c24d71 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