diff options
Diffstat (limited to 'Omni/Jr')
| -rw-r--r-- | Omni/Jr/Web.hs | 184 | ||||
| -rw-r--r-- | Omni/Jr/Web/Style.hs | 160 |
2 files changed, 341 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)) diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs index 8c423bb..00d66c2 100644 --- a/Omni/Jr/Web/Style.hs +++ b/Omni/Jr/Web/Style.hs @@ -39,6 +39,7 @@ stylesheet = do taskMetaStyles timeFilterStyles sortDropdownStyles + agentLogStyles responsiveStyles darkModeStyles @@ -1402,6 +1403,151 @@ taskMetaStyles = do color "#d1d5db" Stylesheet.key "user-select" ("none" :: Text) +agentLogStyles :: Css +agentLogStyles = do + ".agent-log-section" ? do + marginTop (em 1) + paddingTop (em 1) + borderTop (px 1) solid "#e5e7eb" + ".agent-log-live" ? do + fontSize (px 10) + fontWeight bold + color "#10b981" + backgroundColor "#d1fae5" + padding (px 2) (px 6) (px 2) (px 6) + borderRadius (px 10) (px 10) (px 10) (px 10) + marginLeft (px 8) + textTransform uppercase + Stylesheet.key "animation" ("pulse 2s infinite" :: Text) + ".agent-log" ? do + maxHeight (px 600) + overflowY auto + display flex + flexDirection column + Stylesheet.key "gap" ("8px" :: Text) + padding (px 8) (px 0) (px 8) (px 0) + ".agent-event" ? do + fontSize (px 13) + ".event-header" ? do + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + marginBottom (px 4) + ".event-icon" ? do + fontSize (px 14) + width (px 20) + textAlign center + ".event-label" ? do + fontWeight (weight 500) + color "#374151" + ".event-assistant" ? do + padding (px 0) (px 0) (px 0) (px 0) + ".event-bubble" ? do + backgroundColor "#f3f4f6" + padding (px 8) (px 12) (px 8) (px 12) + borderRadius (px 8) (px 8) (px 8) (px 8) + whiteSpace preWrap + lineHeight (em 1.5) + ".event-truncated" ? do + color "#6b7280" + fontStyle italic + ".event-tool-call" ? do + borderLeft (px 3) solid "#3b82f6" + paddingLeft (px 8) + ".event-tool-call" |> "summary" ? do + cursor pointer + listStyleType none + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + ".event-tool-call" |> "summary" # before ? do + content (stringContent "▶") + fontSize (px 10) + color "#6b7280" + transition "transform" (ms 150) ease (sec 0) + ".event-tool-call[open]" |> "summary" # before ? do + Stylesheet.key "transform" ("rotate(90deg)" :: Text) + ".tool-name" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + color "#3b82f6" + ".tool-args" ? do + marginTop (px 4) + paddingLeft (px 20) + ".tool-output-pre" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 11) + backgroundColor "#1e1e1e" + color "#d4d4d4" + padding (px 8) (px 10) (px 8) (px 10) + borderRadius (px 4) (px 4) (px 4) (px 4) + overflowX auto + whiteSpace preWrap + maxHeight (px 300) + margin (px 0) (px 0) (px 0) (px 0) + ".event-tool-result" ? do + borderLeft (px 3) solid "#10b981" + paddingLeft (px 8) + ".result-header" ? do + fontSize (px 12) + ".line-count" ? do + fontSize (px 11) + color "#6b7280" + backgroundColor "#f3f4f6" + padding (px 1) (px 6) (px 1) (px 6) + borderRadius (px 10) (px 10) (px 10) (px 10) + ".result-collapsible" |> "summary" ? do + cursor pointer + fontSize (px 12) + color "#0066cc" + marginBottom (px 4) + ".result-collapsible" |> "summary" # hover ? textDecoration underline + ".tool-output" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 11) + backgroundColor "#1e1e1e" + color "#d4d4d4" + padding (px 8) (px 10) (px 8) (px 10) + borderRadius (px 4) (px 4) (px 4) (px 4) + overflowX auto + whiteSpace preWrap + maxHeight (px 300) + margin (px 0) (px 0) (px 0) (px 0) + ".event-cost" ? do + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + fontSize (px 11) + color "#6b7280" + padding (px 4) (px 0) (px 4) (px 0) + ".cost-text" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + ".event-error" ? do + borderLeft (px 3) solid "#ef4444" + paddingLeft (px 8) + backgroundColor "#fef2f2" + padding (px 8) (px 8) (px 8) (px 12) + borderRadius (px 4) (px 4) (px 4) (px 4) + ".event-error" |> ".event-label" ? color "#dc2626" + ".error-message" ? do + color "#dc2626" + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + whiteSpace preWrap + ".event-complete" ? do + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + color "#10b981" + fontWeight (weight 500) + padding (px 8) (px 0) (px 8) (px 0) + ".output-collapsible" |> "summary" ? do + cursor pointer + fontSize (px 12) + color "#0066cc" + marginBottom (px 4) + ".output-collapsible" |> "summary" # hover ? textDecoration underline + Stylesheet.key "@keyframes pulse" ("0%, 100% { opacity: 1; } 50% { opacity: 0.5; }" :: Text) + responsiveStyles :: Css responsiveStyles = do query Media.screen [Media.maxWidth (px 600)] <| do @@ -1703,6 +1849,20 @@ darkModeStyles = ".retry-banner-details" ? color "#d1d5db" ".retry-value" ? color "#9ca3af" ".retry-commit" ? backgroundColor "#374151" + ".agent-log-section" ? borderTopColor "#374151" + ".agent-log-live" ? do + backgroundColor "#065f46" + color "#a7f3d0" + ".event-bubble" ? backgroundColor "#374151" + ".event-label" ? color "#d1d5db" + ".line-count" ? do + backgroundColor "#374151" + color "#9ca3af" + ".event-error" ? do + backgroundColor "#450a0a" + borderColor "#dc2626" + ".event-error" |> ".event-label" ? color "#f87171" + ".error-message" ? color "#f87171" -- Responsive dark mode: dropdown content needs background on mobile query Media.screen [Media.maxWidth (px 600)] <| do ".navbar-dropdown-content" ? do |