commit 6333f4d8db56e26d384de9901cf0c990f8befec7
Author: Ben Sima <ben@bensima.com>
Date: Sat Nov 29 22:31:49 2025
Add clickable priority dropdown on task detail pages
The build passes successfully. Let me provide a summary of the
changes m
I implemented the clickable priority dropdown on task detail pages,
mirr
1. **Added new API route** for priority updates:
```haskell "tasks" :> Capture "id" Text :> "priority" :> ReqBody
'[FormUrlEncode ```
2. **Added new types**:
- `PriorityBadgePartial` - partial response for HTMX updates -
`PriorityForm` - form data for priority changes with `FromForm` ins
3. **Added handler** `taskPriorityHandler` that updates task
priority vi
4. **Added priority dropdown components**:
- `priorityBadgeWithForm` - container with clickable badge and
dropdo - `clickablePriorityBadge` - the clickable badge showing
current prio - `priorityDropdownOptions` - dropdown menu with
P0-P4 options - `priorityOption` - individual priority option with
HTMX form
5. **Added JavaScript** `priorityDropdownJs` for dropdown toggle/close
b
6. **Updated task detail page** to use `priorityBadgeWithForm`
instead o
7. **Added `ToHtml` instance** for `PriorityBadgePartial`
1. **Added priority badge styles** for P0-P4 with appropriate colors
2. **Added priority dropdown styles** (mirroring status dropdown)
3. **Added dark mode styles** for priority badges and dropdown
Task-Id: t-182
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index ece96ede..44e616ac 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -75,13 +75,6 @@ renderRelativeTimestamp now timestamp =
metaSep :: (Monad m) => Lucid.HtmlT m ()
metaSep = Lucid.span_ [Lucid.class_ "meta-sep"] "·"
-priorityDesc :: TaskCore.Priority -> Text
-priorityDesc TaskCore.P0 = "Critical"
-priorityDesc TaskCore.P1 = "High"
-priorityDesc TaskCore.P2 = "Normal"
-priorityDesc TaskCore.P3 = "Low"
-priorityDesc TaskCore.P4 = "Defer"
-
data TaskFilters = TaskFilters
{ filterStatus :: Maybe TaskCore.Status,
filterPriority :: Maybe TaskCore.Priority,
@@ -225,6 +218,7 @@ type API =
:<|> "epics" :> QueryParam "sort" Text :> Get '[Lucid.HTML] EpicsPage
:<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
:<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
+ :<|> "tasks" :> Capture "id" Text :> "priority" :> ReqBody '[FormUrlEncoded] PriorityForm :> Post '[Lucid.HTML] PriorityBadgePartial
:<|> "tasks" :> Capture "id" Text :> "description" :> "view" :> Get '[Lucid.HTML] DescriptionViewPartial
:<|> "tasks" :> Capture "id" Text :> "description" :> "edit" :> Get '[Lucid.HTML] DescriptionEditPartial
:<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> Post '[Lucid.HTML] DescriptionViewPartial
@@ -329,6 +323,8 @@ newtype ReadyCountPartial = ReadyCountPartial Int
data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text
+data PriorityBadgePartial = PriorityBadgePartial TaskCore.Priority Text
+
newtype TaskListPartial = TaskListPartial [TaskCore.Task]
data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime
@@ -351,6 +347,15 @@ instance FromForm StatusForm where
Just s -> Right (StatusForm s)
Nothing -> Left "Invalid status"
+newtype PriorityForm = PriorityForm TaskCore.Priority
+
+instance FromForm PriorityForm where
+ fromForm form = do
+ priorityText <- parseUnique "priority" form
+ case readMaybe (Text.unpack priorityText) of
+ Just p -> Right (PriorityForm p)
+ Nothing -> Left "Invalid priority"
+
newtype DescriptionForm = DescriptionForm Text
instance FromForm DescriptionForm where
@@ -382,6 +387,7 @@ pageHead title =
]
("" :: Text)
Lucid.script_ [] statusDropdownJs
+ Lucid.script_ [] priorityDropdownJs
Lucid.script_ [] navbarDropdownJs
navbarDropdownJs :: Text
@@ -482,6 +488,77 @@ statusDropdownJs =
"});"
]
+priorityDropdownJs :: Text
+priorityDropdownJs =
+ Text.unlines
+ [ "function togglePriorityDropdown(el) {",
+ " var container = el.parentElement;",
+ " var isOpen = container.classList.toggle('open');",
+ " el.setAttribute('aria-expanded', isOpen);",
+ " if (isOpen) {",
+ " var firstItem = container.querySelector('[role=\"menuitem\"]');",
+ " if (firstItem) firstItem.focus();",
+ " }",
+ "}",
+ "",
+ "function closePriorityDropdown(container) {",
+ " container.classList.remove('open');",
+ " var badge = container.querySelector('[role=\"button\"]');",
+ " if (badge) {",
+ " badge.setAttribute('aria-expanded', 'false');",
+ " badge.focus();",
+ " }",
+ "}",
+ "",
+ "function handlePriorityKeydown(event, el) {",
+ " if (event.key === 'Enter' || event.key === ' ') {",
+ " event.preventDefault();",
+ " togglePriorityDropdown(el);",
+ " } else if (event.key === 'Escape') {",
+ " closePriorityDropdown(el.parentElement);",
+ " } else if (event.key === 'ArrowDown') {",
+ " event.preventDefault();",
+ " var container = el.parentElement;",
+ " if (!container.classList.contains('open')) {",
+ " togglePriorityDropdown(el);",
+ " } else {",
+ " var firstItem = container.querySelector('[role=\"menuitem\"]');",
+ " if (firstItem) firstItem.focus();",
+ " }",
+ " }",
+ "}",
+ "",
+ "function handlePriorityMenuItemKeydown(event) {",
+ " var container = event.target.closest('.priority-badge-dropdown');",
+ " var items = container.querySelectorAll('[role=\"menuitem\"]');",
+ " var currentIndex = Array.from(items).indexOf(event.target);",
+ " ",
+ " if (event.key === 'ArrowDown') {",
+ " event.preventDefault();",
+ " var next = (currentIndex + 1) % items.length;",
+ " items[next].focus();",
+ " } else if (event.key === 'ArrowUp') {",
+ " event.preventDefault();",
+ " var prev = (currentIndex - 1 + items.length) % items.length;",
+ " items[prev].focus();",
+ " } else if (event.key === 'Escape') {",
+ " event.preventDefault();",
+ " closePriorityDropdown(container);",
+ " } else if (event.key === 'Tab') {",
+ " closePriorityDropdown(container);",
+ " }",
+ "}",
+ "",
+ "document.addEventListener('click', function(e) {",
+ " var dropdowns = document.querySelectorAll('.priority-badge-dropdown.open');",
+ " dropdowns.forEach(function(d) {",
+ " if (!d.contains(e.target)) {",
+ " closePriorityDropdown(d);",
+ " }",
+ " });",
+ "});"
+ ]
+
pageBody :: (Monad m) => Lucid.HtmlT m () -> Lucid.HtmlT m ()
pageBody content =
Lucid.body_ [Lucid.makeAttribute "hx-boost" "true"] <| do
@@ -718,6 +795,79 @@ statusOption opt currentStatus tid =
]
(Lucid.toHtml label)
+priorityBadgeWithForm :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
+priorityBadgeWithForm priority tid =
+ Lucid.div_
+ [ Lucid.id_ "priority-badge-container",
+ Lucid.class_ "priority-badge-dropdown"
+ ]
+ <| do
+ clickablePriorityBadge priority tid
+ priorityDropdownOptions priority tid
+
+clickablePriorityBadge :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
+clickablePriorityBadge priority _tid =
+ let (cls, label) = case priority of
+ TaskCore.P0 -> ("badge badge-p0 priority-badge-clickable", "P0 Critical" :: Text)
+ TaskCore.P1 -> ("badge badge-p1 priority-badge-clickable", "P1 High")
+ TaskCore.P2 -> ("badge badge-p2 priority-badge-clickable", "P2 Normal")
+ TaskCore.P3 -> ("badge badge-p3 priority-badge-clickable", "P3 Low")
+ TaskCore.P4 -> ("badge badge-p4 priority-badge-clickable", "P4 Defer")
+ in Lucid.span_
+ [ Lucid.class_ cls,
+ Lucid.tabindex_ "0",
+ Lucid.role_ "button",
+ Lucid.makeAttribute "aria-haspopup" "true",
+ Lucid.makeAttribute "aria-expanded" "false",
+ Lucid.makeAttribute "onclick" "togglePriorityDropdown(this)",
+ Lucid.makeAttribute "onkeydown" "handlePriorityKeydown(event, this)"
+ ]
+ <| do
+ Lucid.toHtml label
+ Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"
+
+priorityDropdownOptions :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
+priorityDropdownOptions currentPriority tid =
+ Lucid.div_
+ [ Lucid.class_ "priority-dropdown-menu",
+ Lucid.role_ "menu",
+ Lucid.makeAttribute "aria-label" "Change task priority"
+ ]
+ <| do
+ priorityOption TaskCore.P0 currentPriority tid
+ priorityOption TaskCore.P1 currentPriority tid
+ priorityOption TaskCore.P2 currentPriority tid
+ priorityOption TaskCore.P3 currentPriority tid
+ priorityOption TaskCore.P4 currentPriority tid
+
+priorityOption :: (Monad m) => TaskCore.Priority -> TaskCore.Priority -> Text -> Lucid.HtmlT m ()
+priorityOption opt currentPriority tid =
+ let (cls, label) = case opt of
+ TaskCore.P0 -> ("badge badge-p0", "P0 Critical" :: Text)
+ TaskCore.P1 -> ("badge badge-p1", "P1 High")
+ TaskCore.P2 -> ("badge badge-p2", "P2 Normal")
+ TaskCore.P3 -> ("badge badge-p3", "P3 Low")
+ TaskCore.P4 -> ("badge badge-p4", "P4 Defer")
+ isSelected = opt == currentPriority
+ optClass = cls <> " priority-dropdown-option" <> if isSelected then " selected" else ""
+ in Lucid.form_
+ [ Lucid.class_ "priority-option-form",
+ Lucid.role_ "none",
+ Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/priority"),
+ Lucid.makeAttribute "hx-target" "#priority-badge-container",
+ Lucid.makeAttribute "hx-swap" "outerHTML"
+ ]
+ <| do
+ Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "priority", Lucid.value_ (tshow opt)]
+ Lucid.button_
+ [ Lucid.type_ "submit",
+ Lucid.class_ optClass,
+ Lucid.role_ "menuitem",
+ Lucid.tabindex_ "-1",
+ Lucid.makeAttribute "onkeydown" "handlePriorityMenuItemKeydown(event)"
+ ]
+ (Lucid.toHtml label)
+
renderTaskCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
renderTaskCard t =
Lucid.a_
@@ -1290,9 +1440,7 @@ instance Lucid.ToHtml TaskDetailPage where
metaSep
statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
metaSep
- Lucid.span_ [Lucid.class_ "task-meta-priority"] <| do
- Lucid.toHtml (tshow (TaskCore.taskPriority task))
- Lucid.span_ [Lucid.class_ "priority-desc"] (Lucid.toHtml (priorityDesc (TaskCore.taskPriority task)))
+ priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task)
case TaskCore.taskNamespace task of
Nothing -> pure ()
Just ns -> do
@@ -1896,6 +2044,11 @@ instance Lucid.ToHtml StatusBadgePartial where
toHtml (StatusBadgePartial status tid) =
statusBadgeWithForm status tid
+instance Lucid.ToHtml PriorityBadgePartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (PriorityBadgePartial priority tid) =
+ priorityBadgeWithForm priority tid
+
instance Lucid.ToHtml TaskListPartial where
toHtmlRaw = Lucid.toHtml
toHtml (TaskListPartial tasks) =
@@ -2179,6 +2332,7 @@ server =
:<|> epicsHandler
:<|> taskDetailHandler
:<|> taskStatusHandler
+ :<|> taskPriorityHandler
:<|> descriptionViewHandler
:<|> descriptionEditHandler
:<|> descriptionPostHandler
@@ -2361,6 +2515,11 @@ server =
liftIO <| TaskCore.updateTaskStatus tid newStatus []
pure (StatusBadgePartial newStatus tid)
+ taskPriorityHandler :: Text -> PriorityForm -> Servant.Handler PriorityBadgePartial
+ taskPriorityHandler tid (PriorityForm newPriority) = do
+ _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskPriority = newPriority})
+ pure (PriorityBadgePartial newPriority tid)
+
descriptionViewHandler :: Text -> Servant.Handler DescriptionViewPartial
descriptionViewHandler tid = do
tasks <- liftIO TaskCore.loadTasks
diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs
index 02352ec4..fbaaa829 100644
--- a/Omni/Jr/Web/Style.hs
+++ b/Omni/Jr/Web/Style.hs
@@ -623,6 +623,66 @@ statusBadges = do
".status-badge-clickable" # focus ? do
Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
Stylesheet.key "outline-offset" ("2px" :: Text)
+ ".badge-p0" ? do
+ backgroundColor "#fee2e2"
+ color "#991b1b"
+ ".badge-p1" ? do
+ backgroundColor "#fef3c7"
+ color "#92400e"
+ ".badge-p2" ? do
+ backgroundColor "#dbeafe"
+ color "#1e40af"
+ ".badge-p3" ? do
+ backgroundColor "#e5e7eb"
+ color "#4b5563"
+ ".badge-p4" ? do
+ backgroundColor "#f3f4f6"
+ color "#6b7280"
+ ".priority-badge-dropdown" ? do
+ position relative
+ display inlineBlock
+ ".priority-badge-clickable" ? do
+ cursor pointer
+ Stylesheet.key "user-select" ("none" :: Text)
+ ".priority-badge-clickable" # hover ? do
+ opacity 0.85
+ ".priority-dropdown-menu" ? do
+ display none
+ position absolute
+ left (px 0)
+ top (pct 100)
+ marginTop (px 2)
+ backgroundColor white
+ borderRadius (px 4) (px 4) (px 4) (px 4)
+ Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text)
+ zIndex 100
+ padding (px 4) (px 4) (px 4) (px 4)
+ minWidth (px 100)
+ ".priority-badge-dropdown.open" |> ".priority-dropdown-menu" ? do
+ display block
+ ".priority-option-form" ? do
+ margin (px 0) (px 0) (px 0) (px 0)
+ padding (px 0) (px 0) (px 0) (px 0)
+ ".priority-dropdown-option" ? do
+ display block
+ width (pct 100)
+ textAlign (alignSide sideLeft)
+ margin (px 2) (px 0) (px 2) (px 0)
+ border (px 0) none transparent
+ cursor pointer
+ transition "opacity" (ms 150) ease (sec 0)
+ ".priority-dropdown-option" # hover ? do
+ opacity 0.7
+ ".priority-dropdown-option" # focus ? do
+ opacity 0.85
+ Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
+ Stylesheet.key "outline-offset" ("1px" :: Text)
+ ".priority-dropdown-option.selected" ? do
+ Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
+ Stylesheet.key "outline-offset" ("1px" :: Text)
+ ".priority-badge-clickable" # focus ? do
+ Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
+ Stylesheet.key "outline-offset" ("2px" :: Text)
buttonStyles :: Css
buttonStyles = do
@@ -1445,6 +1505,24 @@ darkModeStyles =
".badge-done" ? do
backgroundColor "#064e3b"
color "#6ee7b7"
+ ".badge-p0" ? do
+ backgroundColor "#7f1d1d"
+ color "#fca5a5"
+ ".badge-p1" ? do
+ backgroundColor "#78350f"
+ color "#fcd34d"
+ ".badge-p2" ? do
+ backgroundColor "#1e3a8a"
+ color "#93c5fd"
+ ".badge-p3" ? do
+ backgroundColor "#374151"
+ color "#d1d5db"
+ ".badge-p4" ? do
+ backgroundColor "#1f2937"
+ color "#9ca3af"
+ ".priority-dropdown-menu" ? do
+ backgroundColor "#1f2937"
+ Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.3)" :: Text)
".action-btn" ? do
backgroundColor "#374151"
borderColor "#4b5563"