summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Omni/Agent/Worker.hs25
-rw-r--r--Omni/Bild/Sources.json6
-rwxr-xr-xOmni/Jr.hs19
-rw-r--r--Omni/Jr/Web.hs350
-rw-r--r--Omni/Jr/Web/Style.hs43
-rw-r--r--Omni/Task/Core.hs37
6 files changed, 362 insertions, 118 deletions
diff --git a/Omni/Agent/Worker.hs b/Omni/Agent/Worker.hs
index dabf45c..50ad2ae 100644
--- a/Omni/Agent/Worker.hs
+++ b/Omni/Agent/Worker.hs
@@ -125,13 +125,17 @@ processTask worker task = do
TaskCore.logActivity tid TaskCore.Failed (Just (toMetadata [("reason", "max_retries_exceeded")]))
TaskCore.updateTaskStatus tid TaskCore.Open []
else do
+ let currentReason = "attempt " <> tshow attempt <> ": commit_failed: " <> commitErr
+ let accumulatedReason = case maybeCtx of
+ Nothing -> currentReason
+ Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
TaskCore.setRetryContext
TaskCore.RetryContext
{ TaskCore.retryTaskId = tid,
TaskCore.retryOriginalCommit = "",
TaskCore.retryConflictFiles = [],
TaskCore.retryAttempt = attempt,
- TaskCore.retryReason = "commit_failed: " <> commitErr,
+ TaskCore.retryReason = accumulatedReason,
TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
}
TaskCore.logActivity tid TaskCore.Retrying (Just (toMetadata [("attempt", tshow attempt)]))
@@ -329,19 +333,24 @@ formatCommitMessage task ampOutput =
else subject <> "\n\n" <> body <> "\n\nTask-Id: " <> tid
where
cleanSubject s =
- let stripped = Text.dropWhileEnd (`elem` ['.', ':', '!', '?', ' ']) s
- truncated = if Text.length stripped > 52 then Text.take 49 stripped <> "..." else stripped
- capitalized = case Text.uncons truncated of
+ let trailingPunct = ['.', ':', '!', '?', ',', ';', ' ', '-']
+ stripped = Text.dropWhileEnd (`elem` trailingPunct) s
+ truncated = Text.take 72 stripped
+ noPunct = Text.dropWhileEnd (`elem` trailingPunct) truncated
+ capitalized = case Text.uncons noPunct of
Just (c, rest) -> Text.cons (toUpper c) rest
- Nothing -> truncated
+ Nothing -> noPunct
in capitalized
cleanBody :: Text -> Text
cleanBody output =
let stripped = Text.strip output
- lns = Text.lines stripped
- cleaned = map (Text.take 72) lns
- in Text.intercalate "\n" cleaned
+ in if Text.null stripped
+ then ""
+ else
+ let lns = Text.lines stripped
+ cleaned = [Text.take 72 ln | ln <- lns]
+ in Text.intercalate "\n" cleaned
monitorLog :: FilePath -> Process.ProcessHandle -> IO ()
monitorLog path ph = do
diff --git a/Omni/Bild/Sources.json b/Omni/Bild/Sources.json
index a804974..41c3bc4 100644
--- a/Omni/Bild/Sources.json
+++ b/Omni/Bild/Sources.json
@@ -165,10 +165,10 @@
"homepage": "",
"owner": "nixos",
"repo": "nixpkgs",
- "rev": "8eb3b6a2366a7095939cd22f0dc0e9991313294b",
- "sha256": "1mcp4s3qbvgcbyczy311vmc4fbkdx35c0f6piqh884c0ci09ynvc",
+ "rev": "50ab793786d9de88ee30ec4e4c24fb4236fc2674",
+ "sha256": "1s2gr5rcyqvpr58vxdcb095mdhblij9bfzaximrva2243aal3dgx",
"type": "tarball",
- "url": "https://github.com/nixos/nixpkgs/archive/8eb3b6a2366a7095939cd22f0dc0e9991313294b.tar.gz",
+ "url": "https://github.com/nixos/nixpkgs/archive/50ab793786d9de88ee30ec4e4c24fb4236fc2674.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"nixos-mailserver": {
diff --git a/Omni/Jr.hs b/Omni/Jr.hs
index 69c395b..20117fd 100755
--- a/Omni/Jr.hs
+++ b/Omni/Jr.hs
@@ -236,13 +236,17 @@ handleConflict tid conflictFiles commitSha = do
else do
conflictDetails <- gatherConflictContext commitSha conflictFiles
maybeExistingCtx <- TaskCore.getRetryContext tid
+ let currentReason = "attempt " <> tshow attempt <> ":\n" <> conflictDetails
+ let accumulatedReason = case maybeExistingCtx of
+ Nothing -> currentReason
+ Just ctx -> TaskCore.retryReason ctx <> "\n\n" <> currentReason
TaskCore.setRetryContext
TaskCore.RetryContext
{ TaskCore.retryTaskId = tid,
TaskCore.retryOriginalCommit = Text.pack commitSha,
TaskCore.retryConflictFiles = conflictFiles,
TaskCore.retryAttempt = attempt,
- TaskCore.retryReason = conflictDetails,
+ TaskCore.retryReason = accumulatedReason,
TaskCore.retryNotes = maybeExistingCtx +> TaskCore.retryNotes
}
TaskCore.updateTaskStatus tid TaskCore.Open []
@@ -412,13 +416,17 @@ autoReview tid task commitSha = do
putText "[review] Task has failed 3 times. Needs human intervention."
TaskCore.updateTaskStatus tid TaskCore.Open []
else do
+ let currentReason = "attempt " <> tshow attempt <> ": " <> reason
+ let accumulatedReason = case maybeCtx of
+ Nothing -> currentReason
+ Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
TaskCore.setRetryContext
TaskCore.RetryContext
{ TaskCore.retryTaskId = tid,
TaskCore.retryOriginalCommit = Text.pack commitSha,
TaskCore.retryConflictFiles = [],
TaskCore.retryAttempt = attempt,
- TaskCore.retryReason = reason,
+ TaskCore.retryReason = accumulatedReason,
TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
}
TaskCore.updateTaskStatus tid TaskCore.Open []
@@ -445,16 +453,19 @@ interactiveReview tid task commitSha = do
putText "Enter rejection reason: "
IO.hFlush IO.stdout
reason <- getLine
- -- Save rejection as retry context
maybeCtx <- TaskCore.getRetryContext tid
let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
+ let currentReason = "attempt " <> tshow attempt <> ": rejected: " <> reason
+ let accumulatedReason = case maybeCtx of
+ Nothing -> currentReason
+ Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
TaskCore.setRetryContext
TaskCore.RetryContext
{ TaskCore.retryTaskId = tid,
TaskCore.retryOriginalCommit = Text.pack commitSha,
TaskCore.retryConflictFiles = [],
TaskCore.retryAttempt = attempt,
- TaskCore.retryReason = "rejected: " <> reason,
+ TaskCore.retryReason = accumulatedReason,
TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
}
TaskCore.updateTaskStatus tid TaskCore.Open []
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"
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index c469bf8..6d69834 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -13,7 +13,7 @@ import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.List as List
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
-import Data.Time (UTCTime, getCurrentTime)
+import Data.Time (UTCTime, diffUTCTime, getCurrentTime)
import qualified Database.SQLite.Simple as SQL
import qualified Database.SQLite.Simple.FromField as SQL
import qualified Database.SQLite.Simple.Ok as SQLOk
@@ -72,6 +72,14 @@ data TaskProgress = TaskProgress
}
deriving (Show, Eq, Generic)
+data AggregatedMetrics = AggregatedMetrics
+ { aggTotalCostCents :: Int,
+ aggTotalDurationSeconds :: Int,
+ aggCompletedTasks :: Int,
+ aggTotalTokens :: Int
+ }
+ deriving (Show, Eq, Generic)
+
-- Retry context for tasks that failed due to merge conflicts
data RetryContext = RetryContext
{ retryTaskId :: Text,
@@ -143,6 +151,10 @@ instance ToJSON TaskProgress
instance FromJSON TaskProgress
+instance ToJSON AggregatedMetrics
+
+instance FromJSON AggregatedMetrics
+
instance ToJSON RetryContext
instance FromJSON RetryContext
@@ -1233,6 +1245,29 @@ getLatestRunningActivity tid = do
activities <- getActivitiesForTask tid
pure <| List.find (\a -> activityStage a == Running) activities
+-- | Get aggregated metrics for all descendants of an epic
+getAggregatedMetrics :: Text -> IO AggregatedMetrics
+getAggregatedMetrics epicId = do
+ allTasks <- loadTasks
+ let descendants = getAllDescendants allTasks epicId
+ descendantIds = map taskId descendants
+ completedCount = length [t | t <- descendants, taskStatus t == Done]
+ activities <- concat </ traverse getActivitiesForTask descendantIds
+ 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
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-16 11:02:06 +0000