diff options
Diffstat (limited to 'Omni/Jr/Web')
| -rw-r--r-- | Omni/Jr/Web/Components.hs | 178 | ||||
| -rw-r--r-- | Omni/Jr/Web/Style.hs | 64 |
2 files changed, 221 insertions, 21 deletions
diff --git a/Omni/Jr/Web/Components.hs b/Omni/Jr/Web/Components.hs index 3a9df0f..2f885ce 100644 --- a/Omni/Jr/Web/Components.hs +++ b/Omni/Jr/Web/Components.hs @@ -120,11 +120,26 @@ module Omni.Jr.Web.Components renderDecodedToolResult, renderFormattedJson, timelineScrollScript, + + -- * Tool rendering helpers + renderBashToolCall, + renderReadToolCall, + renderEditToolCall, + renderSearchToolCall, + renderSearchAndReadToolCall, + renderWriteToolCall, + renderGenericToolCall, + extractJsonField, + extractJsonFieldInt, + shortenPath, + DecodedToolResult (..), + decodeToolResult, ) where import Alpha import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as AesonKey import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.ByteString.Lazy as LBS import qualified Data.List as List @@ -1479,29 +1494,150 @@ renderAssistantTimelineEvent content _actor timestamp now = when isTruncated <| Lucid.span_ [Lucid.class_ "event-truncated"] "..." renderToolCallTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m () -renderToolCallTimelineEvent content _actor timestamp now = - let (toolName, args) = parseToolCallContent content - summary = formatToolCallSummary toolName args - in Lucid.details_ [Lucid.class_ "timeline-tool-call"] <| do - Lucid.summary_ <| do - Lucid.span_ [Lucid.class_ "event-icon"] "🔧" - Lucid.span_ [Lucid.class_ "tool-name"] (Lucid.toHtml toolName) - Lucid.span_ [Lucid.class_ "tool-summary"] (Lucid.toHtml summary) - renderRelativeTimestamp now timestamp - Lucid.div_ [Lucid.class_ "event-content tool-args"] <| do - renderCollapsibleOutput args +renderToolCallTimelineEvent content _actor _timestamp _now = + let (toolName, argsJson) = parseToolCallContent content + in case toolName of + "run_bash" -> renderBashToolCall argsJson + "read_file" -> renderReadToolCall argsJson + "edit_file" -> renderEditToolCall argsJson + "search_codebase" -> renderSearchToolCall argsJson + "search_and_read" -> renderSearchAndReadToolCall argsJson + "write_file" -> renderWriteToolCall argsJson + _ -> renderGenericToolCall toolName argsJson + +renderBashToolCall :: (Monad m) => Text -> Lucid.HtmlT m () +renderBashToolCall argsJson = + let cmd = extractJsonField "command" argsJson + in Lucid.div_ [Lucid.class_ "tool-bash"] <| do + Lucid.span_ [Lucid.class_ "tool-bash-prompt"] "ϟ" + Lucid.code_ [Lucid.class_ "tool-bash-cmd"] (Lucid.toHtml cmd) + +renderReadToolCall :: (Monad m) => Text -> Lucid.HtmlT m () +renderReadToolCall argsJson = + let path = extractJsonField "path" argsJson + startLine = extractJsonFieldInt "start_line" argsJson + endLine = extractJsonFieldInt "end_line" argsJson + lineRange = case (startLine, endLine) of + (Just s, Just e) -> " @" <> tshow s <> "-" <> tshow e + (Just s, Nothing) -> " @" <> tshow s <> "+" + _ -> "" + in Lucid.div_ [Lucid.class_ "tool-compact"] <| do + Lucid.span_ [Lucid.class_ "tool-check"] "✓" + Lucid.span_ [Lucid.class_ "tool-label"] "Read" + Lucid.code_ [Lucid.class_ "tool-path"] (Lucid.toHtml (shortenPath path <> lineRange)) + +renderEditToolCall :: (Monad m) => Text -> Lucid.HtmlT m () +renderEditToolCall argsJson = + let path = extractJsonField "path" argsJson + in Lucid.div_ [Lucid.class_ "tool-compact"] <| do + Lucid.span_ [Lucid.class_ "tool-check"] "✓" + Lucid.span_ [Lucid.class_ "tool-label"] "Edit" + Lucid.code_ [Lucid.class_ "tool-path"] (Lucid.toHtml (shortenPath path)) + +renderSearchToolCall :: (Monad m) => Text -> Lucid.HtmlT m () +renderSearchToolCall argsJson = + let searchPat = extractJsonField "pattern" argsJson + searchPath = extractJsonField "path" argsJson + pathSuffix = if Text.null searchPath || searchPath == "." then "" else " in " <> shortenPath searchPath + in Lucid.div_ [Lucid.class_ "tool-compact"] <| do + Lucid.span_ [Lucid.class_ "tool-check"] "✓" + Lucid.span_ [Lucid.class_ "tool-label"] "Grep" + Lucid.code_ [Lucid.class_ "tool-pattern"] (Lucid.toHtml searchPat) + unless (Text.null pathSuffix) + <| Lucid.span_ [Lucid.class_ "tool-path-suffix"] (Lucid.toHtml pathSuffix) + +renderWriteToolCall :: (Monad m) => Text -> Lucid.HtmlT m () +renderWriteToolCall argsJson = + let path = extractJsonField "path" argsJson + in Lucid.div_ [Lucid.class_ "tool-compact"] <| do + Lucid.span_ [Lucid.class_ "tool-check"] "✓" + Lucid.span_ [Lucid.class_ "tool-label"] "Write" + Lucid.code_ [Lucid.class_ "tool-path"] (Lucid.toHtml (shortenPath path)) + +renderSearchAndReadToolCall :: (Monad m) => Text -> Lucid.HtmlT m () +renderSearchAndReadToolCall argsJson = + let searchPat = extractJsonField "pattern" argsJson + searchPath = extractJsonField "path" argsJson + pathSuffix = if Text.null searchPath || searchPath == "." then "" else " in " <> shortenPath searchPath + in Lucid.div_ [Lucid.class_ "tool-compact"] <| do + Lucid.span_ [Lucid.class_ "tool-check"] "✓" + Lucid.span_ [Lucid.class_ "tool-label"] "Find" + Lucid.code_ [Lucid.class_ "tool-pattern"] (Lucid.toHtml searchPat) + unless (Text.null pathSuffix) + <| Lucid.span_ [Lucid.class_ "tool-path-suffix"] (Lucid.toHtml pathSuffix) + +renderGenericToolCall :: (Monad m) => Text -> Text -> Lucid.HtmlT m () +renderGenericToolCall toolName argsJson = + Lucid.details_ [Lucid.class_ "tool-generic"] <| do + Lucid.summary_ <| do + Lucid.span_ [Lucid.class_ "tool-check"] "✓" + Lucid.span_ [Lucid.class_ "tool-label"] (Lucid.toHtml toolName) + Lucid.pre_ [Lucid.class_ "tool-args-pre"] (Lucid.toHtml argsJson) + +extractJsonField :: Text -> Text -> Text +extractJsonField field jsonText = + case Aeson.decode (LBS.fromStrict (str jsonText)) of + Just (Aeson.Object obj) -> + case KeyMap.lookup (AesonKey.fromText field) obj of + Just (Aeson.String s) -> s + _ -> "" + _ -> "" + +extractJsonFieldInt :: Text -> Text -> Maybe Int +extractJsonFieldInt field jsonText = + case Aeson.decode (LBS.fromStrict (str jsonText)) of + Just (Aeson.Object obj) -> + case KeyMap.lookup (AesonKey.fromText field) obj of + Just (Aeson.Number n) -> Just (floor n) + _ -> Nothing + _ -> Nothing + +shortenPath :: Text -> Text +shortenPath path = + let parts = Text.splitOn "/" path + relevant = dropWhile (\p -> p `elem` ["", "home", "ben", "omni"]) parts + in Text.intercalate "/" relevant renderToolResultTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m () -renderToolResultTimelineEvent content _actor timestamp now = - let lineCount = length (Text.lines content) - in Lucid.details_ [Lucid.class_ "timeline-tool-result"] <| do - Lucid.summary_ <| 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 - Lucid.pre_ [Lucid.class_ "event-content tool-output"] (renderDecodedToolResult content) +renderToolResultTimelineEvent content _actor _timestamp _now = + let decoded = decodeToolResult content + isSuccess = toolResultIsSuccess decoded + output = toolResultOutput' decoded + lineCount = length (Text.lines output) + in if Text.null output || (isSuccess && lineCount <= 1) + then pure () + else + Lucid.div_ [Lucid.class_ "tool-result-output"] <| do + when (lineCount > 10) + <| Lucid.details_ [Lucid.class_ "result-collapsible"] + <| do + Lucid.summary_ (Lucid.toHtml (tshow lineCount <> " lines")) + Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml output) + when (lineCount <= 10) + <| Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml output) + +data DecodedToolResult = DecodedToolResult + { toolResultIsSuccess :: Bool, + toolResultOutput' :: Text, + toolResultError' :: Maybe Text + } + +decodeToolResult :: Text -> DecodedToolResult +decodeToolResult content = + case Aeson.decode (LBS.fromStrict (str content)) of + Just (Aeson.Object obj) -> + DecodedToolResult + { toolResultIsSuccess = case KeyMap.lookup "success" obj of + Just (Aeson.Bool b) -> b + _ -> True, + toolResultOutput' = case KeyMap.lookup "output" obj of + Just (Aeson.String s) -> s + _ -> "", + toolResultError' = case KeyMap.lookup "error" obj of + Just (Aeson.String s) -> Just s + _ -> Nothing + } + _ -> DecodedToolResult True content Nothing renderCheckpointEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m () renderCheckpointEvent content actor timestamp now = diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs index 0f4b300..ee5136e 100644 --- a/Omni/Jr/Web/Style.hs +++ b/Omni/Jr/Web/Style.hs @@ -1815,6 +1815,70 @@ unifiedTimelineStyles = do fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] whiteSpace preWrap overflowWrap breakWord + compactToolStyles + +compactToolStyles :: Css +compactToolStyles = do + ".tool-compact" ? do + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + padding (px 2) (px 0) (px 2) (px 0) + ".tool-check" ? do + color "#10b981" + fontWeight bold + ".tool-label" ? do + color "#6b7280" + fontWeight (weight 500) + ".tool-path" ? do + color "#3b82f6" + ".tool-pattern" ? do + color "#8b5cf6" + backgroundColor "#f5f3ff" + padding (px 1) (px 4) (px 1) (px 4) + borderRadius (px 2) (px 2) (px 2) (px 2) + ".tool-path-suffix" ? do + color "#6b7280" + fontSize (px 11) + ".tool-bash" ? do + display flex + alignItems flexStart + Stylesheet.key "gap" ("6px" :: Text) + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + padding (px 2) (px 0) (px 2) (px 0) + ".tool-bash-prompt" ? do + color "#f59e0b" + fontWeight bold + fontSize (px 14) + ".tool-bash-cmd" ? do + color "#374151" + backgroundColor "#f3f4f6" + padding (px 2) (px 6) (px 2) (px 6) + borderRadius (px 3) (px 3) (px 3) (px 3) + wordBreak breakAll + ".tool-generic" ? do + fontSize (px 12) + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + ".tool-generic" |> "summary" ? do + cursor pointer + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + ".tool-args-pre" ? do + margin (px 4) (px 0) (px 0) (px 16) + padding (px 6) (px 8) (px 6) (px 8) + backgroundColor "#f9fafb" + borderRadius (px 3) (px 3) (px 3) (px 3) + fontSize (px 11) + whiteSpace preWrap + maxHeight (px 200) + overflowY auto + ".tool-result-output" ? do + marginLeft (px 16) + marginTop (px 2) responsiveStyles :: Css responsiveStyles = do |
