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

2 files changed, 96 insertions, 0 deletions

diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 759f42e..7ca2ec3 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 4e65581..3a71900 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
+      ]