summaryrefslogtreecommitdiff
path: root/Omni
diff options
context:
space:
mode:
Diffstat (limited to 'Omni')
-rw-r--r--Omni/Agent/Log.hs4
-rw-r--r--Omni/Agent/Worker.hs15
-rw-r--r--Omni/Jr/Web.hs162
-rw-r--r--Omni/Jr/Web/Style.hs41
-rw-r--r--Omni/Task/Core.hs74
5 files changed, 276 insertions, 20 deletions
diff --git a/Omni/Agent/Log.hs b/Omni/Agent/Log.hs
index b1020c5..55bc1e2 100644
--- a/Omni/Agent/Log.hs
+++ b/Omni/Agent/Log.hs
@@ -72,6 +72,10 @@ update f = do
modifyIORef' currentStatus f
render
+-- | Get the current status
+getStatus :: IO Status
+getStatus = readIORef currentStatus
+
-- | Set the activity message
updateActivity :: Text -> IO ()
updateActivity msg = update (\s -> s {statusActivity = msg})
diff --git a/Omni/Agent/Worker.hs b/Omni/Agent/Worker.hs
index 2557d70..eef31f4 100644
--- a/Omni/Agent/Worker.hs
+++ b/Omni/Agent/Worker.hs
@@ -10,6 +10,7 @@ import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE
import qualified Data.Text.IO as TIO
+import qualified Data.Time
import qualified Omni.Agent.Core as Core
import qualified Omni.Agent.Log as AgentLog
import qualified Omni.Task.Core as TaskCore
@@ -83,12 +84,22 @@ processTask worker task = do
TaskCore.updateTaskStatus tid TaskCore.InProgress []
say "[worker] Status -> InProgress"
- -- Run Amp
+ -- Run Amp with timing
say "[worker] Starting amp..."
- TaskCore.logActivity tid TaskCore.Running Nothing
+ startTime <- Data.Time.getCurrentTime
+ activityId <- TaskCore.logActivityWithMetrics tid TaskCore.Running Nothing Nothing (Just startTime) Nothing Nothing Nothing
(exitCode, output) <- runAmp repo task
+ endTime <- Data.Time.getCurrentTime
say ("[worker] Amp exited with: " <> tshow exitCode)
+ -- Capture metrics from agent log (thread URL, credits)
+ status <- AgentLog.getStatus
+ let threadUrl = ("https://ampcode.com/threads/" <>) </ AgentLog.statusThread status
+ let costCents = Just <| floor (AgentLog.statusCredits status * 100)
+
+ -- Update the activity record with metrics
+ TaskCore.updateActivityMetrics activityId threadUrl (Just endTime) costCents Nothing
+
case exitCode of
Exit.ExitSuccess -> do
TaskCore.logActivity tid TaskCore.Reviewing Nothing
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 3c24d71..5fc8126 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -21,10 +21,11 @@ import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText
-import Data.Time (UTCTime, defaultTimeLocale, formatTime)
+import Data.Time (UTCTime, defaultTimeLocale, diffUTCTime, formatTime)
import qualified Lucid
import qualified Lucid.Base as Lucid
import qualified Network.Wai.Handler.Warp as Warp
+import Numeric (showFFloat)
import qualified Omni.Jr.Web.Style as Style
import qualified Omni.Task.Core as TaskCore
import Servant
@@ -71,6 +72,7 @@ type API =
:> QueryParam "priority" Text
:> QueryParam "namespace" Text
:> Get '[Lucid.HTML] TaskListPartial
+ :<|> "partials" :> "task" :> Capture "id" Text :> "metrics" :> Get '[Lucid.HTML] TaskMetricsPartial
data CSS
@@ -91,7 +93,7 @@ newtype InterventionPage = InterventionPage [TaskCore.Task]
data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters
data TaskDetailPage
- = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity]
+ = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext)
| TaskDetailNotFound Text
data TaskReviewPage
@@ -113,6 +115,8 @@ data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text
newtype TaskListPartial = TaskListPartial [TaskCore.Task]
+data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext)
+
newtype RejectForm = RejectForm (Maybe Text)
instance FromForm RejectForm where
@@ -402,7 +406,7 @@ instance Lucid.ToHtml TaskDetailPage where
"The task "
Lucid.code_ (Lucid.toHtml tid)
" could not be found."
- toHtml (TaskDetailFound task allTasks activities) =
+ toHtml (TaskDetailFound task allTasks activities maybeRetry) =
Lucid.doctypehtml_ <| do
pageHead (TaskCore.taskId task <> " - Jr")
Lucid.body_ <| do
@@ -492,6 +496,21 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.ul_ [Lucid.class_ "child-list"] <| do
traverse_ renderChild children
+ 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"
+ ]
+ sectionAttrs =
+ [Lucid.class_ "execution-section", Lucid.id_ "execution-details"]
+ <> [attr | isInProgress, attr <- htmxAttrs]
+ Lucid.div_ sectionAttrs <| do
+ Lucid.h3_ "Execution Details"
+ renderExecutionDetails (TaskCore.taskId task) activities maybeRetry
+
when (TaskCore.taskStatus task == TaskCore.InProgress && not (null activities)) <| do
Lucid.div_ [Lucid.class_ "activity-section"] <| do
Lucid.h3_ "Activity Timeline"
@@ -566,6 +585,64 @@ instance Lucid.ToHtml TaskDetailPage where
formatTimestamp :: UTCTime -> Text
formatTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S"
+ 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_ "metric-value amp-link"] (Lucid.toHtml url)
+
+ 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"] (Lucid.toHtml (formatTimestamp 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"] (Lucid.toHtml (formatTimestamp (TaskCore.activityTimestamp act)))
+ where
+ findRunningAct = List.find (\a -> TaskCore.activityStage a == TaskCore.Running)
+
+ 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 "")
+
instance Lucid.ToHtml TaskReviewPage where
toHtmlRaw = Lucid.toHtml
toHtml (ReviewPageNotFound tid) =
@@ -772,6 +849,75 @@ instance Lucid.ToHtml TaskListPartial where
then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
+instance Lucid.ToHtml TaskMetricsPartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (TaskMetricsPartial _tid activities maybeRetry) =
+ 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_ "metric-value amp-link"] (Lucid.toHtml url)
+
+ 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"] (Lucid.toHtml (formatTimestamp 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))
+
+ 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"))
+
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Last Activity:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTimestamp (TaskCore.activityTimestamp act)))
+ where
+ findRunningActivity = List.find (\a -> TaskCore.activityStage a == TaskCore.Running)
+
+ formatTimestamp :: UTCTime -> Text
+ formatTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S"
+
+ formatDuration :: UTCTime -> UTCTime -> Text
+ formatDuration 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"
+
+ formatCost :: Int -> Text
+ formatCost cents =
+ let dollars = fromIntegral cents / 100.0 :: Double
+ in "$" <> Text.pack (showFFloat (Just 2) dollars "")
+
-- | Simple markdown renderer for epic descriptions
-- Supports: headers (#, ##, ###), lists (- or *), code blocks (```), inline code (`)
renderMarkdown :: (Monad m) => Text -> Lucid.HtmlT m ()
@@ -904,6 +1050,7 @@ server =
:<|> recentActivityHandler
:<|> readyCountHandler
:<|> taskListPartialHandler
+ :<|> taskMetricsPartialHandler
where
styleHandler :: Servant.Handler LazyText.Text
styleHandler = pure Style.css
@@ -988,7 +1135,8 @@ server =
Nothing -> pure (TaskDetailNotFound tid)
Just task -> do
activities <- liftIO (TaskCore.getActivitiesForTask tid)
- pure (TaskDetailFound task tasks activities)
+ retryCtx <- liftIO (TaskCore.getRetryContext tid)
+ pure (TaskDetailFound task tasks activities retryCtx)
taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
taskStatusHandler tid (StatusForm newStatus) = do
@@ -1056,6 +1204,12 @@ server =
filteredTasks = applyFilters filters allTasks
pure (TaskListPartial filteredTasks)
+ taskMetricsPartialHandler :: Text -> Servant.Handler TaskMetricsPartial
+ taskMetricsPartialHandler tid = do
+ activities <- liftIO (TaskCore.getActivitiesForTask tid)
+ maybeRetry <- liftIO (TaskCore.getRetryContext tid)
+ pure (TaskMetricsPartial tid activities maybeRetry)
+
getReviewInfo :: Text -> IO ReviewInfo
getReviewInfo tid = do
maybeCommit <- findCommitForTask tid
diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs
index dbe1daa..b4f4c76 100644
--- a/Omni/Jr/Web/Style.hs
+++ b/Omni/Jr/Web/Style.hs
@@ -28,6 +28,7 @@ stylesheet = do
statusBadges
buttonStyles
formStyles
+ executionDetailsStyles
activityTimelineStyles
markdownStyles
responsiveStyles
@@ -497,6 +498,39 @@ formStyles = do
".form-actions" ? do
marginTop (px 8)
+executionDetailsStyles :: Css
+executionDetailsStyles = do
+ ".execution-section" ? do
+ marginTop (em 1)
+ backgroundColor white
+ borderRadius (px 2) (px 2) (px 2) (px 2)
+ padding (px 8) (px 10) (px 8) (px 10)
+ border (px 1) solid "#d0d0d0"
+ ".execution-details" ? do
+ marginTop (px 8)
+ ".metric-row" ? do
+ display flex
+ flexWrap Flexbox.wrap
+ padding (px 4) (px 0) (px 4) (px 0)
+ borderBottom (px 1) solid "#e5e7eb"
+ ".metric-row" # lastChild ? borderBottom (px 0) none transparent
+ ".metric-label" ? do
+ fontWeight (weight 600)
+ width (px 120)
+ color "#6b7280"
+ fontSize (px 13)
+ ".metric-value" ? do
+ Stylesheet.key "flex" ("1" :: Text)
+ fontSize (px 13)
+ ".amp-link" ? do
+ color "#0066cc"
+ textDecoration none
+ wordBreak breakAll
+ ".amp-link" # hover ? textDecoration underline
+ ".retry-count" ? do
+ color "#f97316"
+ fontWeight (weight 600)
+
activityTimelineStyles :: Css
activityTimelineStyles = do
".activity-section" ? do
@@ -751,6 +785,13 @@ darkModeStyles =
".activity-message" ? color "#d1d5db"
(".activity-metadata" |> "summary") ? color "#9ca3af"
".metadata-json" ? backgroundColor "#374151"
+ ".execution-section" ? do
+ backgroundColor "#1f2937"
+ borderColor "#374151"
+ ".metric-row" ? borderBottomColor "#374151"
+ ".metric-label" ? color "#9ca3af"
+ ".metric-value" ? color "#d1d5db"
+ ".amp-link" ? color "#60a5fa"
".markdown-content" ? color "#d1d5db"
".md-h1" ? borderBottomColor "#374151"
".md-inline-code" ? do
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index 3a71900..ffecd60 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -93,7 +93,12 @@ data TaskActivity = TaskActivity
activityTimestamp :: UTCTime,
activityStage :: ActivityStage,
activityMessage :: Maybe Text,
- activityMetadata :: Maybe Text -- JSON for extra data
+ activityMetadata :: Maybe Text, -- JSON for extra data
+ activityAmpThreadUrl :: Maybe Text, -- Link to amp thread
+ activityStartedAt :: Maybe UTCTime, -- When work started
+ activityCompletedAt :: Maybe UTCTime, -- When work completed
+ activityCostCents :: Maybe Int, -- API cost in cents
+ activityTokensUsed :: Maybe Int -- Total tokens used
}
deriving (Show, Eq, Generic)
@@ -241,6 +246,11 @@ instance SQL.FromRow TaskActivity where
<*> SQL.field
<*> SQL.field
<*> SQL.field
+ <*> SQL.field
+ <*> SQL.field
+ <*> SQL.field
+ <*> SQL.field
+ <*> SQL.field
instance SQL.ToRow TaskActivity where
toRow a =
@@ -249,7 +259,12 @@ instance SQL.ToRow TaskActivity where
SQL.toField (activityTimestamp a),
SQL.toField (activityStage a),
SQL.toField (activityMessage a),
- SQL.toField (activityMetadata a)
+ SQL.toField (activityMetadata a),
+ SQL.toField (activityAmpThreadUrl a),
+ SQL.toField (activityStartedAt a),
+ SQL.toField (activityCompletedAt a),
+ SQL.toField (activityCostCents a),
+ SQL.toField (activityTokensUsed a)
]
-- | Case-insensitive ID comparison
@@ -352,6 +367,11 @@ initTaskDb = do
\ stage TEXT NOT NULL, \
\ message TEXT, \
\ metadata TEXT, \
+ \ amp_thread_url TEXT, \
+ \ started_at DATETIME, \
+ \ completed_at DATETIME, \
+ \ cost_cents INTEGER, \
+ \ tokens_used INTEGER, \
\ FOREIGN KEY (task_id) REFERENCES tasks(id) \
\)"
@@ -1011,21 +1031,47 @@ logActivity tid stage metadata =
"INSERT INTO task_activity (task_id, stage, message, metadata) VALUES (?, ?, ?, ?)"
(tid, show stage :: String, Nothing :: Maybe Text, metadata)
+-- | Log activity with worker metrics (amp thread URL, timing, cost)
+logActivityWithMetrics :: Text -> ActivityStage -> Maybe Text -> Maybe Text -> Maybe UTCTime -> Maybe UTCTime -> Maybe Int -> Maybe Int -> IO Int
+logActivityWithMetrics tid stage metadata ampUrl startedAt completedAt costCents tokens =
+ withDb <| \conn -> do
+ SQL.execute
+ conn
+ "INSERT INTO task_activity (task_id, stage, message, metadata, amp_thread_url, started_at, completed_at, cost_cents, tokens_used) \
+ \VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)"
+ (tid, show stage :: String, Nothing :: Maybe Text, metadata, ampUrl, startedAt, completedAt, costCents, tokens)
+ [SQL.Only actId] <- SQL.query_ conn "SELECT last_insert_rowid()" :: IO [SQL.Only Int]
+ pure actId
+
+-- | Update an existing activity record with metrics
+updateActivityMetrics :: Int -> Maybe Text -> Maybe UTCTime -> Maybe Int -> Maybe Int -> IO ()
+updateActivityMetrics actId ampUrl completedAt costCents tokens =
+ withDb <| \conn ->
+ SQL.execute
+ conn
+ "UPDATE task_activity SET amp_thread_url = COALESCE(?, amp_thread_url), \
+ \completed_at = COALESCE(?, completed_at), \
+ \cost_cents = COALESCE(?, cost_cents), \
+ \tokens_used = COALESCE(?, tokens_used) \
+ \WHERE id = ?"
+ (ampUrl, completedAt, costCents, tokens, actId)
+
-- | Get all activities for a task, ordered by timestamp descending
getActivitiesForTask :: Text -> IO [TaskActivity]
getActivitiesForTask tid =
- withDb <| \conn -> do
- rows <-
- SQL.query
- conn
- "SELECT id, task_id, timestamp, stage, message, metadata \
- \FROM task_activity WHERE task_id = ? ORDER BY timestamp DESC"
- (SQL.Only tid) ::
- IO [(Int, Text, UTCTime, Text, Maybe Text, Maybe Text)]
- pure [TaskActivity (Just i) taskId ts (readStage stg) msg meta | (i, taskId, ts, stg, msg, meta) <- rows]
- where
- readStage :: Text -> ActivityStage
- readStage s = fromMaybe Claiming (readMaybe (T.unpack s))
+ withDb <| \conn ->
+ SQL.query
+ conn
+ "SELECT id, task_id, timestamp, stage, message, metadata, \
+ \amp_thread_url, started_at, completed_at, cost_cents, tokens_used \
+ \FROM task_activity WHERE task_id = ? ORDER BY timestamp DESC"
+ (SQL.Only tid)
+
+-- | Get the most recent running activity for a task (for metrics display)
+getLatestRunningActivity :: Text -> IO (Maybe TaskActivity)
+getLatestRunningActivity tid = do
+ activities <- getActivitiesForTask tid
+ pure <| List.find (\a -> activityStage a == Running) activities
-- | Get tasks with unmet blocking dependencies (not ready, not done)
getBlockedTasks :: IO [Task]
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-16 19:42:57 +0000