commit 5b3256b500ebb9a2f953c8b54917626b11988448
Author: Ben Sima <ben@bensima.com>
Date: Mon Dec 1 14:59:52 2025
Consolidate cost display in timeline header, remove Execution Details
- Add cost/token summary to timeline header
- Filter Cost events from timeline display
- Remove Execution Details section (cost info now in header)
- Remove unused renderExecutionDetails function
Task-Id: t-216
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index cd6f2d7b..a493395f 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -1518,7 +1518,7 @@ instance Lucid.ToHtml TaskDetailPage where
"The task "
Lucid.code_ (Lucid.toHtml tid)
" could not be found."
- toHtml (TaskDetailFound task allTasks activities maybeRetry commits maybeAggMetrics agentEvents now) =
+ toHtml (TaskDetailFound task allTasks _activities maybeRetry commits maybeAggMetrics agentEvents now) =
let crumbs = taskBreadcrumbs allTasks task
in Lucid.doctypehtml_ <| do
pageHead (TaskCore.taskId task <> " - Jr")
@@ -1588,21 +1588,6 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.div_ [Lucid.class_ "commit-list"] <| do
traverse_ (renderCommit (TaskCore.taskId task)) commits
- let hasRunningActivity = any (\a -> TaskCore.activityStage a == TaskCore.Running) activities
- when hasRunningActivity <| do
- let isInProgress = TaskCore.taskStatus task == TaskCore.InProgress
- htmxAttrs =
- [ Lucid.makeAttribute "hx-get" ("/partials/task/" <> TaskCore.taskId task <> "/metrics"),
- Lucid.makeAttribute "hx-trigger" "every 5s",
- Lucid.makeAttribute "hx-swap" "innerHTML"
- ]
- innerAttrs =
- [Lucid.id_ "execution-details-inner"]
- <> [attr | isInProgress, attr <- htmxAttrs]
- Lucid.div_ [Lucid.class_ "execution-section"] <| do
- Lucid.h3_ "Execution Details"
- Lucid.div_ innerAttrs <| renderExecutionDetails (TaskCore.taskId task) activities maybeRetry
-
when (TaskCore.taskStatus task == TaskCore.Review) <| do
Lucid.div_ [Lucid.class_ "review-link-section"] <| do
Lucid.a_
@@ -1641,98 +1626,6 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.span_ [Lucid.class_ "commit-date"] (Lucid.toHtml (commitRelativeDate c))
Lucid.span_ [Lucid.class_ "commit-files"] (Lucid.toHtml (tshow (commitFilesChanged c) <> " files"))
- renderExecutionDetails :: (Monad m) => Text -> [TaskCore.TaskActivity] -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m ()
- renderExecutionDetails _ acts retryCtx =
- let runningActs = filter (\a -> TaskCore.activityStage a == TaskCore.Running) acts
- in if null runningActs
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available."
- else
- Lucid.div_ [Lucid.class_ "execution-details"] <| do
- let totalCost = sum [c | act <- runningActs, Just c <- [TaskCore.activityCostCents act]]
- totalDuration = sum [calcDurSecs act | act <- runningActs]
- attemptCount = length runningActs
-
- case retryCtx of
- Nothing -> pure ()
- Just ctx ->
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Retry Attempt:"
- Lucid.span_ [Lucid.class_ "metric-value retry-count"] (Lucid.toHtml (tshow (TaskCore.retryAttempt ctx) <> "/3"))
-
- when (attemptCount > 1) <| do
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Total Attempts:"
- Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow attemptCount))
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Total Duration:"
- Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurSecs totalDuration))
- when (totalCost > 0)
- <| Lucid.div_ [Lucid.class_ "metric-row"]
- <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Total Cost:"
- Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCostVal totalCost))
- Lucid.hr_ [Lucid.class_ "attempts-divider"]
-
- traverse_ (renderAttempt attemptCount) (zip [1 ..] (reverse runningActs))
- where
- calcDurSecs :: TaskCore.TaskActivity -> Int
- calcDurSecs act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
- (Just start, Just end) -> floor (diffUTCTime end start)
- _ -> 0
-
- formatDurSecs :: Int -> Text
- formatDurSecs secs
- | secs < 60 = tshow secs <> "s"
- | secs < 3600 = tshow (secs `div` 60) <> "m " <> tshow (secs `mod` 60) <> "s"
- | otherwise = tshow (secs `div` 3600) <> "h " <> tshow ((secs `mod` 3600) `div` 60) <> "m"
-
- renderAttempt :: (Monad m) => Int -> (Int, TaskCore.TaskActivity) -> Lucid.HtmlT m ()
- renderAttempt totalAttempts (attemptNum, act) = do
- when (totalAttempts > 1)
- <| Lucid.div_ [Lucid.class_ "attempt-header"] (Lucid.toHtml ("Attempt " <> tshow attemptNum :: Text))
- case TaskCore.activityThreadUrl act of
- Nothing -> pure ()
- Just url ->
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Session:"
- Lucid.a_ [Lucid.href_ url, Lucid.target_ "_blank", Lucid.class_ "amp-thread-btn"] "View in Amp ↗"
-
- case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
- (Just start, Just end) ->
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Duration:"
- Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDur start end))
- (Just start, Nothing) ->
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Started:"
- Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now start)
- _ -> pure ()
-
- case TaskCore.activityCostCents act of
- Nothing -> pure ()
- Just cents ->
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Cost:"
- Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCostVal cents))
-
- Lucid.div_ [Lucid.class_ "metric-row"] <| do
- Lucid.span_ [Lucid.class_ "metric-label"] "Timestamp:"
- Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now (TaskCore.activityTimestamp act))
-
- formatDur :: UTCTime -> UTCTime -> Text
- formatDur start end =
- let diffSecs = floor (diffUTCTime end start) :: Int
- mins = diffSecs `div` 60
- secs = diffSecs `mod` 60
- in if mins > 0
- then tshow mins <> "m " <> tshow secs <> "s"
- else tshow secs <> "s"
-
- formatCostVal :: Int -> Text
- formatCostVal cents =
- let dollars = fromIntegral cents / 100.0 :: Double
- in "$" <> Text.pack (showFFloat (Just 2) dollars "")
-
renderAggregatedMetrics :: (Monad m) => [TaskCore.Task] -> TaskCore.Task -> TaskCore.AggregatedMetrics -> Lucid.HtmlT m ()
renderAggregatedMetrics allTasks task metrics =
let descendants = getDescendants allTasks (TaskCore.taskId task)
@@ -2402,6 +2295,36 @@ liveToggleJs =
"});"
]
+-- | Aggregate cost and token data from events (Cost event type)
+aggregateCostMetrics :: [TaskCore.StoredEvent] -> (Int, Int)
+aggregateCostMetrics events =
+ let costEvents = filter (\e -> TaskCore.storedEventType e == "Cost") events
+ aggregateOne (totalCents, totalTokens) event =
+ case Aeson.decode (LBS.fromStrict (str (TaskCore.storedEventContent event))) of
+ Just (Aeson.Object obj) ->
+ let cents = case KeyMap.lookup "cents" obj of
+ Just (Aeson.Number n) -> floor n
+ _ -> 0
+ tokens = case KeyMap.lookup "tokens" obj of
+ Just (Aeson.Number n) -> floor n
+ _ -> 0
+ in (totalCents + cents, totalTokens + tokens)
+ _ -> (totalCents, totalTokens)
+ in foldl' aggregateOne (0, 0) costEvents
+
+-- | Format cost in dollars
+formatCostHeader :: Int -> Text
+formatCostHeader cents =
+ let dollars = fromIntegral cents / 100.0 :: Double
+ in "$" <> Text.pack (showFFloat (Just 2) dollars "")
+
+-- | Format tokens with K/M suffixes
+formatTokensHeader :: Int -> Text
+formatTokensHeader t
+ | t < 1000 = tshow t
+ | t < 1000000 = Text.pack (showFFloat (Just 1) (fromIntegral t / 1000.0 :: Double) "") <> "K"
+ | otherwise = Text.pack (showFFloat (Just 2) (fromIntegral t / 1000000.0 :: Double) "") <> "M"
+
-- | Unified timeline view combining comments, status changes, and agent events
renderUnifiedTimeline :: (Monad m) => Text -> [TaskCore.Comment] -> [TaskCore.StoredEvent] -> TaskCore.Status -> UTCTime -> Lucid.HtmlT m ()
renderUnifiedTimeline tid legacyComments events status now = do
@@ -2416,16 +2339,26 @@ renderUnifiedTimeline tid legacyComments events status now = do
Lucid.makeAttribute "hx-on::after-swap" "var log = this.querySelector('.timeline-events'); if(log && this.dataset.scroll) log.scrollTop = this.dataset.scroll"
]
else []
+ -- Count non-Cost events for the display
+ nonCostEvents = filter (\e -> TaskCore.storedEventType e /= "Cost") events
+ eventCount = length nonCostEvents + length legacyComments
+ (totalCents, totalTokens) = aggregateCostMetrics events
Lucid.div_ ([Lucid.class_ "unified-timeline-section", Lucid.id_ "unified-timeline"] <> pollAttrs) <| do
Lucid.h3_ <| do
- Lucid.toHtml ("Timeline (" <> tshow (length events + length legacyComments) <> ")")
+ Lucid.toHtml ("Timeline (" <> tshow eventCount <> ")")
+ when (totalCents > 0 || totalTokens > 0) <| do
+ Lucid.span_ [Lucid.class_ "timeline-cost-summary"] <| do
+ metaSep
+ when (totalCents > 0) <| Lucid.toHtml (formatCostHeader totalCents)
+ when (totalCents > 0 && totalTokens > 0) <| metaSep
+ when (totalTokens > 0) <| Lucid.toHtml (formatTokensHeader totalTokens <> " tokens")
when isInProgress <| renderLiveToggle
- if null events && null legacyComments
+ if null nonCostEvents && null legacyComments
then Lucid.p_ [Lucid.class_ "empty-msg"] "No activity yet."
else do
Lucid.div_ [Lucid.class_ "timeline-events"] <| do
- traverse_ (renderTimelineEvent now) events
+ traverse_ (renderTimelineEvent now) nonCostEvents
when isInProgress <| timelineScrollScript
commentForm tid
@@ -2456,7 +2389,7 @@ renderTimelineEvent now event =
"Assistant" -> renderAssistantTimelineEvent content actor timestamp now
"ToolCall" -> renderToolCallTimelineEvent content actor timestamp now
"ToolResult" -> renderToolResultTimelineEvent content actor timestamp now
- "Cost" -> renderCostTimelineEvent content
+ "Cost" -> pure () -- Cost events are hidden; cost data shown in timeline header
"Checkpoint" -> renderCheckpointEvent content actor timestamp now
"Guardrail" -> renderGuardrailEvent content actor timestamp now
_ -> renderGenericEvent eventType content actor timestamp now
@@ -2585,13 +2518,6 @@ renderToolResultTimelineEvent content _actor timestamp now =
renderRelativeTimestamp now timestamp
Lucid.pre_ [Lucid.class_ "event-content tool-output"] (renderDecodedToolResult content)
--- | Render cost event (inline)
-renderCostTimelineEvent :: (Monad m) => Text -> Lucid.HtmlT m ()
-renderCostTimelineEvent content =
- Lucid.div_ [Lucid.class_ "timeline-cost"] <| do
- Lucid.span_ [Lucid.class_ "event-icon"] "💰"
- Lucid.span_ [Lucid.class_ "cost-text"] (Lucid.toHtml content)
-
-- | Render checkpoint event
renderCheckpointEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderCheckpointEvent content actor timestamp now =