summaryrefslogtreecommitdiff
path: root/Omni/Jr/Web.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Jr/Web.hs')
-rw-r--r--Omni/Jr/Web.hs184
1 files changed, 181 insertions, 3 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index fe1711b..86647d4 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -241,6 +241,7 @@ type API =
:> QueryParam "sort" Text
:> Get '[Lucid.HTML] TaskListPartial
:<|> "partials" :> "task" :> Capture "id" Text :> "metrics" :> Get '[Lucid.HTML] TaskMetricsPartial
+ :<|> "partials" :> "task" :> Capture "id" Text :> "events" :> QueryParam "since" Int :> Get '[Lucid.HTML] AgentEventsPartial
data CSS
@@ -261,7 +262,7 @@ data InterventionPage = InterventionPage TaskCore.HumanActionItems SortOrder UTC
data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters SortOrder UTCTime
data TaskDetailPage
- = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] (Maybe TaskCore.AggregatedMetrics) UTCTime
+ = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] (Maybe TaskCore.AggregatedMetrics) [TaskCore.StoredEvent] UTCTime
| TaskDetailNotFound Text
data GitCommit = GitCommit
@@ -330,6 +331,8 @@ newtype TaskListPartial = TaskListPartial [TaskCore.Task]
data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime
+data AgentEventsPartial = AgentEventsPartial [TaskCore.StoredEvent] Bool UTCTime
+
data DescriptionViewPartial = DescriptionViewPartial Text Text Bool
data DescriptionEditPartial = DescriptionEditPartial Text Text Bool
@@ -1487,7 +1490,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 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,6 +1591,8 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.class_ "review-link-btn"
]
"Review This Task"
+
+ renderAgentLogSection (TaskCore.taskId task) agentEvents (TaskCore.taskStatus task) now
where
renderDependency :: (Monad m) => TaskCore.Dependency -> Lucid.HtmlT m ()
renderDependency dep =
@@ -2386,6 +2391,162 @@ renderInlinePart part = case part of
InlineCode txt -> Lucid.code_ [Lucid.class_ "md-inline-code"] (Lucid.toHtml txt)
BoldText txt -> Lucid.strong_ (Lucid.toHtml txt)
+renderAgentLogSection :: (Monad m) => Text -> [TaskCore.StoredEvent] -> TaskCore.Status -> UTCTime -> Lucid.HtmlT m ()
+renderAgentLogSection tid events status now = do
+ let shouldShow = not (null events) || status == TaskCore.InProgress
+ when shouldShow <| do
+ let isInProgress = status == TaskCore.InProgress
+ pollAttrs =
+ if isInProgress
+ then
+ [ Lucid.makeAttribute "hx-get" ("/partials/task/" <> tid <> "/events"),
+ Lucid.makeAttribute "hx-trigger" "every 3s",
+ Lucid.makeAttribute "hx-swap" "innerHTML"
+ ]
+ else []
+ Lucid.div_ ([Lucid.class_ "agent-log-section", Lucid.id_ "agent-log-container"] <> pollAttrs) <| do
+ Lucid.h3_ <| do
+ Lucid.toHtml ("Agent Log (" <> tshow (length events) <> ")")
+ when isInProgress <| Lucid.span_ [Lucid.class_ "agent-log-live"] " LIVE"
+ if null events
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "Agent session starting..."
+ else do
+ Lucid.div_ [Lucid.class_ "agent-log"] <| do
+ traverse_ (renderAgentEvent now) events
+ agentLogScrollScript
+
+renderAgentEvent :: (Monad m) => UTCTime -> TaskCore.StoredEvent -> Lucid.HtmlT m ()
+renderAgentEvent now event =
+ let eventType = TaskCore.storedEventType event
+ content = TaskCore.storedEventContent event
+ timestamp = TaskCore.storedEventTimestamp event
+ eventId = TaskCore.storedEventId event
+ in Lucid.div_
+ [ Lucid.class_ ("agent-event agent-event-" <> eventType),
+ Lucid.makeAttribute "data-event-id" (tshow eventId)
+ ]
+ <| do
+ case eventType of
+ "Assistant" -> renderAssistantEvent content timestamp now
+ "ToolCall" -> renderToolCallEvent content timestamp now
+ "ToolResult" -> renderToolResultEvent content timestamp now
+ "Cost" -> renderCostEvent content
+ "Error" -> renderErrorEvent content timestamp now
+ "Complete" -> renderCompleteEvent timestamp now
+ _ -> Lucid.div_ [Lucid.class_ "event-unknown"] (Lucid.toHtml content)
+
+renderAssistantEvent :: (Monad m) => Text -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderAssistantEvent content timestamp now =
+ Lucid.div_ [Lucid.class_ "event-assistant"] <| do
+ Lucid.div_ [Lucid.class_ "event-header"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "💬"
+ Lucid.span_ [Lucid.class_ "event-label"] "Assistant"
+ renderRelativeTimestamp now timestamp
+ Lucid.div_ [Lucid.class_ "event-content event-bubble"] <| do
+ let truncated = Text.take 2000 content
+ isTruncated = Text.length content > 2000
+ Lucid.toHtml truncated
+ when isTruncated <| Lucid.span_ [Lucid.class_ "event-truncated"] "..."
+
+renderToolCallEvent :: (Monad m) => Text -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderToolCallEvent content timestamp now =
+ let (toolName, args) = parseToolCallContent content
+ in Lucid.details_ [Lucid.class_ "event-tool-call"] <| do
+ Lucid.summary_ <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "🔧"
+ Lucid.span_ [Lucid.class_ "event-label tool-name"] (Lucid.toHtml toolName)
+ renderRelativeTimestamp now timestamp
+ Lucid.div_ [Lucid.class_ "event-content tool-args"] <| do
+ renderCollapsibleOutput args
+
+renderToolResultEvent :: (Monad m) => Text -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderToolResultEvent content timestamp now =
+ let lineCount = length (Text.lines content)
+ isLong = lineCount > 20
+ in Lucid.div_ [Lucid.class_ "event-tool-result"] <| do
+ Lucid.div_ [Lucid.class_ "event-header result-header"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "📋"
+ Lucid.span_ [Lucid.class_ "event-label"] "Result"
+ when (lineCount > 1)
+ <| Lucid.span_ [Lucid.class_ "line-count"] (Lucid.toHtml (tshow lineCount <> " lines"))
+ renderRelativeTimestamp now timestamp
+ if isLong
+ then
+ Lucid.details_ [Lucid.class_ "result-collapsible"] <| do
+ Lucid.summary_ "Show output"
+ Lucid.pre_ [Lucid.class_ "event-content tool-output"] (Lucid.toHtml content)
+ else Lucid.pre_ [Lucid.class_ "event-content tool-output"] (Lucid.toHtml content)
+
+renderCostEvent :: (Monad m) => Text -> Lucid.HtmlT m ()
+renderCostEvent content =
+ Lucid.div_ [Lucid.class_ "event-cost"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "💰"
+ Lucid.span_ [Lucid.class_ "cost-text"] (Lucid.toHtml content)
+
+renderErrorEvent :: (Monad m) => Text -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderErrorEvent content timestamp now =
+ Lucid.div_ [Lucid.class_ "event-error"] <| do
+ Lucid.div_ [Lucid.class_ "event-header"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "❌"
+ Lucid.span_ [Lucid.class_ "event-label"] "Error"
+ renderRelativeTimestamp now timestamp
+ Lucid.div_ [Lucid.class_ "event-content error-message"] (Lucid.toHtml content)
+
+renderCompleteEvent :: (Monad m) => UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderCompleteEvent timestamp now =
+ Lucid.div_ [Lucid.class_ "event-complete"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "✅"
+ Lucid.span_ [Lucid.class_ "event-label"] "Session completed"
+ renderRelativeTimestamp now timestamp
+
+parseToolCallContent :: Text -> (Text, Text)
+parseToolCallContent content =
+ case Text.breakOn ":" content of
+ (name, rest)
+ | Text.null rest -> (content, "")
+ | otherwise -> (Text.strip name, Text.strip (Text.drop 1 rest))
+
+renderCollapsibleOutput :: (Monad m) => Text -> Lucid.HtmlT m ()
+renderCollapsibleOutput content =
+ let lineCount = length (Text.lines content)
+ in if lineCount > 20
+ then
+ Lucid.details_ [Lucid.class_ "output-collapsible"] <| do
+ Lucid.summary_ (Lucid.toHtml (tshow lineCount <> " lines"))
+ Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)
+ else Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)
+
+agentLogScrollScript :: (Monad m) => Lucid.HtmlT m ()
+agentLogScrollScript =
+ Lucid.script_
+ [ Lucid.type_ "text/javascript"
+ ]
+ ( Text.unlines
+ [ "(function() {",
+ " var log = document.querySelector('.agent-log');",
+ " if (log) {",
+ " var isNearBottom = log.scrollHeight - log.scrollTop - log.clientHeight < 100;",
+ " if (isNearBottom) {",
+ " log.scrollTop = log.scrollHeight;",
+ " }",
+ " }",
+ "})();"
+ ]
+ )
+
+instance Lucid.ToHtml AgentEventsPartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (AgentEventsPartial events isInProgress now) = do
+ Lucid.h3_ <| do
+ Lucid.toHtml ("Agent Log (" <> tshow (length events) <> ")")
+ when isInProgress <| Lucid.span_ [Lucid.class_ "agent-log-live"] " LIVE"
+ if null events
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "Agent session starting..."
+ else do
+ Lucid.div_ [Lucid.class_ "agent-log"] <| do
+ traverse_ (renderAgentEvent now) events
+ agentLogScrollScript
+
api :: Proxy API
api = Proxy
@@ -2422,6 +2583,7 @@ server =
:<|> readyCountHandler
:<|> taskListPartialHandler
:<|> taskMetricsPartialHandler
+ :<|> agentEventsPartialHandler
where
styleHandler :: Servant.Handler LazyText.Text
styleHandler = pure Style.css
@@ -2584,7 +2746,8 @@ server =
if TaskCore.taskType task == TaskCore.Epic
then Just </ liftIO (TaskCore.getAggregatedMetrics tid)
else pure Nothing
- pure (TaskDetailFound task tasks activities retryCtx commits aggMetrics now)
+ agentEvents <- liftIO (TaskCore.getEventsForTask tid)
+ pure (TaskDetailFound task tasks activities retryCtx commits aggMetrics agentEvents now)
taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
taskStatusHandler tid (StatusForm newStatus) = do
@@ -2725,6 +2888,21 @@ server =
maybeRetry <- liftIO (TaskCore.getRetryContext tid)
pure (TaskMetricsPartial tid activities maybeRetry now)
+ agentEventsPartialHandler :: Text -> Maybe Int -> Servant.Handler AgentEventsPartial
+ agentEventsPartialHandler tid maybeSince = do
+ now <- liftIO getCurrentTime
+ maybeSession <- liftIO (TaskCore.getLatestSessionForTask tid)
+ events <- case maybeSession of
+ Nothing -> pure []
+ Just sid -> case maybeSince of
+ Nothing -> liftIO (TaskCore.getEventsForSession sid)
+ Just lastId -> liftIO (TaskCore.getEventsSince sid lastId)
+ tasks <- liftIO TaskCore.loadTasks
+ let isInProgress = case TaskCore.findTask tid tasks of
+ Nothing -> False
+ Just task -> TaskCore.taskStatus task == TaskCore.InProgress
+ pure (AgentEventsPartial events isInProgress now)
+
taskToUnixTs :: TaskCore.Task -> Int
taskToUnixTs t = round (utcTimeToPOSIXSeconds (TaskCore.taskUpdatedAt t))
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-19 08:27:11 +0000