diff options
Diffstat (limited to 'Omni')
| -rw-r--r-- | Omni/Jr/Web.hs | 33 | ||||
| -rw-r--r-- | Omni/Jr/Web/Style.hs | 10 | ||||
| -rw-r--r-- | Omni/Task/Core.hs | 26 |
3 files changed, 61 insertions, 8 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index e00ebcd..2200bc0 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 11475d9..5090e2e 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 d64d607..e4986c1 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 |