diff options
Diffstat (limited to 'Omni/Jr/Web.hs')
| -rw-r--r-- | Omni/Jr/Web.hs | 68 |
1 files changed, 45 insertions, 23 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index d3130ce..9bc5ae5 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -131,7 +131,7 @@ data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text) newtype KBPage = KBPage [TaskCore.Task] -newtype EpicsPage = EpicsPage [TaskCore.Task] +data EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task] newtype RecentActivityPartial = RecentActivityPartial [TaskCore.Task] @@ -436,34 +436,56 @@ instance Lucid.ToHtml KBPage where instance Lucid.ToHtml EpicsPage where toHtmlRaw = Lucid.toHtml - toHtml (EpicsPage tasks) = + toHtml (EpicsPage epics allTasks) = Lucid.doctypehtml_ <| do pageHead "Epics - Jr" Lucid.body_ <| do navbar Lucid.div_ [Lucid.class_ "container"] <| do - Lucid.h1_ <| Lucid.toHtml ("Epics (" <> tshow (length tasks) <> ")") + Lucid.h1_ <| Lucid.toHtml ("Epics (" <> tshow (length epics) <> ")") Lucid.p_ [Lucid.class_ "info-msg"] "All epics (large, multi-task projects)." - if null tasks + if null epics then Lucid.p_ [Lucid.class_ "empty-msg"] "No epics found." - else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderEpicCard tasks - where - renderEpicCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m () - renderEpicCard t = - 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))) - Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t)) - case TaskCore.taskDescription t of - Nothing -> pure () - Just desc -> - Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 desc <> "...")) + else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ (renderEpicCardWithStats allTasks) epics + +renderEpicCardWithStats :: (Monad m) => [TaskCore.Task] -> TaskCore.Task -> Lucid.HtmlT m () +renderEpicCardWithStats allTasks t = + let children = getDescendants allTasks (TaskCore.taskId t) + openCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Open] + inProgressCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.InProgress] + reviewCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Review] + doneCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Done] + totalCount = length children + in 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))) + Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t)) + when (totalCount > 0) <| do + Lucid.div_ [Lucid.class_ "epic-status-breakdown"] <| do + Lucid.span_ [Lucid.class_ "breakdown-label"] (Lucid.toHtml (tshow totalCount <> " tasks: ")) + when (doneCount > 0) + <| Lucid.span_ [Lucid.class_ "badge badge-done breakdown-badge"] (Lucid.toHtml (tshow doneCount <> " done")) + when (inProgressCount > 0) + <| Lucid.span_ [Lucid.class_ "badge badge-inprogress breakdown-badge"] (Lucid.toHtml (tshow inProgressCount <> " in progress")) + when (reviewCount > 0) + <| Lucid.span_ [Lucid.class_ "badge badge-review breakdown-badge"] (Lucid.toHtml (tshow reviewCount <> " review")) + when (openCount > 0) + <| Lucid.span_ [Lucid.class_ "badge badge-open breakdown-badge"] (Lucid.toHtml (tshow openCount <> " open")) + case TaskCore.taskDescription t of + Nothing -> pure () + Just desc -> + Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 desc <> "...")) + +getDescendants :: [TaskCore.Task] -> Text -> [TaskCore.Task] +getDescendants allTasks parentId = + let children = [c | c <- allTasks, maybe False (TaskCore.matchesId parentId) (TaskCore.taskParent c)] + in children ++ concatMap (getDescendants allTasks <. TaskCore.taskId) children instance Lucid.ToHtml TaskListPage where toHtmlRaw = Lucid.toHtml @@ -1389,7 +1411,7 @@ server = allTasks <- liftIO TaskCore.loadTasks let epicTasks = filter (\t -> TaskCore.taskType t == TaskCore.Epic) allTasks sortedEpics = List.sortBy (compare `on` TaskCore.taskPriority) epicTasks - pure (EpicsPage sortedEpics) + pure (EpicsPage sortedEpics allTasks) parseStatus :: Text -> Maybe TaskCore.Status parseStatus = readMaybe <. Text.unpack |