commit b5f3b9027aa0e96cd792f036a61d6b4418b39487
Author: Ben Sima <ben@bensima.com>
Date: Sat Nov 29 23:18:57 2025
Sort /blocked page by blocking impact (transitive dependents)
All tests pass. The implementation is complete:
**Summary of changes:**
1. **Omni/Task/Core.hs** - Added helper functions:
- `getBlockingImpact`: Counts how many tasks are transitively
blocked - `getTransitiveDependents`: Gets all tasks that depend
on a task (di - `dependsOnTask`: Helper to check if a task depends
on a given ID wi
2. **Omni/Jr/Web.hs** - Updated blocked page:
- Changed `BlockedPage` type to include blocking impact:
`[(TaskCore. - Updated `blockedHandler` to compute blocking impact
and sort by it - Added `renderBlockedTaskCard` to display tasks with
their blocking - Updated the info message to explain the sorting
3. **Omni/Jr/Web/Style.hs** - Added CSS:
- `.blocking-impact` badge style (light mode) - `.blocking-impact`
dark mode style
Task-Id: t-189
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index e00ebcd8..2200bc03 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -254,7 +254,7 @@ data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool
data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] SortOrder UTCTime
-data BlockedPage = BlockedPage [TaskCore.Task] SortOrder UTCTime
+data BlockedPage = BlockedPage [(TaskCore.Task, Int)] SortOrder UTCTime
data InterventionPage = InterventionPage [TaskCore.Task] SortOrder UTCTime
@@ -889,6 +889,21 @@ renderTaskCard t =
Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
+renderBlockedTaskCard :: (Monad m) => (TaskCore.Task, Int) -> Lucid.HtmlT m ()
+renderBlockedTaskCard (t, impact) =
+ Lucid.a_
+ [ Lucid.class_ "task-card task-card-link",
+ Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
+ ]
+ <| do
+ Lucid.div_ [Lucid.class_ "task-header"] <| do
+ Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
+ statusBadge (TaskCore.taskStatus t)
+ Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
+ when (impact > 0)
+ <| Lucid.span_ [Lucid.class_ "blocking-impact"] (Lucid.toHtml ("Blocks " <> tshow impact))
+ Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
+
renderListGroupItem :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
renderListGroupItem t =
Lucid.a_
@@ -1021,19 +1036,19 @@ instance Lucid.ToHtml ReadyQueuePage where
instance Lucid.ToHtml BlockedPage where
toHtmlRaw = Lucid.toHtml
- toHtml (BlockedPage tasks currentSort _now) =
+ toHtml (BlockedPage tasksWithImpact currentSort _now) =
let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Blocked" Nothing]
in Lucid.doctypehtml_ <| do
pageHead "Blocked Tasks - Jr"
pageBodyWithCrumbs crumbs <| do
Lucid.div_ [Lucid.class_ "container"] <| do
Lucid.div_ [Lucid.class_ "page-header-row"] <| do
- Lucid.h1_ <| Lucid.toHtml ("Blocked Tasks (" <> tshow (length tasks) <> " tasks)")
+ Lucid.h1_ <| Lucid.toHtml ("Blocked Tasks (" <> tshow (length tasksWithImpact) <> " tasks)")
sortDropdown "/blocked" currentSort
- Lucid.p_ [Lucid.class_ "info-msg"] "Tasks with unmet blocking dependencies."
- if null tasks
+ Lucid.p_ [Lucid.class_ "info-msg"] "Tasks with unmet blocking dependencies, sorted by blocking impact."
+ if null tasksWithImpact
then Lucid.p_ [Lucid.class_ "empty-msg"] "No blocked tasks."
- else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
+ else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderBlockedTaskCard tasksWithImpact
instance Lucid.ToHtml InterventionPage where
toHtmlRaw = Lucid.toHtml
@@ -2421,9 +2436,11 @@ server =
blockedHandler maybeSortText = do
now <- liftIO getCurrentTime
blockedTasks <- liftIO TaskCore.getBlockedTasks
+ allTasks <- liftIO TaskCore.loadTasks
let sortOrder = parseSortOrder maybeSortText
- sortedTasks = sortTasks sortOrder blockedTasks
- pure (BlockedPage sortedTasks sortOrder now)
+ tasksWithImpact = [(t, TaskCore.getBlockingImpact allTasks t) | t <- blockedTasks]
+ sorted = List.sortBy (comparing (Down <. snd)) tasksWithImpact
+ pure (BlockedPage sorted sortOrder now)
interventionHandler :: Maybe Text -> Servant.Handler InterventionPage
interventionHandler maybeSortText = do
diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs
index 11475d90..5090e2ee 100644
--- a/Omni/Jr/Web/Style.hs
+++ b/Omni/Jr/Web/Style.hs
@@ -367,6 +367,13 @@ cardStyles = do
".priority" ? do
fontSize (px 11)
color "#6b7280"
+ ".blocking-impact" ? do
+ fontSize (px 10)
+ color "#6b7280"
+ backgroundColor "#e5e7eb"
+ padding (px 1) (px 6) (px 1) (px 6)
+ borderRadius (px 8) (px 8) (px 8) (px 8)
+ marginLeft auto
".task-title" ? do
fontSize (px 14)
margin (px 0) (px 0) (px 0) (px 0)
@@ -1556,6 +1563,9 @@ darkModeStyles =
".badge-p4" ? do
backgroundColor "#1f2937"
color "#9ca3af"
+ ".blocking-impact" ? do
+ backgroundColor "#374151"
+ color "#9ca3af"
".priority-dropdown-menu" ? do
backgroundColor "#1f2937"
Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.3)" :: Text)
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index d64d607b..e4986c1c 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -11,6 +11,7 @@ import Data.Aeson (FromJSON, ToJSON, decode, encode)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.List as List
+import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Time (UTCTime, diffUTCTime, getCurrentTime)
@@ -1395,6 +1396,31 @@ getBlockedTasks = do
`notElem` doneIds
pure [t | t <- allTasks, isBlocked t]
+-- | Count how many tasks are transitively blocked by this task
+getBlockingImpact :: [Task] -> Task -> Int
+getBlockingImpact allTasks task =
+ length (getTransitiveDependents allTasks (taskId task))
+
+-- | Get all tasks that depend on this task (directly or transitively)
+-- Uses a Set to track visited nodes and avoid infinite loops from circular deps
+getTransitiveDependents :: [Task] -> Text -> [Task]
+getTransitiveDependents allTasks tid = go Set.empty [tid]
+ where
+ go :: Set.Set Text -> [Text] -> [Task]
+ go _ [] = []
+ go visited (current : rest)
+ | Set.member current visited = go visited rest
+ | otherwise =
+ let directDeps = [t | t <- allTasks, dependsOnTask current t]
+ newIds = [taskId t | t <- directDeps, not (Set.member (taskId t) visited)]
+ visited' = Set.insert current visited
+ in directDeps ++ go visited' (newIds ++ rest)
+
+-- | Check if task depends on given ID with Blocks dependency type
+dependsOnTask :: Text -> Task -> Bool
+dependsOnTask tid task =
+ any (\d -> matchesId (depId d) tid && depType d == Blocks) (taskDependencies task)
+
-- | Get tasks that have failed 3+ times and need human intervention
getInterventionTasks :: IO [Task]
getInterventionTasks = do