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