diff options
Diffstat (limited to 'Omni')
| -rw-r--r-- | Omni/Jr/Web.hs | 31 | ||||
| -rw-r--r-- | Omni/Jr/Web/Style.hs | 3 | ||||
| -rw-r--r-- | Omni/Task/Core.hs | 22 |
3 files changed, 53 insertions, 3 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index bed26a6..533d761 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -139,7 +139,7 @@ instance Accept CSS where instance MimeRender CSS LazyText.Text where mimeRender _ = LazyText.encodeUtf8 -data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool UTCTime +data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool TaskCore.AggregatedMetrics UTCTime data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] UTCTime @@ -611,7 +611,7 @@ renderListGroupItem t = instance Lucid.ToHtml HomePage where toHtmlRaw = Lucid.toHtml - toHtml (HomePage stats readyTasks recentTasks hasMoreRecent _now) = + toHtml (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics _now) = Lucid.doctypehtml_ <| do pageHead "Jr Dashboard" pageBody <| do @@ -623,6 +623,8 @@ instance Lucid.ToHtml HomePage where statCard "Review" (TaskCore.reviewTasks stats) "badge-review" "/tasks?status=Review" statCard "Approved" (TaskCore.approvedTasks stats) "badge-approved" "/tasks?status=Approved" statCard "Done" (TaskCore.doneTasks stats) "badge-done" "/tasks?status=Done" + metricCard "Cost" (formatCost (TaskCore.aggTotalCostCents globalMetrics)) + metricCard "Duration" (formatDuration (TaskCore.aggTotalDurationSeconds globalMetrics)) Lucid.h2_ <| do "Ready Queue " @@ -671,6 +673,28 @@ instance Lucid.ToHtml HomePage where Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml (tshow count)) Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label) + metricCard :: (Monad m) => Text -> Text -> Lucid.HtmlT m () + metricCard label value = + Lucid.div_ [Lucid.class_ "stat-card badge-neutral"] <| do + Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml value) + Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label) + + formatCost :: Int -> Text + formatCost cents = + let dollars = fromIntegral cents / 100.0 :: Double + in Text.pack ("$" <> showFFloat (Just 2) dollars "") + + formatDuration :: Int -> Text + formatDuration totalSeconds + | totalSeconds < 60 = tshow totalSeconds <> "s" + | totalSeconds < 3600 = + let mins = totalSeconds `div` 60 + in tshow mins <> "m" + | otherwise = + let hours = totalSeconds `div` 3600 + mins = (totalSeconds `mod` 3600) `div` 60 + in tshow hours <> "h " <> tshow mins <> "m" + instance Lucid.ToHtml ReadyQueuePage where toHtmlRaw = Lucid.toHtml toHtml (ReadyQueuePage tasks _now) = @@ -2018,10 +2042,11 @@ server = stats <- liftIO <| TaskCore.getTaskStats Nothing readyTasks <- liftIO TaskCore.getReadyTasks allTasks <- liftIO TaskCore.loadTasks + globalMetrics <- liftIO TaskCore.getGlobalAggregatedMetrics let sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks recentTasks = take 5 sortedTasks hasMoreRecent = length allTasks > 5 - pure (HomePage stats readyTasks recentTasks hasMoreRecent now) + pure (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics now) readyQueueHandler :: Servant.Handler ReadyQueuePage readyQueueHandler = do diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs index 0628c53..ad1ff02 100644 --- a/Omni/Jr/Web/Style.hs +++ b/Omni/Jr/Web/Style.hs @@ -336,6 +336,8 @@ cardStyles = do (".stat-card.badge-approved" |> ".stat-count") ? color "#0e7490" ".stat-card.badge-done" ? borderLeft (px 4) solid "#10b981" (".stat-card.badge-done" |> ".stat-count") ? color "#065f46" + ".stat-card.badge-neutral" ? borderLeft (px 4) solid "#6b7280" + (".stat-card.badge-neutral" |> ".stat-count") ? color "#374151" ".task-card" ? do transition "border-color" (ms 150) ease (sec 0) ".task-card" # hover ? do @@ -1382,6 +1384,7 @@ darkModeStyles = (".stat-card.badge-review" |> ".stat-count") ? color "#a78bfa" (".stat-card.badge-approved" |> ".stat-count") ? color "#22d3ee" (".stat-card.badge-done" |> ".stat-count") ? color "#34d399" + (".stat-card.badge-neutral" |> ".stat-count") ? color "#9ca3af" ".progress-bar" ? backgroundColor "#374151" ".progress-fill" ? backgroundColor "#60a5fa" diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs index 773a01f..722e696 100644 --- a/Omni/Task/Core.hs +++ b/Omni/Task/Core.hs @@ -1320,6 +1320,28 @@ getAggregatedMetrics epicId = do (Just start, Just end) -> floor (diffUTCTime end start) _ -> 0 +-- | Get aggregated metrics for all tasks globally (not scoped to an epic) +getGlobalAggregatedMetrics :: IO AggregatedMetrics +getGlobalAggregatedMetrics = do + allTasks <- loadTasks + let completedCount = length [t | t <- allTasks, taskStatus t == Done] + taskIds = map taskId allTasks + activities <- concat </ traverse getActivitiesForTask taskIds + let totalCost = sum [c | act <- activities, Just c <- [activityCostCents act]] + totalTokens = sum [t | act <- activities, Just t <- [activityTokensUsed act]] + totalDuration = sum [calcDuration act | act <- activities] + pure + AggregatedMetrics + { aggTotalCostCents = totalCost, + aggTotalDurationSeconds = totalDuration, + aggCompletedTasks = completedCount, + aggTotalTokens = totalTokens + } + where + calcDuration act = case (activityStartedAt act, activityCompletedAt act) of + (Just start, Just end) -> floor (diffUTCTime end start) + _ -> 0 + -- | Get tasks with unmet blocking dependencies (not ready, not done) getBlockedTasks :: IO [Task] getBlockedTasks = do |