diff options
Diffstat (limited to 'Omni/Jr/Web.hs')
| -rw-r--r-- | Omni/Jr/Web.hs | 33 |
1 files changed, 25 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 |