diff options
| author | Ben Sima <ben@bensima.com> | 2025-11-26 13:08:11 -0500 |
|---|---|---|
| committer | Ben Sima <ben@bensima.com> | 2025-11-26 13:08:11 -0500 |
| commit | e6c0c8ffdb4e0af8c7c1c0f33db4854e1dba6364 (patch) | |
| tree | d3280dbb0f116e9b9c627f101995c8cf2b52d1ef | |
| parent | 555d5d416e2001d04145b173aa40fd40f656509d (diff) | |
Add stats page (GET /stats)
All the necessary components are in place: 1. Route added to API type
(`GET /stats` with optional `?epic=` query pa 2. `StatsPage` data
type defined 3. `ToHtml` instance for `StatsPage` with all sections
(By Status, By Pr 4. `statsHandler` function to handle the route
5. Handler connected in `server` 6. Link to stats page added to the
dashboard 7. CSS styles for progress bars and stats sections added
(including dark
Task-Id: t-1o2g8gugkr1.10
| -rw-r--r-- | Omni/Jr/Web.hs | 114 | ||||
| -rw-r--r-- | Omni/Jr/Web/Style.hs | 43 |
2 files changed, 157 insertions, 0 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 69162aa..d078a9e 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -47,6 +47,7 @@ type API = Get '[Lucid.HTML] HomePage :<|> "style.css" :> Get '[CSS] LazyText.Text :<|> "ready" :> Get '[Lucid.HTML] ReadyQueuePage + :<|> "stats" :> QueryParam "epic" Text :> Get '[Lucid.HTML] StatsPage :<|> "tasks" :> QueryParam "status" TaskCore.Status :> QueryParam "priority" TaskCore.Priority @@ -85,6 +86,8 @@ data ReviewInfo | ReviewMergeConflict Text [Text] | ReviewReady Text Text +data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text) + newtype RejectForm = RejectForm (Maybe Text) instance FromForm RejectForm where @@ -145,6 +148,7 @@ 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_ "/stats", Lucid.class_ "action-btn"] "View Statistics" Lucid.h2_ "Task Status" Lucid.div_ [Lucid.class_ "stats-grid"] <| do @@ -461,6 +465,109 @@ instance Lucid.ToHtml TaskReviewPage where "" Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "reject-btn"] "Reject" +instance Lucid.ToHtml StatsPage where + toHtmlRaw = Lucid.toHtml + toHtml (StatsPage stats maybeEpic) = + Lucid.doctypehtml_ <| do + pageHead "Task Statistics - Jr" + Lucid.body_ <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.p_ [Lucid.class_ "back-link"] <| Lucid.a_ [Lucid.href_ "/"] "← Back to Dashboard" + + Lucid.h1_ <| case maybeEpic of + Nothing -> "Task Statistics" + Just epicId -> Lucid.toHtml ("Statistics for Epic: " <> epicId) + + Lucid.form_ [Lucid.method_ "GET", Lucid.action_ "/stats", Lucid.class_ "filter-form"] <| do + Lucid.div_ [Lucid.class_ "filter-row"] <| do + Lucid.div_ [Lucid.class_ "filter-group"] <| do + Lucid.label_ [Lucid.for_ "epic"] "Epic:" + Lucid.input_ + [ Lucid.type_ "text", + Lucid.name_ "epic", + Lucid.id_ "epic", + Lucid.class_ "filter-input", + Lucid.placeholder_ "Epic ID (optional)", + Lucid.value_ (fromMaybe "" maybeEpic) + ] + Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter" + Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "clear-btn"] "Clear" + + Lucid.h2_ "By Status" + Lucid.div_ [Lucid.class_ "stats-grid"] <| do + statCard "Open" (TaskCore.openTasks stats) (TaskCore.totalTasks stats) + statCard "In Progress" (TaskCore.inProgressTasks stats) (TaskCore.totalTasks stats) + statCard "Review" (TaskCore.reviewTasks stats) (TaskCore.totalTasks stats) + statCard "Approved" (TaskCore.approvedTasks stats) (TaskCore.totalTasks stats) + statCard "Done" (TaskCore.doneTasks stats) (TaskCore.totalTasks stats) + + Lucid.h2_ "By Priority" + Lucid.div_ [Lucid.class_ "stats-section"] <| do + traverse_ (uncurry renderPriorityRow) (TaskCore.tasksByPriority stats) + + Lucid.h2_ "By Namespace" + Lucid.div_ [Lucid.class_ "stats-section"] <| do + if null (TaskCore.tasksByNamespace stats) + then Lucid.p_ [Lucid.class_ "empty-msg"] "No namespaces found." + else traverse_ (uncurry (renderNamespaceRow (TaskCore.totalTasks stats))) (TaskCore.tasksByNamespace stats) + + Lucid.h2_ "Summary" + Lucid.div_ [Lucid.class_ "summary-section"] <| do + Lucid.div_ [Lucid.class_ "detail-row"] <| do + Lucid.span_ [Lucid.class_ "detail-label"] "Total Tasks:" + Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalTasks stats))) + Lucid.div_ [Lucid.class_ "detail-row"] <| do + Lucid.span_ [Lucid.class_ "detail-label"] "Epics:" + Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalEpics stats))) + Lucid.div_ [Lucid.class_ "detail-row"] <| do + Lucid.span_ [Lucid.class_ "detail-label"] "Ready:" + Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.readyTasks stats))) + Lucid.div_ [Lucid.class_ "detail-row"] <| do + Lucid.span_ [Lucid.class_ "detail-label"] "Blocked:" + Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.blockedTasks stats))) + where + statCard :: (Monad m) => Text -> Int -> Int -> Lucid.HtmlT m () + statCard label count total = + let pct = if total == 0 then 0 else (count * 100) `div` total + in Lucid.div_ [Lucid.class_ "stat-card"] <| do + Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml (tshow count)) + Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label) + Lucid.div_ [Lucid.class_ "progress-bar"] <| do + Lucid.div_ + [ Lucid.class_ "progress-fill", + Lucid.style_ ("width: " <> tshow pct <> "%") + ] + "" + + renderPriorityRow :: (Monad m) => TaskCore.Priority -> Int -> Lucid.HtmlT m () + renderPriorityRow priority count = + let total = TaskCore.totalTasks stats + pct = if total == 0 then 0 else (count * 100) `div` total + in Lucid.div_ [Lucid.class_ "stats-row"] <| do + Lucid.span_ [Lucid.class_ "stats-label"] (Lucid.toHtml (tshow priority)) + Lucid.div_ [Lucid.class_ "stats-bar-container"] <| do + Lucid.div_ [Lucid.class_ "progress-bar"] <| do + Lucid.div_ + [ Lucid.class_ "progress-fill", + Lucid.style_ ("width: " <> tshow pct <> "%") + ] + "" + Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count)) + + renderNamespaceRow :: (Monad m) => Int -> Text -> Int -> Lucid.HtmlT m () + renderNamespaceRow total ns count = + let pct = if total == 0 then 0 else (count * 100) `div` total + in Lucid.div_ [Lucid.class_ "stats-row"] <| do + Lucid.span_ [Lucid.class_ "stats-label"] (Lucid.toHtml ns) + Lucid.div_ [Lucid.class_ "stats-bar-container"] <| do + Lucid.div_ [Lucid.class_ "progress-bar"] <| do + Lucid.div_ + [ Lucid.class_ "progress-fill", + Lucid.style_ ("width: " <> tshow pct <> "%") + ] + "" + Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count)) + api :: Proxy API api = Proxy @@ -469,6 +576,7 @@ server = homeHandler :<|> styleHandler :<|> readyQueueHandler + :<|> statsHandler :<|> taskListHandler :<|> taskDetailHandler :<|> taskStatusHandler @@ -493,6 +601,12 @@ server = let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) readyTasks pure (ReadyQueuePage sortedTasks) + statsHandler :: Maybe Text -> Servant.Handler StatsPage + statsHandler maybeEpic = do + let epicId = emptyToNothing maybeEpic + stats <- liftIO <| TaskCore.getTaskStats epicId + pure (StatsPage stats epicId) + taskListHandler :: Maybe TaskCore.Status -> Maybe TaskCore.Priority -> Maybe Text -> Servant.Handler TaskListPage taskListHandler maybeStatus maybePriority maybeNamespace = do allTasks <- liftIO TaskCore.loadTasks diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs index e2377b5..c1ad47e 100644 --- a/Omni/Jr/Web/Style.hs +++ b/Omni/Jr/Web/Style.hs @@ -253,6 +253,43 @@ cardStyles = do ".diff-block" ? do maxHeight (px 600) overflowY auto + ".progress-bar" ? do + height (px 8) + backgroundColor "#e5e7eb" + borderRadius (px 4) (px 4) (px 4) (px 4) + overflow hidden + marginTop (px 8) + ".progress-fill" ? do + height (pct 100) + backgroundColor "#0066cc" + borderRadius (px 4) (px 4) (px 4) (px 4) + transition "width" (ms 300) ease (sec 0) + ".stats-section" ? do + backgroundColor white + borderRadius (px 8) (px 8) (px 8) (px 8) + padding (px 16) (px 16) (px 16) (px 16) + boxShadow (NE.singleton (bsColor (rgba 0 0 0 0.1) (shadow (px 0) (px 1)))) + ".stats-row" ? do + display flex + alignItems center + Stylesheet.key "gap" ("12px" :: Text) + padding (px 8) (px 0) (px 8) (px 0) + borderBottom (px 1) solid "#e5e7eb" + ".stats-row" # lastChild ? borderBottom (px 0) none transparent + ".stats-label" ? do + minWidth (px 100) + fontWeight (weight 500) + ".stats-bar-container" ? do + Stylesheet.key "flex" ("1" :: Text) + ".stats-count" ? do + minWidth (px 40) + textAlign (alignSide sideRight) + fontWeight (weight 500) + ".summary-section" ? do + backgroundColor white + borderRadius (px 8) (px 8) (px 8) (px 8) + padding (px 16) (px 16) (px 16) (px 16) + boxShadow (NE.singleton (bsColor (rgba 0 0 0 0.1) (shadow (px 0) (px 1)))) ".no-commit-msg" ? do backgroundColor "#fff3cd" border (px 1) solid "#ffc107" @@ -486,6 +523,12 @@ darkModeStyles = backgroundColor "#374151" borderColor "#4b5563" color "#f3f4f6" + ".stats-section" <> ".summary-section" ? do + backgroundColor "#1f2937" + boxShadow (NE.singleton (bsColor (rgba 0 0 0 0.3) (shadow (px 0) (px 2)))) + ".stats-row" ? borderBottomColor "#374151" + ".progress-bar" ? backgroundColor "#374151" + ".progress-fill" ? backgroundColor "#60a5fa" prefersDark :: Stylesheet.Feature prefersDark = |
