diff options
Diffstat (limited to 'Omni/Jr')
| -rw-r--r-- | Omni/Jr/Web.hs | 350 | ||||
| -rw-r--r-- | Omni/Jr/Web/Style.hs | 43 |
2 files changed, 291 insertions, 102 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 505baca..fbb56a7 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -136,7 +136,7 @@ data InterventionPage = InterventionPage [TaskCore.Task] UTCTime data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters UTCTime data TaskDetailPage - = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] UTCTime + = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] (Maybe TaskCore.AggregatedMetrics) UTCTime | TaskDetailNotFound Text data GitCommit = GitCommit @@ -516,7 +516,6 @@ instance Lucid.ToHtml HomePage where navbar Lucid.div_ [Lucid.class_ "container"] <| do Lucid.h2_ "Task Status" - multiColorProgressBar stats Lucid.div_ [Lucid.class_ "stats-grid"] <| do statCard "Open" (TaskCore.openTasks stats) "badge-open" "/tasks?status=Open" statCard "In Progress" (TaskCore.inProgressTasks stats) "badge-inprogress" "/tasks?status=InProgress" @@ -821,6 +820,45 @@ instance Lucid.ToHtml EpicsPage where then Lucid.p_ [Lucid.class_ "empty-msg"] "No epics found." else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ (renderEpicCardWithStats allTasks) epics +epicProgressBar :: (Monad m) => Int -> Int -> Int -> Int -> Lucid.HtmlT m () +epicProgressBar doneCount inProgressCount openCount totalCount = + let donePct = if totalCount == 0 then 0 else (doneCount * 100) `div` totalCount + inProgressPct = if totalCount == 0 then 0 else (inProgressCount * 100) `div` totalCount + openPct = if totalCount == 0 then 0 else (openCount * 100) `div` totalCount + in Lucid.div_ [Lucid.class_ "multi-progress-container epic-progress"] <| do + Lucid.div_ [Lucid.class_ "multi-progress-bar"] <| do + when (donePct > 0) + <| Lucid.div_ + [ Lucid.class_ "multi-progress-segment progress-done", + Lucid.style_ ("width: " <> tshow donePct <> "%"), + Lucid.title_ (tshow doneCount <> " done") + ] + "" + when (inProgressPct > 0) + <| Lucid.div_ + [ Lucid.class_ "multi-progress-segment progress-inprogress", + Lucid.style_ ("width: " <> tshow inProgressPct <> "%"), + Lucid.title_ (tshow inProgressCount <> " in progress") + ] + "" + when (openPct > 0) + <| Lucid.div_ + [ Lucid.class_ "multi-progress-segment progress-open", + Lucid.style_ ("width: " <> tshow openPct <> "%"), + Lucid.title_ (tshow openCount <> " open") + ] + "" + Lucid.div_ [Lucid.class_ "progress-legend"] <| do + Lucid.span_ [Lucid.class_ "legend-item"] <| do + Lucid.span_ [Lucid.class_ "legend-dot legend-done"] "" + Lucid.toHtml (tshow doneCount) + Lucid.span_ [Lucid.class_ "legend-item"] <| do + Lucid.span_ [Lucid.class_ "legend-dot legend-inprogress"] "" + Lucid.toHtml (tshow inProgressCount) + Lucid.span_ [Lucid.class_ "legend-item"] <| do + Lucid.span_ [Lucid.class_ "legend-dot legend-open"] "" + Lucid.toHtml (tshow openCount) + renderEpicCardWithStats :: (Monad m) => [TaskCore.Task] -> TaskCore.Task -> Lucid.HtmlT m () renderEpicCardWithStats allTasks t = let children = getDescendants allTasks (TaskCore.taskId t) @@ -829,6 +867,7 @@ renderEpicCardWithStats allTasks t = reviewCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Review] doneCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Done] totalCount = length children + openAndReview = openCount + reviewCount in Lucid.a_ [ Lucid.class_ "task-card task-card-link", Lucid.href_ ("/tasks/" <> TaskCore.taskId t) @@ -839,17 +878,7 @@ renderEpicCardWithStats allTasks 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")) + when (totalCount > 0) <| epicProgressBar doneCount inProgressCount openAndReview totalCount case TaskCore.taskDescription t of Nothing -> pure () Just desc -> @@ -953,7 +982,7 @@ instance Lucid.ToHtml TaskDetailPage where "The task " Lucid.code_ (Lucid.toHtml tid) " could not be found." - toHtml (TaskDetailFound task allTasks activities maybeRetry commits now) = + toHtml (TaskDetailFound task allTasks activities maybeRetry commits maybeAggMetrics now) = Lucid.doctypehtml_ <| do pageHead (TaskCore.taskId task <> " - Jr") Lucid.body_ <| do @@ -1013,6 +1042,7 @@ instance Lucid.ToHtml TaskDetailPage where case TaskCore.taskType task of TaskCore.Epic -> do + for_ maybeAggMetrics (renderAggregatedMetrics allTasks task) Lucid.div_ [Lucid.class_ "detail-section"] <| do Lucid.h3_ "Design" case TaskCore.taskDescription task of @@ -1154,47 +1184,81 @@ instance Lucid.ToHtml TaskDetailPage where renderExecutionDetails :: (Monad m) => Text -> [TaskCore.TaskActivity] -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m () renderExecutionDetails _ acts retryCtx = - case findRunningAct acts of - Nothing -> Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available." - Just act -> - Lucid.div_ [Lucid.class_ "execution-details"] <| do - case TaskCore.activityAmpThreadUrl act of - Nothing -> pure () - Just url -> - Lucid.div_ [Lucid.class_ "metric-row"] <| do - Lucid.span_ [Lucid.class_ "metric-label"] "Amp Thread:" - 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)) - - 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")) - - Lucid.div_ [Lucid.class_ "metric-row"] <| do - Lucid.span_ [Lucid.class_ "metric-label"] "Last Activity:" - Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now (TaskCore.activityTimestamp act)) + 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 - findRunningAct = List.find (\a -> TaskCore.activityStage a == TaskCore.Running) + 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.activityAmpThreadUrl act of + Nothing -> pure () + Just url -> + Lucid.div_ [Lucid.class_ "metric-row"] <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Amp Thread:" + 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 = @@ -1210,6 +1274,54 @@ instance Lucid.ToHtml TaskDetailPage where 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) + totalCount = length descendants + costCents = TaskCore.aggTotalCostCents metrics + durationSecs = TaskCore.aggTotalDurationSeconds metrics + completedCount = TaskCore.aggCompletedTasks metrics + tokensUsed = TaskCore.aggTotalTokens metrics + in Lucid.div_ [Lucid.class_ "detail-section aggregated-metrics"] <| do + Lucid.h3_ "Execution Summary" + Lucid.div_ [Lucid.class_ "metrics-grid"] <| do + Lucid.div_ [Lucid.class_ "metric-card"] <| do + Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow completedCount <> "/" <> tshow totalCount)) + Lucid.div_ [Lucid.class_ "metric-label"] "Tasks Completed" + Lucid.div_ [Lucid.class_ "metric-card"] <| do + Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost costCents)) + Lucid.div_ [Lucid.class_ "metric-label"] "Total Cost" + Lucid.div_ [Lucid.class_ "metric-card"] <| do + Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDuration durationSecs)) + Lucid.div_ [Lucid.class_ "metric-label"] "Total Time" + when (tokensUsed > 0) <| do + Lucid.div_ [Lucid.class_ "metric-card"] <| do + Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTokens tokensUsed)) + Lucid.div_ [Lucid.class_ "metric-label"] "Tokens Used" + where + formatCost :: Int -> Text + formatCost cents = + let dollars = fromIntegral cents / 100.0 :: Double + in "$" <> Text.pack (showFFloat (Just 2) dollars "") + + formatDuration :: Int -> Text + formatDuration secs + | secs < 60 = tshow secs <> "s" + | secs < 3600 = + let mins = secs `div` 60 + remSecs = secs `mod` 60 + in tshow mins <> "m " <> tshow remSecs <> "s" + | otherwise = + let hrs = secs `div` 3600 + mins = (secs `mod` 3600) `div` 60 + in tshow hrs <> "h " <> tshow mins <> "m" + + formatTokens :: Int -> Text + formatTokens 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" + renderRetryContextBanner :: (Monad m) => Text -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m () renderRetryContextBanner _ Nothing = pure () renderRetryContextBanner tid (Just ctx) = @@ -1528,54 +1640,81 @@ instance Lucid.ToHtml TaskListPartial where instance Lucid.ToHtml TaskMetricsPartial where toHtmlRaw = Lucid.toHtml toHtml (TaskMetricsPartial _tid activities maybeRetry now) = - Lucid.div_ [Lucid.class_ "execution-details"] <| do - case findRunningActivity activities of - Nothing -> Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available." - Just act -> do - case TaskCore.activityAmpThreadUrl act of - Nothing -> pure () - Just url -> - Lucid.div_ [Lucid.class_ "metric-row"] <| do - Lucid.span_ [Lucid.class_ "metric-label"] "Amp Thread:" - 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 (formatDuration 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 (formatCost cents)) + let runningActs = filter (\a -> TaskCore.activityStage a == TaskCore.Running) activities + 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 TaskCore.activityTokensUsed act of - Nothing -> pure () - Just tokens -> - Lucid.div_ [Lucid.class_ "metric-row"] <| do - Lucid.span_ [Lucid.class_ "metric-label"] "Tokens:" - Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow tokens)) + case maybeRetry 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")) - case maybeRetry 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")) - - Lucid.div_ [Lucid.class_ "metric-row"] <| do - Lucid.span_ [Lucid.class_ "metric-label"] "Last Activity:" - Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now (TaskCore.activityTimestamp act)) + 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 (formatCost totalCost)) + Lucid.hr_ [Lucid.class_ "attempts-divider"] + + traverse_ (renderAttempt attemptCount now) (zip [1 ..] (reverse runningActs)) where - findRunningActivity = List.find (\a -> TaskCore.activityStage a == TaskCore.Running) + 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 -> UTCTime -> (Int, TaskCore.TaskActivity) -> Lucid.HtmlT m () + renderAttempt totalAttempts currentTime (attemptNum, act) = do + when (totalAttempts > 1) + <| Lucid.div_ [Lucid.class_ "attempt-header"] (Lucid.toHtml ("Attempt " <> tshow attemptNum :: Text)) + case TaskCore.activityAmpThreadUrl act of + Nothing -> pure () + Just url -> + Lucid.div_ [Lucid.class_ "metric-row"] <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Amp Thread:" + 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 (formatDuration 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 currentTime 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 (formatCost cents)) + + Lucid.div_ [Lucid.class_ "metric-row"] <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Timestamp:" + Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp currentTime (TaskCore.activityTimestamp act)) formatDuration :: UTCTime -> UTCTime -> Text formatDuration start end = @@ -1875,7 +2014,11 @@ server = activities <- liftIO (TaskCore.getActivitiesForTask tid) retryCtx <- liftIO (TaskCore.getRetryContext tid) commits <- liftIO (getCommitsForTask tid) - pure (TaskDetailFound task tasks activities retryCtx commits now) + aggMetrics <- + if TaskCore.taskType task == TaskCore.Epic + then Just </ liftIO (TaskCore.getAggregatedMetrics tid) + else pure Nothing + pure (TaskDetailFound task tasks activities retryCtx commits aggMetrics now) taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial taskStatusHandler tid (StatusForm newStatus) = do @@ -1923,14 +2066,17 @@ server = let commitSha = fromMaybe "" maybeCommit maybeCtx <- TaskCore.getRetryContext tid let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx - let reason = "rejected: " <> fromMaybe "(no notes)" maybeNotes + let currentReason = "attempt " <> tshow attempt <> ": rejected: " <> fromMaybe "(no notes)" maybeNotes + let accumulatedReason = case maybeCtx of + Nothing -> currentReason + Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason TaskCore.setRetryContext TaskCore.RetryContext { TaskCore.retryTaskId = tid, TaskCore.retryOriginalCommit = commitSha, TaskCore.retryConflictFiles = [], TaskCore.retryAttempt = attempt, - TaskCore.retryReason = reason, + TaskCore.retryReason = accumulatedReason, TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes } TaskCore.updateTaskStatus tid TaskCore.Open [] diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs index 866ed52..7002052 100644 --- a/Omni/Jr/Web/Style.hs +++ b/Omni/Jr/Web/Style.hs @@ -851,6 +851,44 @@ executionDetailsStyles = do ".retry-count" ? do color "#f97316" fontWeight (weight 600) + ".attempts-divider" ? do + margin (px 12) (px 0) (px 12) (px 0) + border (px 0) none transparent + borderTop (px 1) solid "#e5e7eb" + ".attempt-header" ? do + fontWeight (weight 600) + fontSize (px 13) + color "#374151" + marginTop (px 8) + marginBottom (px 4) + paddingBottom (px 4) + borderBottom (px 1) solid "#f3f4f6" + ".aggregated-metrics" ? do + marginTop (em 0.5) + paddingTop (em 0.75) + ".metrics-grid" ? do + display grid + Stylesheet.key "grid-template-columns" ("repeat(auto-fit, minmax(100px, 1fr))" :: Text) + Stylesheet.key "gap" ("10px" :: Text) + marginTop (px 8) + ".metric-card" ? do + backgroundColor "#f9fafb" + border (px 1) solid "#e5e7eb" + borderRadius (px 4) (px 4) (px 4) (px 4) + padding (px 10) (px 12) (px 10) (px 12) + textAlign center + (".metric-card" |> ".metric-value") ? do + fontSize (px 20) + fontWeight bold + color "#374151" + display block + marginBottom (px 2) + width auto + (".metric-card" |> ".metric-label") ? do + fontSize (px 11) + color "#6b7280" + fontWeight (weight 400) + width auto activityTimelineStyles :: Css activityTimelineStyles = do @@ -1268,6 +1306,11 @@ darkModeStyles = ".metric-label" ? color "#9ca3af" ".metric-value" ? color "#d1d5db" + ".metric-card" ? do + backgroundColor "#374151" + borderColor "#4b5563" + (".metric-card" |> ".metric-value") ? color "#f3f4f6" + (".metric-card" |> ".metric-label") ? color "#9ca3af" ".amp-link" ? color "#60a5fa" ".amp-thread-btn" ? do backgroundColor "#8b5cf6" |