commit 33832022b7b4e3cd22f2503c09537af1e577d973
Author: Ben Sima <ben@bensima.com>
Date: Thu Nov 27 10:22:47 2025
Add views for blocked and needs-intervention tasks
The build passes with no errors. The implementation was already
in place
Task-Id: t-149.6
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 759f42e2..7ca2ec39 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -48,6 +48,8 @@ type API =
Get '[Lucid.HTML] HomePage
:<|> "style.css" :> Get '[CSS] LazyText.Text
:<|> "ready" :> Get '[Lucid.HTML] ReadyQueuePage
+ :<|> "blocked" :> Get '[Lucid.HTML] BlockedPage
+ :<|> "intervention" :> Get '[Lucid.HTML] InterventionPage
:<|> "stats" :> QueryParam "epic" Text :> Get '[Lucid.HTML] StatsPage
:<|> "tasks"
:> QueryParam "status" Text
@@ -72,6 +74,10 @@ data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task]
newtype ReadyQueuePage = ReadyQueuePage [TaskCore.Task]
+newtype BlockedPage = BlockedPage [TaskCore.Task]
+
+newtype InterventionPage = InterventionPage [TaskCore.Task]
+
data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters
data TaskDetailPage
@@ -122,6 +128,8 @@ navbar =
Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-link"] "Dashboard"
Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "navbar-link"] "Tasks"
Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "navbar-link"] "Ready"
+ Lucid.a_ [Lucid.href_ "/blocked", Lucid.class_ "navbar-link"] "Blocked"
+ Lucid.a_ [Lucid.href_ "/intervention", Lucid.class_ "navbar-link"] "Intervention"
Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "navbar-link"] "Stats"
statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
@@ -160,6 +168,8 @@ instance Lucid.ToHtml HomePage where
Lucid.div_ [Lucid.class_ "actions"] <| do
Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "action-btn"] "View All Tasks"
Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "action-btn action-btn-primary"] "View Ready Queue"
+ Lucid.a_ [Lucid.href_ "/blocked", Lucid.class_ "action-btn"] "View Blocked"
+ Lucid.a_ [Lucid.href_ "/intervention", Lucid.class_ "action-btn"] "Needs Intervention"
Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "action-btn"] "View Statistics"
Lucid.h2_ "Task Status"
@@ -206,6 +216,34 @@ instance Lucid.ToHtml ReadyQueuePage where
then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks are ready for work."
else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
+instance Lucid.ToHtml BlockedPage where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (BlockedPage tasks) =
+ Lucid.doctypehtml_ <| do
+ pageHead "Blocked Tasks - Jr"
+ Lucid.body_ <| do
+ navbar
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.h1_ <| Lucid.toHtml ("Blocked Tasks (" <> tshow (length tasks) <> " tasks)")
+ Lucid.p_ [Lucid.class_ "info-msg"] "Tasks with unmet blocking dependencies."
+ if null tasks
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "No blocked tasks."
+ else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
+
+instance Lucid.ToHtml InterventionPage where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (InterventionPage tasks) =
+ Lucid.doctypehtml_ <| do
+ pageHead "Needs Intervention - Jr"
+ Lucid.body_ <| do
+ navbar
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.h1_ <| Lucid.toHtml ("Needs Intervention (" <> tshow (length tasks) <> " tasks)")
+ 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
+
instance Lucid.ToHtml TaskListPage where
toHtmlRaw = Lucid.toHtml
toHtml (TaskListPage tasks filters) =
@@ -630,6 +668,8 @@ server =
homeHandler
:<|> styleHandler
:<|> readyQueueHandler
+ :<|> blockedHandler
+ :<|> interventionHandler
:<|> statsHandler
:<|> taskListHandler
:<|> taskDetailHandler
@@ -655,6 +695,18 @@ server =
let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) readyTasks
pure (ReadyQueuePage sortedTasks)
+ blockedHandler :: Servant.Handler BlockedPage
+ blockedHandler = do
+ blockedTasks <- liftIO TaskCore.getBlockedTasks
+ let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) blockedTasks
+ pure (BlockedPage sortedTasks)
+
+ interventionHandler :: Servant.Handler InterventionPage
+ interventionHandler = do
+ interventionTasks <- liftIO TaskCore.getInterventionTasks
+ let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) interventionTasks
+ pure (InterventionPage sortedTasks)
+
statsHandler :: Maybe Text -> Servant.Handler StatsPage
statsHandler maybeEpic = do
let epicId = emptyToNothing maybeEpic
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index 4e655813..3a71900d 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -1026,3 +1026,47 @@ getActivitiesForTask tid =
where
readStage :: Text -> ActivityStage
readStage s = fromMaybe Claiming (readMaybe (T.unpack s))
+
+-- | Get tasks with unmet blocking dependencies (not ready, not done)
+getBlockedTasks :: IO [Task]
+getBlockedTasks = do
+ allTasks <- loadTasks
+ readyTasks <- getReadyTasks
+ let readyIds = map taskId readyTasks
+ doneIds = [taskId t | t <- allTasks, taskStatus t == Done]
+ isBlocked task =
+ taskStatus task
+ `elem` [Open, InProgress]
+ && taskId task
+ `notElem` readyIds
+ && taskId task
+ `notElem` doneIds
+ pure [t | t <- allTasks, isBlocked t]
+
+-- | Get tasks that have failed 3+ times and need human intervention
+getInterventionTasks :: IO [Task]
+getInterventionTasks = do
+ allTasks <- loadTasks
+ retryContexts <- getAllRetryContexts
+ let highRetryIds = [retryTaskId ctx | ctx <- retryContexts, retryAttempt ctx >= 3]
+ pure [t | t <- allTasks, taskId t `elem` highRetryIds]
+
+-- | Get all retry contexts from the database
+getAllRetryContexts :: IO [RetryContext]
+getAllRetryContexts =
+ withDb <| \conn -> do
+ rows <-
+ SQL.query_
+ conn
+ "SELECT task_id, original_commit, conflict_files, attempt, reason FROM retry_context" ::
+ IO [(Text, Text, Text, Int, Text)]
+ pure
+ [ RetryContext
+ { retryTaskId = tid,
+ retryOriginalCommit = commit,
+ retryConflictFiles = fromMaybe [] (decode (BLC.pack (T.unpack filesJson))),
+ retryAttempt = attempt,
+ retryReason = reason
+ }
+ | (tid, commit, filesJson, attempt, reason) <- rows
+ ]