feat: Support images and PDFs in tool results

NEWS.md

@@ -1,5 +1,7 @@
 # ellmer (development version)
 
+* ellmer now supports tools that return image or PDF content types, for example using `content_image_file()` or `content_image_pdf()`. (#735)
+
 * The following deprecated functions/arguments/methods have now been removed:
   * `Chat$extract_data()` -> `chat$chat_structured()` (0.2.0)
   * `Chat$extract_data_async()` -> `chat$chat_structured_async()` (0.2.0)

R/chat-tools.R

@@ -250,6 +250,67 @@ tool_results_as_turn <- function(results) {
   Turn("user", contents = results[is_tool_result])
 }
 
+is_extra_content <- function(x) {
+  S7::S7_inherits(x, ContentImage) || S7::S7_inherits(x, ContentPDF)
+}
+
+tool_results_separate_content <- function(turn) {
+  if (!some(turn@contents, is_tool_result)) {
+    return(list(tool_results = list(), contents = turn@contents))
+  }
+
+  tool_results <- list()
+  contents <- list()
+
+  for (result in turn@contents) {
+    if (!is_tool_result(result)) {
+      contents <- c(contents, list(result))
+      next
+    }
+
+    id <- result@request@id
+
+    # Check for extra content in the result value
+    if (is_extra_content(result@value)) {
+      contents <- c(
+        contents,
+        list(
+          ContentText(sprintf('<tool-content tool-call-id="%s">', id)),
+          result@value,
+          ContentText("</tool-content>")
+        )
+      )
+      result@value <- "[see below]"
+    }
+
+    # Check for extra content in list items
+    if (is_list(result@value)) {
+      for (j in seq_along(result@value)) {
+        if (is_extra_content(result@value[[j]])) {
+          contents <- c(
+            contents,
+            list(
+              ContentText(
+                sprintf('<tool-content tool-call-id="%s" item="%d">', id, j)
+              ),
+              result@value[[j]],
+              ContentText("</tool-content>")
+            )
+          )
+          result@value[[j]] <- sprintf("[see below: item %d]", j)
+        }
+      }
+    }
+
+    tool_results <- c(tool_results, list(result))
+  }
+
+  list(
+    tool_results = if (length(tool_results) > 0) tool_results else NULL,
+    contents = contents
+  )
+}
+
 turn_get_tool_errors <- function(turn = NULL) {
   if (is.null(turn)) {
     return(NULL)
@@ -328,7 +389,7 @@ maybe_echo_tool <- function(x, echo = "output") {
   } else {
     icon <- cli::col_green(cli::symbol$record)
     header <- ""
-    value <- tool_string(x)
+    value <- tool_string(x, force = TRUE)
   }
 
   value <- cli::style_italic(value)

R/content.R

@@ -142,7 +142,7 @@ ContentImage <- new_class(
 #' @param detail Not currently used.
 ContentImageRemote <- new_class(
   "ContentImageRemote",
-  parent = Content,
+  parent = ContentImage,
   properties = list(
     url = prop_string(),
     detail = prop_string(default = "")
@@ -164,7 +164,7 @@ method(contents_markdown, ContentImageRemote) <- function(content) {
 #' @param data Base64 encoded image data.
 ContentImageInline <- new_class(
   "ContentImageInline",
-  parent = Content,
+  parent = ContentImage,
   properties = list(
     type = prop_string(),
     data = prop_string(allow_null = TRUE)
@@ -294,7 +294,7 @@ method(format, ContentToolResult) <- function(
   if (tool_errored(x)) {
     value <- paste0(cli::col_red("Error: "), tool_error_string(x))
   } else {
-    value <- tool_string(x)
+    value <- tool_string(x, force = TRUE)
   }
 
   if (!is_string(value) || !grepl("\n", value)) {
@@ -308,7 +308,7 @@ tool_errored <- function(x) !is.null(x@error)
 tool_error_string <- function(x) {
   if (inherits(x@error, "condition")) conditionMessage(x@error) else x@error
 }
-tool_string <- function(x) {
+tool_string <- function(x, force = FALSE) {
   if (tool_errored(x)) {
     paste0("Tool calling failed with error ", tool_error_string(x))
   } else if (inherits(x@value, "AsIs")) {
@@ -318,7 +318,18 @@ tool_string <- function(x) {
   } else if (is.character(x@value)) {
     paste(x@value, collapse = "\n")
   } else {
-    jsonlite::toJSON(x@value, auto_unbox = TRUE)
+    tryCatch(
+      jsonlite::toJSON(x@value, auto_unbox = TRUE, force = force),
+      error = function(err) {
+        cli::cli_abort(
+          c(
+            "Could not convert tool result from {.obj_type_friendly {x@value}} to JSON.",
+            "i" = "If you are the tool author, update the tool to convert the result to a string or JSON."
+          ),
+          parent = err
+        )
+      }
+    )
   }
 }
 

R/provider-anthropic.R

@@ -309,7 +309,11 @@ method(as_json, list(ProviderAnthropic, Turn)) <- function(provider, x, ...) {
       # (all messages must have non-empty content)
       return(NULL)
     }
-    list(role = x@role, content = as_json(provider, x@contents, ...))
+    data <- tool_results_separate_content(x)
+    list(
+      role = x@role,
+      content = as_json(provider, c(data$tool_results, data$contents), ...)
+    )
   } else {
     cli::cli_abort("Unknown role {turn@role}", .internal = TRUE)
   }

R/provider-aws.R

@@ -369,7 +369,11 @@ method(as_json, list(ProviderAWSBedrock, Turn)) <- function(provider, x, ...) {
     # bedrock passes system prompt as separate arg
     NULL
   } else if (x@role %in% c("user", "assistant")) {
-    list(role = x@role, content = as_json(provider, x@contents, ...))
+    data <- tool_results_separate_content(x)
+    list(
+      role = x@role,
+      content = as_json(provider, c(data$tool_results, data$contents), ...)
+    )
   } else {
     cli::cli_abort("Unknown role {turn@role}", .internal = TRUE)
   }

R/provider-databricks.R

@@ -160,9 +160,11 @@ method(as_json, list(ProviderDatabricks, Turn)) <- function(provider, x, ...) {
     list(list(role = "system", content = x@contents[[1]]@text))
   } else if (x@role == "user") {
     # Each tool result needs to go in its own message with role "tool".
-    is_tool <- map_lgl(x@contents, S7_inherits, ContentToolResult)
-    if (any(is_tool)) {
-      return(lapply(x@contents[is_tool], function(tool) {
+    data <- tool_results_separate_content(x)
+    if (length(data$tool_results) > 0) {
+      # If Databricks starts supporting image/pdf content, we'll need to merge
+      # tool results with other content instead of just returning here.
+      return(lapply(data$tool_results, function(tool) {
         list(
           role = "tool",
           content = tool_string(tool),

R/provider-deepseek.R

@@ -79,22 +79,22 @@ method(as_json, list(ProviderDeepSeek, ContentText)) <- function(
 
 method(as_json, list(ProviderDeepSeek, Turn)) <- function(provider, x, ...) {
   if (x@role == "user") {
+    data <- tool_results_separate_content(x)
     # Text and tool results go in separate messages
-    texts <- keep(x@contents, S7_inherits, ContentText)
+    texts <- keep(data$contents, S7_inherits, ContentText)
     texts_out <- lapply(texts, function(text) {
       list(role = "user", content = as_json(provider, text, ...))
     })
 
-    tools <- keep(x@contents, S7_inherits, ContentToolResult)
-    tools_out <- lapply(tools, function(tool) {
+    tools_out <- lapply(data$tool_results, function(tool) {
       list(
         role = "tool",
         content = tool_string(tool),
         tool_call_id = tool@request@id
       )
     })
 
-    c(texts_out, tools_out)
+    c(tools_out, texts_out)
   } else if (x@role == "assistant") {
     # Tool requests come out of content and go into own argument
     text <- detect(x@contents, S7_inherits, ContentText)

R/provider-google.R

@@ -321,7 +321,11 @@ method(as_json, list(ProviderGoogleGemini, Turn)) <- function(
   if (x@role == "system") {
     # System messages go in the top-level API parameter
   } else if (x@role == "user") {
-    list(role = x@role, parts = as_json(provider, x@contents, ...))
+    data <- tool_results_separate_content(x)
+    list(
+      role = x@role,
+      parts = as_json(provider, c(data$tool_results, data$contents), ...)
+    )
   } else if (x@role == "assistant") {
     list(role = "model", parts = as_json(provider, x@contents, ...))
   } else {

R/provider-openai.R

@@ -278,24 +278,26 @@ method(as_json, list(ProviderOpenAI, Turn)) <- function(provider, x, ...) {
       list(role = "system", content = x@contents[[1]]@text)
     )
   } else if (x@role == "user") {
-    # Each tool result needs to go in its own message with role "tool"
-    is_tool <- map_lgl(x@contents, S7_inherits, ContentToolResult)
-    content <- as_json(provider, x@contents[!is_tool], ...)
-    if (length(content) > 0) {
+    data <- tool_results_separate_content(x)
+
+    if (length(data$contents) > 0) {
+      content <- as_json(provider, data$contents, ...)
       user <- list(list(role = "user", content = content))
     } else {
       user <- list()
     }
 
-    tools <- lapply(x@contents[is_tool], function(tool) {
+    # Each tool result needs to go in its own message with role "tool"
+    tools <- lapply(data$tool_results, function(tool) {
       list(
         role = "tool",
         content = tool_string(tool),
         tool_call_id = tool@request@id
       )
     })
 
-    c(user, tools)
+    # API errors if tool results do not follow previous assistant turn
+    c(tools, user)
   } else if (x@role == "assistant") {
     # Tool requests come out of content and go into own argument
     is_tool <- map_lgl(x@contents, is_tool_request)

R/provider-snowflake.R

@@ -289,13 +289,14 @@ method(as_json, list(ProviderSnowflakeCortex, Turn)) <- function(
     # Completely undocumented, but: it seems like the model is expecting the
     # tool result in textual format here, too -- otherwise it gets confused,
     # like it can't see the output.
-    content <- tool_string(x@contents[[1]])
+    content <- tool_string(x@contents[[1]], force = TRUE)
   } else {
     cli::cli_abort("Unsupported content type: {.cls {class(x@contents[[1]])}}.")
   }
+  data <- tool_results_separate_content(x)
   list(
     role = x@role,
-    content_list = as_json(provider, x@contents, ...)
+    content_list = as_json(provider, c(data$tool_results, data$contents), ...)
   )
 }
 

tests/testthat/test-chat-tools.R

@@ -786,3 +786,88 @@ test_that("match_tools() matches tools in a turn to a list of tools", {
   turn_matched <- match_tools(turn, tools)
   expect_equal(turn_matched, fixture_turn_with_tool_requests(with_tool = TRUE))
 })
+
+test_that("tool_results_separate_content() splits tool results and content", {
+  request <- ContentToolRequest("x1", "my_tool", list())
+  result <- ContentToolResult(
+    content_image_url("https://placecat.com/200/200"),
+    request = request
+  )
+  user_turn <- tool_results_as_turn(list(result))
+
+  data <- tool_results_separate_content(user_turn)
+  expect_length(data$tool_results, 1)
+  expect_s7_class(data$tool_results[[1]], ContentToolResult)
+  expect_true(is.character(data$tool_results[[1]]@value))
+
+  expect_length(data$contents, 3)
+  expect_equal(data$contents[[2]], result@value)
+  expect_s7_class(data$contents[[1]], ContentText)
+  expect_s7_class(data$contents[[3]], ContentText)
+})
+
+test_that("tool_results_separate_content() keeps content order", {
+  request <- ContentToolRequest("x1", "my_tool", list())
+  result <- ContentToolResult(
+    content_image_url("https://placecat.com/200/200"),
+    request = request
+  )
+  user_turn <- Turn(
+    "user",
+    list(
+      ContentText("Here is a cat image:"),
+      result,
+      ContentText("Isn't it cute?")
+    )
+  )
+
+  data <- tool_results_separate_content(user_turn)
+  expect_length(data$tool_results, 1)
+  expect_s7_class(data$tool_results[[1]], ContentToolResult)
+  expect_true(is.character(data$tool_results[[1]]@value))
+
+  expect_length(data$contents, 5)
+  expect_equal(data$contents[[1]]@text, "Here is a cat image:")
+  expect_s7_class(data$contents[[2]], ContentText) # Added text for tool result
+  expect_equal(data$contents[[3]], result@value)
+  expect_s7_class(data$contents[[4]], ContentText) # Closing text for tool result
+  expect_equal(data$contents[[5]]@text, "Isn't it cute?")
+})
+
+test_that("tool_results_separate_content() handles no tool results", {
+  user_turn <- Turn(
+    "user",
+    list(
+      ContentText("Hello!"),
+      ContentText("How are you?")
+    )
+  )
+
+  data <- tool_results_separate_content(user_turn)
+  expect_length(data$tool_results, 0)
+  expect_length(data$contents, 2)
+  expect_equal(data$contents, user_turn@contents)
+})
+
+test_that("tool_results_separate_content() handles list result values", {
+  request <- ContentToolRequest("x1", "my_tool", list())
+  result <- ContentToolResult(
+    list(
+      content_image_url("https://placecat.com/200/200"),
+      "not an image",
+      content_image_url("https://placecat.com/300/300")
+    ),
+    request = request
+  )
+  user_turn <- Turn("user", list(result))
+  data <- tool_results_separate_content(user_turn)
+
+  expect_length(data$tool_results, 1)
+  expect_length(data$tool_results[[1]]@value, 3)
+  # Images are replaced with text placeholders in the tool result
+  expect_true(every(data$tool_results[[1]]@value, is.character))
+
+  expect_length(data$contents, 3 * 2)
+  expect_equal(data$contents[[2]], result@value[[1]])
+  expect_equal(data$contents[[5]], result@value[[3]])
+})