commit 7966eb9ce705ac835b2336fcd6aedffebd54234d
Author: Ben Sima <ben@bensima.com>
Date: Sat Nov 29 23:42:43 2025
Expand intervention page to show all human action items
All tests pass and lint is clean. The implementation is complete:
**Changes made:**
1. **Omni/Task/Core.hs:**
- Added `EpicForReview` data type to hold epic with progress info -
Added `HumanActionItems` data type to group all three categories -
Added `getHumanActionItems` function that returns:
- `failedTasks`: Tasks with retry_attempt >= 3 - `epicsInReview`:
Epics where all children are Done (and has at le - `humanTasks`:
HumanTask type tasks in Open status
2. **Omni/Jr/Web.hs:**
- Updated `InterventionPage` data type to use `HumanActionItems`
- Updated `interventionHandler` to call `getHumanActionItems` -
Rewrote `ToHtml InterventionPage` to show 3 sections with headers -
Added `renderEpicReviewCard` for epic review cards with "Approve &
- Renamed navbar link from "Intervention" to "Human Action"
Task-Id: t-193.5
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 5f0da6d0..befda940 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -256,7 +256,7 @@ data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] SortOrder UTCTime
data BlockedPage = BlockedPage [(TaskCore.Task, Int)] SortOrder UTCTime
-data InterventionPage = InterventionPage [TaskCore.Task] SortOrder UTCTime
+data InterventionPage = InterventionPage TaskCore.HumanActionItems SortOrder UTCTime
data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters SortOrder UTCTime
@@ -645,7 +645,7 @@ navbar =
Lucid.div_ [Lucid.class_ "navbar-dropdown-content"] <| do
Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "navbar-dropdown-item"] "Ready"
Lucid.a_ [Lucid.href_ "/blocked", Lucid.class_ "navbar-dropdown-item"] "Blocked"
- Lucid.a_ [Lucid.href_ "/intervention", Lucid.class_ "navbar-dropdown-item"] "Intervention"
+ Lucid.a_ [Lucid.href_ "/intervention", Lucid.class_ "navbar-dropdown-item"] "Human Action"
Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "navbar-dropdown-item"] "All"
Lucid.div_ [Lucid.class_ "navbar-dropdown"] <| do
Lucid.button_ [Lucid.class_ "navbar-dropdown-btn"] "Plans ▾"
@@ -1053,19 +1053,61 @@ instance Lucid.ToHtml BlockedPage where
instance Lucid.ToHtml InterventionPage where
toHtmlRaw = Lucid.toHtml
- toHtml (InterventionPage tasks currentSort _now) =
- let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Needs Intervention" Nothing]
+ toHtml (InterventionPage actionItems currentSort _now) =
+ let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Needs Human Action" Nothing]
+ failed = TaskCore.failedTasks actionItems
+ epicsReady = TaskCore.epicsInReview actionItems
+ human = TaskCore.humanTasks actionItems
+ totalCount = length failed + length epicsReady + length human
in Lucid.doctypehtml_ <| do
- pageHead "Needs Intervention - Jr"
+ pageHead "Needs Human Action - Jr"
pageBodyWithCrumbs crumbs <| do
Lucid.div_ [Lucid.class_ "container"] <| do
Lucid.div_ [Lucid.class_ "page-header-row"] <| do
- Lucid.h1_ <| Lucid.toHtml ("Needs Intervention (" <> tshow (length tasks) <> " tasks)")
+ Lucid.h1_ <| Lucid.toHtml ("Needs Human Action (" <> tshow totalCount <> " items)")
sortDropdown "/intervention" currentSort
- Lucid.p_ [Lucid.class_ "info-msg"] "Tasks that have failed 3+ times and need human help."
- if null tasks
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks need intervention."
- else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
+ if totalCount == 0
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "No items need human action."
+ else do
+ unless (null failed) <| do
+ Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Failed Tasks (" <> tshow (length failed) <> ")")
+ Lucid.p_ [Lucid.class_ "info-msg"] "Tasks that have failed 3+ times and need human help."
+ Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard (sortTasks currentSort failed)
+ unless (null epicsReady) <| do
+ Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Epics Ready for Review (" <> tshow (length epicsReady) <> ")")
+ Lucid.p_ [Lucid.class_ "info-msg"] "Epics with all children completed. Verify before closing."
+ Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderEpicReviewCard epicsReady
+ unless (null human) <| do
+ Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Human Tasks (" <> tshow (length human) <> ")")
+ Lucid.p_ [Lucid.class_ "info-msg"] "Tasks explicitly marked as needing human work."
+ Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard (sortTasks currentSort human)
+
+renderEpicReviewCard :: (Monad m) => TaskCore.EpicForReview -> Lucid.HtmlT m ()
+renderEpicReviewCard epicReview = do
+ let task = TaskCore.epicTask epicReview
+ total = TaskCore.epicTotal epicReview
+ completed = TaskCore.epicCompleted epicReview
+ progressText = tshow completed <> "/" <> tshow total <> " subtasks done"
+ Lucid.div_ [Lucid.class_ "task-card"] <| do
+ Lucid.div_ [Lucid.class_ "task-card-header"] <| do
+ Lucid.div_ [Lucid.class_ "task-title-row"] <| do
+ Lucid.a_
+ [Lucid.href_ ("/tasks/" <> TaskCore.taskId task), Lucid.class_ "task-link"]
+ <| Lucid.toHtml (TaskCore.taskTitle task)
+ Lucid.span_ [Lucid.class_ "badge badge-epic"] "Epic"
+ Lucid.span_ [Lucid.class_ "task-id"] <| Lucid.toHtml (TaskCore.taskId task)
+ Lucid.div_ [Lucid.class_ "task-card-body"] <| do
+ Lucid.div_ [Lucid.class_ "progress-info"] <| do
+ Lucid.span_ [Lucid.class_ "badge badge-success"] <| Lucid.toHtml progressText
+ Lucid.div_ [Lucid.class_ "epic-actions"] <| do
+ Lucid.form_
+ [ Lucid.method_ "POST",
+ Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/status"),
+ Lucid.class_ "inline-form"
+ ]
+ <| do
+ Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "status", Lucid.value_ "done"]
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-success btn-sm"] "Approve & Close"
instance Lucid.ToHtml KBPage where
toHtmlRaw = Lucid.toHtml
@@ -2446,10 +2488,9 @@ server =
interventionHandler :: Maybe Text -> Servant.Handler InterventionPage
interventionHandler maybeSortText = do
now <- liftIO getCurrentTime
- interventionTasks <- liftIO TaskCore.getInterventionTasks
+ actionItems <- liftIO TaskCore.getHumanActionItems
let sortOrder = parseSortOrder maybeSortText
- sortedTasks = sortTasks sortOrder interventionTasks
- pure (InterventionPage sortedTasks sortOrder now)
+ pure (InterventionPage actionItems sortOrder now)
statsHandler :: Maybe Text -> Servant.Handler StatsPage
statsHandler maybeEpic = do
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index e4986c1c..07c74fc1 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -74,6 +74,20 @@ data TaskProgress = TaskProgress
}
deriving (Show, Eq, Generic)
+data EpicForReview = EpicForReview
+ { epicTask :: Task,
+ epicTotal :: Int,
+ epicCompleted :: Int
+ }
+ deriving (Show, Eq, Generic)
+
+data HumanActionItems = HumanActionItems
+ { failedTasks :: [Task],
+ epicsInReview :: [EpicForReview],
+ humanTasks :: [Task]
+ }
+ deriving (Show, Eq, Generic)
+
data AggregatedMetrics = AggregatedMetrics
{ aggTotalCostCents :: Int,
aggTotalDurationSeconds :: Int,
@@ -1429,6 +1443,35 @@ getInterventionTasks = do
let highRetryIds = [retryTaskId ctx | ctx <- retryContexts, retryAttempt ctx >= 3]
pure [t | t <- allTasks, taskId t `elem` highRetryIds]
+-- | Get all items needing human action
+getHumanActionItems :: IO HumanActionItems
+getHumanActionItems = do
+ allTasks <- loadTasks
+ retryContexts <- getAllRetryContexts
+ let highRetryIds = [retryTaskId ctx | ctx <- retryContexts, retryAttempt ctx >= 3]
+ failed = [t | t <- allTasks, taskId t `elem` highRetryIds]
+ epics = [t | t <- allTasks, taskType t == Epic, taskStatus t /= Done]
+ epicsReady =
+ [ EpicForReview
+ { epicTask = e,
+ epicTotal = total,
+ epicCompleted = completed
+ }
+ | e <- epics,
+ let children = [c | c <- allTasks, taskParent c == Just (taskId e)],
+ let total = length children,
+ total > 0,
+ let completed = length [c | c <- children, taskStatus c == Done],
+ completed == total
+ ]
+ human = [t | t <- allTasks, taskType t == HumanTask, taskStatus t == Open]
+ pure
+ HumanActionItems
+ { failedTasks = failed,
+ epicsInReview = epicsReady,
+ humanTasks = human
+ }
+
-- | Get all retry contexts from the database
getAllRetryContexts :: IO [RetryContext]
getAllRetryContexts =