R/llm_providers.R

In tidyprompt: Prompt Large Language Models and Enhance Their Functionality

#' Create a new Ollama LLM provider
#'
#' This function creates a new [llm_provider-class] object that interacts with the Ollama API.
#'
#' @param parameters A named list of parameters. Currently the following parameters are required:
#'    - model: The name of the model to use
#'    - stream: A logical indicating whether the API should stream responses
#'
#'  Additional parameters may be passed by adding them to the parameters list;
#'  these parameters will be passed to the Ollama API via the body of the POST request.
#'
#'  Note that various Ollama options need to be set in a list named 'options' within
#'  the parameters list (e.g., context window size is represented in $parameters$options$num_ctx).
#'  For ease of configuration, the 'set_option' and 'set_options' functions are available
#'  (e.g., `$set_option("num_ctx", 1024)` or `$set_options(list(num_ctx = 1024, temperature = 1))`).
#   See available settings at https://github.com/ollama/ollama/blob/main/docs/api.md
#' @param verbose A logical indicating whether the interaction with the LLM provider
#' should be printed to the console
#' @param url The URL to the Ollama API endpoint for chat completion
#' (typically: "http://localhost:11434/api/chat")
#' @param num_ctx The context window size to use.
#' When NULL, the default context window size will be used. This is a function
#' argument for convenience, and will be passed to '$parameters$options$num_ctx'
#'
#' @return A new [llm_provider-class] object for use of the Ollama API
#'
#' @export
#' @example inst/examples/llm_providers.R
#'
#' @family llm_provider
llm_provider_ollama <- function(
  parameters = list(
    model = "llama3.1:8b",
    stream = getOption("tidyprompt.stream", TRUE)
  ),
  verbose = getOption("tidyprompt.verbose", TRUE),
  url = "http://localhost:11434/api/chat",
  num_ctx = NULL
) {
  complete_chat <- function(chat_history) {
    # Build messages, with optional image support for the last user message
    msgs <- lapply(seq_len(nrow(chat_history)), function(i) {
      list(role = chat_history$role[i], content = chat_history$content[i])
    })

    # If images are attached, convert them to Ollama's `images` array (base64)
    add_parts <- self$parameters$.add_image_parts %||% NULL
    if (!is.null(add_parts) && length(add_parts) > 0) {
      last_i <- nrow(chat_history)
      if (last_i > 0 && identical(chat_history$role[last_i], "user")) {
        b64s <- list()
        for (p in add_parts) {
          src <- p$source %||% NULL
          if (identical(src, "b64") && !is.null(p$data)) {
            b64s[[length(b64s) + 1]] <- as.character(p$data)
          } else if (identical(src, "url") && !is.null(p$data)) {
            # Download and base64-encode
            res <- tryCatch(
              {
                rq <- httr2::request(as.character(p$data))
                rp <- httr2::req_perform(rq)
                raw <- httr2::resp_body_raw(rp)
                jsonlite::base64_enc(raw)
              },
              error = function(e) NULL
            )
            if (!is.null(res)) b64s[[length(b64s) + 1]] <- as.character(res)
          }
        }
        if (length(b64s) > 0) {
          msgs[[last_i]]$images <- unname(b64s)
        }
      }
    }

    body <- list(
      model = self$parameters$model,
      messages = msgs
    )

    # Append user-facing parameters only; skip internal helpers (prefixed with '.')
    for (name in names(self$parameters)) {
      if (!startsWith(name, ".")) body[[name]] <- self$parameters[[name]]
    }

    request <- httr2::request(self$url) |>
      httr2::req_body_json(body)

    stream_cb <- self$stream_callback %||%
      getOption("tidyprompt.stream_callback", NULL)

    request_llm_provider(
      chat_history,
      request,
      stream = self$parameters$stream,
      verbose = self$verbose,
      api_type = self$api_type,
      stream_callback = stream_cb,
      llm_provider = self
    )
  }

  if (is.null(parameters$stream)) {
    parameters$stream <- FALSE
  }
  if (!is.null(num_ctx)) {
    parameters$options$num_ctx <- num_ctx
  }

  # Extend llm_provider-class with 'set_option' functions
  class <- R6::R6Class(
    "llm_provider_ollama-class",
    inherit = `llm_provider-class`,
    public = list(
      set_option = function(name, value) {
        stopifnot(
          is.character(name),
          is.character(value) || is.logical(value) || is.numeric(value)
        )

        self$parameters$options[[name]] <- value
        return(self)
      },
      set_options = function(options) {
        stopifnot(
          is.list(options),
          !is.null(names(options))
        )

        for (name in names(options)) {
          value <- options[[name]]
          stopifnot(
            is.character(value) || is.logical(value) || is.numeric(value)
          )

          self$parameters$options[[name]] <- value
        }
        return(self)
      }
    )
  )

  ollama <- class$new(
    complete_chat_function = complete_chat,
    parameters = parameters,
    verbose = verbose,
    url = url,
    api_type = "ollama"
  )

  return(ollama)
}

#' Create a new OpenAI LLM provider
#'
#' This function creates a new [llm_provider-class] object that interacts with the Open AI API.
#' Supports both the Chat Completions API (/v1/chat/completions) and the Responses API (/v1/responses).
#'
#' @param parameters A named list of parameters. Currently the following parameters are required:
#'    - model: The name of the model to use
#'    - api_key: The API key to use for authentication with the OpenAI API. This
#'    should be a project API key (not a user API key)
#'    - url: The URL to the OpenAI API (may also be an alternative endpoint
#'    that provides a similar API.)
#'    - stream: A logical indicating whether the API should stream responses
#'
#'  Additional parameters are appended to the request body; see the OpenAI API
#'  documentation for more information: https://platform.openai.com/docs/api-reference/chat
#' @param verbose A logical indicating whether the interaction with the LLM provider
#' should be printed to the console. Default is TRUE.
#' @param url The URL to the OpenAI API endpoint for chat completion
#' (typically: "https://api.openai.com/v1/chat/completions"
#' or "https://api.openai.com/v1/responses"; both the Chat Completions API and
#' the Responses API are supported; the Responses API is more modern)
#' @param api_key The API key to use for authentication with the OpenAI API
#'
#' @return A new [llm_provider-class] object for use of the OpenAI API
#'
#' @export
#' @example inst/examples/llm_providers.R
#'
#' @family llm_provider
llm_provider_openai <- function(
  parameters = list(
    model = "gpt-4o-mini",
    stream = getOption("tidyprompt.stream", TRUE)
  ),
  verbose = getOption("tidyprompt.verbose", TRUE),
  url = "https://api.openai.com/v1/responses",
  api_key = Sys.getenv("OPENAI_API_KEY")
) {
  complete_chat <- function(chat_history) {
    headers <- c(
      "Content-Type" = "application/json",
      "Authorization" = paste("Bearer", self$api_key)
    )

    # Build messages; support multimodal content for last user message
    add_parts <- self$parameters$.add_image_parts %||% NULL
    n <- nrow(chat_history)
    messages <- lapply(seq_len(n), function(i) {
      role <- chat_history$role[i]
      text <- chat_history$content[i]
      # For the last user message, if images are attached, convert to content parts
      if (!is.null(add_parts) && i == n && identical(role, "user")) {
        parts <- list()
        if (!is.null(text) && nzchar(text)) {
          parts[[length(parts) + 1]] <- list(type = "text", text = text)
        }
        for (p in add_parts) {
          src <- p$source %||% NULL
          if (identical(src, "url") && !is.null(p$data)) {
            parts[[length(parts) + 1]] <- list(
              type = "image_url",
              image_url = compact_list(list(
                url = as.character(p$data),
                detail = p$detail %||% NULL
              ))
            )
          } else if (identical(src, "b64") && !is.null(p$data)) {
            mime <- p$mime %||% "image/png"
            data_url <- paste0("data:", mime, ";base64,", as.character(p$data))
            parts[[length(parts) + 1]] <- list(
              type = "image_url",
              image_url = compact_list(list(
                url = data_url,
                detail = p$detail %||% NULL
              ))
            )
          }
        }
        return(list(role = role, content = parts))
      }
      list(role = role, content = text)
    })

    # Decide between Chat Completions style (messages) and Responses API (input)
    # Support both legacy Chat Completions (messages) and modern Responses API (input)
    use_responses_api <- grepl("/responses$", self$url)
    if (use_responses_api) {
      # Transform messages -> input with part types changed to input_*/output_* variants.
      # For image parts, OpenAI Responses API expects a scalar URL string in `image_url`
      # and (optionally) a separate `detail` field, not an object. The previous implementation
      # forwarded the object `{ url = ..., detail = ... }` which triggers a 400 error:
      # "Invalid type for 'input[0].content[1].image_url': expected an image URL, but got an object instead.".
      input <- lapply(messages, function(msg) {
        role <- msg$role
        content <- msg$content
        parts <- list()
        text_type <- if (identical(role, "assistant")) {
          "output_text"
        } else {
          "input_text"
        }
        image_type <- if (identical(role, "assistant")) {
          "output_image"
        } else {
          "input_image"
        }
        if (is.character(content)) {
          if (nzchar(content)) {
            parts[[length(parts) + 1]] <- list(type = text_type, text = content)
          }
        } else if (is.list(content)) {
          for (part in content) {
            if (identical(part$type, "text")) {
              if (!is.null(part$text) && nzchar(part$text)) {
                parts[[length(parts) + 1]] <- list(
                  type = text_type,
                  text = part$text
                )
              }
            } else if (identical(part$type, "image_url")) {
              img <- part$image_url
              if (is.list(img)) {
                url_val <- img$url %||% NULL
                detail_val <- img$detail %||% NULL
                if (!is.null(url_val)) {
                  parts[[length(parts) + 1]] <- compact_list(list(
                    type = image_type,
                    image_url = as.character(url_val),
                    detail = detail_val
                  ))
                }
              } else if (is.character(img) && length(img) == 1) {
                parts[[length(parts) + 1]] <- list(
                  type = image_type,
                  image_url = img
                )
              }
            } else {
              # Fallback: keep as input_text if unknown
              if (!is.null(part$text)) {
                parts[[length(parts) + 1]] <- list(
                  type = text_type,
                  text = part$text
                )
              }
            }
          }
        }
        list(role = role, content = parts)
      })
      body <- list(input = input)
    } else {
      body <- list(messages = messages)
    }

    # Append user-facing parameters only; skip internal helpers (prefixed with '.')
    # This prevents sending fields like '.add_image_parts' which cause 400 errors
    # from OpenAI ("Unknown parameter"). Internal parameters are consumed above.
    for (name in names(self$parameters)) {
      if (!startsWith(name, ".")) {
        body[[name]] <- self$parameters[[name]]
      }
    }

    request <- httr2::request(self$url) |>
      httr2::req_body_json(body) |>
      httr2::req_headers(!!!headers)

    stream_cb <- self$stream_callback %||%
      getOption("tidyprompt.stream_callback", NULL)

    request_llm_provider(
      chat_history,
      request,
      stream = self$parameters$stream,
      verbose = self$verbose,
      api_type = self$api_type,
      stream_callback = stream_cb,
      llm_provider = self
    )
  }

  return(
    `llm_provider-class`$new(
      complete_chat_function = complete_chat,
      parameters = parameters,
      verbose = verbose,
      url = url,
      api_key = api_key,
      api_type = "openai"
    )
  )
}

#' Create a new OpenRouter LLM provider
#'
#' This function creates a new [llm_provider-class] object that interacts with the OpenRouter API.
#'
#' @param parameters A named list of parameters. Currently the following parameters are required:
#'    - model: The name of the model to use
#'    - stream: A logical indicating whether the API should stream responses
#'
#'  Additional parameters are appended to the request body; see the OpenRouter API
#'  documentation for more information: https://openrouter.ai/docs/parameters
#' @param verbose A logical indicating whether the interaction with the LLM provider
#' should be printed to the console.
#' @param url The URL to the OpenRouter API endpoint for chat completion
#' @param api_key The API key to use for authentication with the OpenRouter API
#'
#' @return A new [llm_provider-class] object for use of the OpenRouter API
#'
#' @export
#' @example inst/examples/llm_providers.R
#'
#' @family llm_provider
llm_provider_openrouter <- function(
  parameters = list(
    model = "qwen/qwen-2.5-7b-instruct",
    stream = getOption("tidyprompt.stream", TRUE)
  ),
  verbose = getOption("tidyprompt.verbose", TRUE),
  url = "https://openrouter.ai/api/v1/chat/completions",
  api_key = Sys.getenv("OPENROUTER_API_KEY")
) {
  llm_provider_openai(parameters, verbose, url, api_key)
}

#' Create a new Mistral LLM provider
#'
#' This function creates a new [llm_provider-class] object that interacts with the Mistral API.
#'
#' @param parameters A named list of parameters. Currently the following parameters are required:
#'    - model: The name of the model to use
#'    - stream: A logical indicating whether the API should stream responses
#'
#'  Additional parameters are appended to the request body; see the Mistral API
#'  documentation for more information: https://docs.mistral.ai/api/#tag/chat
#' @param verbose A logical indicating whether the interaction with the LLM provider
#' should be printed to the consol
#' @param url The URL to the Mistral API endpoint for chat completion
#' @param api_key The API key to use for authentication with the Mistral API
#'
#' @return A new [llm_provider-class] object for use of the Mistral API
#'
#' @export
#' @example inst/examples/llm_providers.R
#'
#' @family llm_provider
llm_provider_mistral <- function(
  parameters = list(
    model = "ministral-3b-latest",
    stream = getOption("tidyprompt.stream", TRUE)
  ),
  verbose = getOption("tidyprompt.verbose", TRUE),
  url = "https://api.mistral.ai/v1/chat/completions",
  api_key = Sys.getenv("MISTRAL_API_KEY")
) {
  llm_provider_openai(parameters, verbose, url, api_key)
}

#' Create a new Groq LLM provider
#'
#' This function creates a new [llm_provider-class] object that interacts with the Groq API.
#'
#' @param parameters A named list of parameters. Currently the following parameters are required:
#'   - model: The name of the model to use
#'   - stream: A logical indicating whether the API should stream responses
#'
#'  Additional parameters are appended to the request body; see the Groq API
#'  documentation for more information: https://console.groq.com/docs/api-reference#chat-create
#' @param verbose A logical indicating whether the interaction with the LLM provider
#' should be printed to the console
#' @param api_key The API key to use for authentication with the Groq API
#' @param url The URL to the Groq API endpoint for chat completion
#'
#' @return A new [llm_provider-class] object for use of the Groq API
#'
#' @export
#' @example inst/examples/llm_providers.R
#'
#' @family llm_provider
llm_provider_groq <- function(
  parameters = list(
    model = "llama-3.1-8b-instant",
    stream = TRUE
  ),
  verbose = getOption("tidyprompt.verbose", TRUE),
  url = "https://api.groq.com/openai/v1/chat/completions",
  api_key = Sys.getenv("GROQ_API_KEY")
) {
  llm_provider_openai(parameters, verbose, url, api_key)
}

#' Create a new XAI (Grok) LLM provider
#'
#' This function creates a new [llm_provider-class] object that interacts with the XAI API.
#'
#' @param parameters A named list of parameters. Currently the following parameters are required:
#'   - model: The name of the model to use
#'   - stream: A logical indicating whether the API should stream responses
#'
#'  Additional parameters are appended to the request body; see the XAI API
#'  documentation for more information: https://docs.x.ai/api/endpoints#chat-completions
#' @param verbose A logical indicating whether the interaction with the LLM provider
#' should be printed to the console. Default is TRUE.
#' @param url The URL to the XAI API endpoint for chat completion
#' @param api_key The API key to use for authentication with the XAI API
#'
#' @return A new [llm_provider-class] object for use of the XAI API
#'
#' @export
#' @example inst/examples/llm_providers.R
#'
#' @family llm_provider
llm_provider_xai <- function(
  parameters = list(
    model = "grok-beta",
    stream = getOption("tidyprompt.stream", TRUE)
  ),
  verbose = getOption("tidyprompt.verbose", TRUE),
  url = "https://api.x.ai/v1/chat/completions",
  api_key = Sys.getenv("XAI_API_KEY")
) {
  llm_provider_openai(parameters, verbose, url, api_key)
}

#' Create a new Google Gemini LLM provider
#'
#' @description
#' `r lifecycle::badge("superseded")`
#' This function creates a new [llm_provider-class] object that interacts with the Google Gemini API.
#'
#' @details
#' Streaming is not yet supported in this implementation. Native functions
#' like structured output and tool calling are also not supported in this implemetation.
#' This may however be achieved through creating a [llm_provider_ellmer()] object
#' with as input a `ellmer::chat_google_gemini()` object. Therefore, this function
#' is now superseded by `llm_provider_ellmer(ellmer::chat_google_gemini())`.
#'
#' @param parameters A named list of parameters. Currently the following parameters are required:
#'    - model: The name of the model to use (see: https://ai.google.dev/gemini-api/docs/models/gemini)
#'
#'  Additional parameters are appended to the request body; see the Google AI Studio API
#'  documentation for more information: https://ai.google.dev/gemini-api/docs/text-generation
#'  and https://github.com/google/generative-ai-docs/blob/main/site/en/gemini-api/docs/get-started/rest.ipynb
#' @param verbose A logical indicating whether the interaction with the LLM provider
#' should be printed to the console
#' @param url The URL to the Google Gemini API endpoint for chat completion
#' @param api_key The API key to use for authentication with the Google Gemini API
#' (see: https://aistudio.google.com/app/apikey)
#'
#' @return A new [llm_provider-class] object for use of the Google Gemini API
#'
#' @export
#'
#' @example inst/examples/llm_providers.R
#'
#' @family llm_provider
llm_provider_google_gemini <- function(
  parameters = list(
    model = "gemini-1.5-flash"
  ),
  verbose = getOption("tidyprompt.verbose", TRUE),
  url = "https://generativelanguage.googleapis.com/v1beta/models/",
  api_key = Sys.getenv("GOOGLE_AI_STUDIO_API_KEY")
) {
  complete_chat <- function(chat_history) {
    # Construct URL for the API request
    endpoint <- paste0(
      self$url,
      self$parameters$model,
      ":generateContent"
    )

    # Format chat_history for API compatibility with the 'contents' format
    formatted_contents <- lapply(seq_len(nrow(chat_history)), function(i) {
      list(
        role = ifelse(
          chat_history$role[i] == "assistant",
          "model",
          chat_history$role[i]
        ),
        parts = list(list(text = chat_history$content[i]))
      )
    })

    # Build the request body with 'contents' field
    body <- list(
      contents = formatted_contents
    )

    # Append all other parameters to the body
    for (name in names(self$parameters)) {
      body[[name]] <- self$parameters[[name]]
    }

    # Send the POST request with httr2
    request <- httr2::request(endpoint) |>
      httr2::req_headers(
        `Content-Type` = "application/json"
      ) |>
      httr2::req_body_json(body) |>
      httr2::req_url_query(key = self$api_key)
    response <- request |> httr2::req_perform()

    # Check if the request was successful
    if (httr2::resp_status(response) == 200) {
      content <- httr2::resp_body_json(response)

      completed <- chat_history |>
        dplyr::bind_rows(
          data.frame(
            role = "assistant",
            content = content$candidates[[1]]$content$parts[[1]]$text
          )
        )

      return(
        list(
          completed = completed,
          http = list(
            request = request,
            response = response
          )
        )
      )
    } else {
      stop(
        "Error: ",
        httr2::resp_status(response),
        " - ",
        httr2::resp_body_string(response)
      )
    }
  }

  `llm_provider-class`$new(
    complete_chat_function = complete_chat,
    parameters = parameters,
    verbose = verbose,
    url = url,
    api_key = api_key,
    api_type = "gemini"
  )
}

#' Create a fake [llm_provider-class] (for development and testing purposes)
#'
#' This function creates a fake [llm_provider-class] that can be used for development
#' and testing purposes. It is hardcoded to send back specific responses to
#' specific prompts that are used in vignettes, tests, and examples.
#' This is useful for running tests and builds in environments in which an
#' actual [llm_provider-class] is not available.
#'
#' @param verbose A logical indicating whether the interaction with the [llm_provider-class]
#' should be printed to the console. Default is TRUE.
#'
#' @return A new [llm_provider-class] object for use of the fake LLM provider
#'
#' @noRd
#' @keywords internal
llm_provider_fake <- function(verbose = getOption("tidyprompt.verbose", TRUE)) {
  complete_chat <- function(chat_history) {
    last_msg <- utils::tail(chat_history$content, 1)

    answer_as_integer_input <-
      "You must answer with only an integer (use no other characters)."

    chain_of_thought_input <-
      "To answer the user's prompt, you need to think step by step to arrive at a final answer."

    if (last_msg == "Hi there!") {
      return(
        list(
          completed = chat_history |>
            dplyr::bind_rows(
              data.frame(
                role = "assistant",
                content = paste0(
                  "It's nice to meet you.",
                  " Is there something I can help you with or would you like to chat?"
                )
              )
            )
        )
      )
    }

    if (
      grepl(
        "What is a large language model? Explain in 10 words.",
        last_msg,
        fixed = TRUE
      )
    ) {
      return(
        list(
          completed = chat_history |>
            dplyr::bind_rows(
              data.frame(
                role = "assistant",
                content = "Complex computer program trained on vast texts to generate human-like responses."
              )
            )
        )
      )
    }

    if (
      grepl("What is 2 + 2?", last_msg, fixed = TRUE) &&
        grepl(answer_as_integer_input, last_msg, fixed = TRUE) &&
        !grepl(chain_of_thought_input, last_msg, fixed = TRUE)
    ) {
      return(
        list(
          completed = chat_history |>
            dplyr::bind_rows(
              data.frame(
                role = "assistant",
                content = "4"
              )
            )
        )
      )
    }

    if (
      grepl("What is 2 + 2?", last_msg, fixed = TRUE) &&
        !grepl(answer_as_integer_input, last_msg, fixed = TRUE)
    ) {
      return(
        list(
          completed = chat_history |>
            dplyr::bind_rows(
              data.frame(
                role = "assistant",
                content = glue::glue(
                  ">> step 1: Identify the mathematical operation in the prompt,
          which is a simple addition problem.

          >> step 2: Recall the basic arithmetic fact that 2 + 2 equals a specific
          numerical value.

          >> step 3: Apply this knowledge to determine the result of the addition problem,
          using the known facts about numbers and their operations.

          >> step 4: Conclude that based on this mathematical understanding, the
          solution to the prompt \"What is 2 + 2?\" is a fixed numerical quantity."
                )
              )
            )
        )
      )
    }

    if (
      any(
        grepl(
          "What is 2 + 2?",
          chat_history$content[chat_history$role == "user"],
          fixed = TRUE
        )
      ) &&
        grepl(answer_as_integer_input, last_msg, fixed = TRUE) &&
        !grepl(chain_of_thought_input, last_msg, fixed = TRUE)
    ) {
      return(
        list(
          completed = chat_history |>
            dplyr::bind_rows(
              data.frame(
                role = "assistant",
                content = "22"
              )
            )
        )
      )
    }

    if (
      grepl("What is 2 + 2?", last_msg, fixed = TRUE) &&
        grepl(chain_of_thought_input, last_msg, fixed = TRUE) &&
        grepl(answer_as_integer_input, last_msg, fixed = TRUE)
    ) {
      return(
        list(
          completed = chat_history |>
            dplyr::bind_rows(
              data.frame(
                role = "assistant",
                content = glue::glue(
                  ">> step 1: Identify the mathematical operation in the prompt,
          which is a simple addition problem.

          >> step 2: Recall the basic arithmetic fact that 2 + 2 equals a specific
          numerical value.

          >> step 3: Apply this knowledge to determine the result of the addition problem,
          using the known facts about numbers and their operations.

          >> step 4: Conclude that based on this mathematical understanding, the
          solution to the prompt \"What is 2 + 2?\" is a fixed numerical quantity.

          FINISH[4]"
                )
              )
            )
        )
      )
    }

    if (
      grepl(
        'example usage: FUNCTION[temperature_in_location]("Amsterdam", "Fahrenheit")',
        last_msg,
        fixed = TRUE
      )
    ) {
      return(
        list(
          completed = chat_history |>
            dplyr::bind_rows(
              data.frame(
                role = "assistant",
                content = glue::glue(
                  "I'll use the provided function to get the current temperature in Enschede.

          FUNCTION[temperature_in_location](\"Enschede\", \"Celcius\")"
                )
              )
            )
        )
      )
    }

    if (
      grepl(
        "function called: temperature_in_location",
        last_msg,
        fixed = TRUE
      ) &&
        grepl("arguments used: location = Enschede", last_msg, fixed = TRUE)
    ) {
      return(
        list(
          completed = chat_history |>
            dplyr::bind_rows(
              data.frame(
                role = "assistant",
                content = "22.7"
              )
            )
        )
      )
    }

    if (
      any(
        grepl(
          "So the current temperature in Enschede is 22.7 degrees Celsius.",
          chat_history$content[chat_history$role == "assistant"],
          fixed = TRUE
        )
      ) &&
        grepl(last_msg, answer_as_integer_input, fixed = TRUE)
    ) {
      return(
        list(
          completed = chat_history |>
            dplyr::bind_rows(
              data.frame(
                role = "assistant",
                content = "22.7"
              )
            )
        )
      )
    }

    return(
      list(
        completed = chat_history |>
          dplyr::bind_rows(
            data.frame(
              role = "assistant",
              content = "I'm a fake LLM! This is my default response."
            )
          )
      )
    )
  }

  `llm_provider-class`$new(
    complete_chat_function = complete_chat,
    verbose = verbose,
    parameters = list(
      model = 'llama3.1:8b'
    ),
    api_type = "fake"
  )
}

#' Create a new LLM provider from an `ellmer::chat()` object
#'
#' @description
#' `r lifecycle::badge("experimental")`
#'
#' This function creates a [llm_provider-class] from an `ellmer::chat()` object.
#' This allows the user to use the various LLM providers which are supported
#' by the 'ellmer' R package, including respective configuration and features.
#'
#' Please note that this function is experimental. This provider type may show different behavior than
#' other LLM providers, and may not function optimally.
#'
#' @details
#' **ellmer version compatibility:** tidyprompt requires ellmer >= 0.3.0.
#' Some features are only fully available with ellmer >= 0.4.0; on older
#' versions they degrade gracefully:
#' \itemize{
#'   \item Built-in tools (`ToolBuiltIn`, e.g. `claude_tool_web_search()`)
#'     require ellmer >= 0.4.0.
#'   \item `type_ignore()` for ignored tool arguments requires ellmer >= 0.4.0;
#'     on older versions, ignored arguments fall back to optional string
#'     parameters.
#' }
#'
#' Unlike other LLM provider classes,
#' most LLM provider settings need to be managed in the `ellmer::chat()` object
#' (and not in the `$parameters` list). `$get_chat()` and `$set_chat()` may be used
#' to manipulate the chat object. There are however some parameters that can be set
#' in the `$parameters` list; these are documented below.
#'
#' 1) Streaming can be controlled through via the `$parameters$stream` parameter.
#' If set to TRUE (default), streaming will be used if supported by the underlying
#' `ellmer::chat()` object. If the underlying `ellmer::chat()` object does not support streaming,
#' you may need to set this parameter to FALSE to avoid errors.
#'
#' 2) A special parameter `$.ellmer_structured_type` may also be set in the `$parameters` list;
#' this parameter is used to specify a structured output format. This should be a 'ellmer'
#' structured type (e.g., `ellmer::type_object`; see https://ellmer.tidyverse.org/articles/structured-data.html).
#' `answer_as_json()` sets this parameter to obtain structured output
#' (it is not recommended to set this parameter manually, but it is possible).
#'
#' @param chat An `ellmer::chat()` object (e.g., `ellmer::chat_openai()`)
#' @param parameters A named list of parameters. See 'details' for supported parameters
#' @param verbose A logical indicating whether the interaction with the [llm_provider-class]
#' should be printed to the console. Default is TRUE
#'
#' @return An [llm_provider-class] with api_type = "ellmer"
#'
#' @export
#'
#' @example inst/examples/llm_providers.R
#'
#' @family llm_provider
llm_provider_ellmer <- function(
  chat,
  parameters = list(
    stream = getOption("tidyprompt.stream", TRUE)
  ),
  verbose = getOption("tidyprompt.verbose", TRUE)
) {
  if (missing(chat) || is.null(chat)) {
    stop("`chat` must be an ellmer chat object (e.g., ellmer::chat_openai()).")
  }
  if (!is_ellmer_chat(chat)) {
    stop(
      "`chat` doesn't look like an ellmer chat object (no `$chat()` method)."
    )
  }

  if (isTRUE(parameters$stream) && !requireNamespace("coro", quietly = TRUE)) {
    stop(paste0(
      "The 'coro' package is required for streaming with `llm_provider_ellmer()`.\n",
      "Please install it first (e.g., `install.packages('coro')`), ",
      "or set `parameters$stream = FALSE` to disable streaming"
    ))
  }

  complete_chat <- function(chat_history) {
    private$sync_model()
    ch <- self$ellmer_chat
    params <- self$parameters

    # Known parameter names that are handled by the ellmer provider path.
    # Anything else is silently ignored because ellmer Chat objects carry their
    # API params (temperature, max_tokens, etc.) from construction and cannot
    # be modified afterwards.
    ellmer_known_params <- c(
      "model",
      "stream",
      ".ellmer_tools",
      ".ellmer_structured_type",
      ".add_image_parts",
      ".reset_ellmer_chat"
    )

    # Warn once per session about parameters that cannot be forwarded.
    extra <- setdiff(names(params), ellmer_known_params)
    extra <- extra[!startsWith(extra, ".")]
    if (length(extra)) {
      rlang::warn(
        c(
          paste0(
            "Parameters not forwarded to ellmer provider: ",
            paste0("`", extra, "`", collapse = ", "),
            "."
          ),
          i = "Set these when creating the ellmer chat, e.g., `chat_openai(params = list(...))`."
        ),
        .frequency = "once",
        .frequency_id = "tidyprompt_ellmer_extra_params"
      )
    }

    if (!all(c("role", "content") %in% names(chat_history))) {
      stop("`chat_history` must have columns `role` and `content`.")
    }

    # Seed prior turns
    hist <- if (nrow(chat_history) > 1) {
      chat_history[seq_len(nrow(chat_history) - 1), , drop = FALSE]
    } else {
      chat_history[0, , drop = FALSE]
    }

    ellmer_available <- requireNamespace("ellmer", quietly = TRUE)
    ellmer_ns <- if (ellmer_available) asNamespace("ellmer") else NULL

    as_content_text <- function(text) {
      if (is.null(text) || !nzchar(text)) {
        return(NULL)
      }
      if (
        !is.null(ellmer_ns) &&
          exists("ContentText", envir = ellmer_ns, inherits = FALSE)
      ) {
        return(ellmer::ContentText(text))
      }
      list(type = "text", text = text)
    }

    as_turn <- function(role, contents) {
      # ellmer only supports user/assistant/system roles; map "tool" rows
      # (created by openai/ollama tool handlers) to user turns so replayed
      # histories don't crash.
      if (identical(role, "tool")) {
        role <- "user"
      }

      if (!is.null(ellmer_ns)) {
        # Prefer role-specific constructors (ellmer >= 0.4.0)
        ctor <- switch(
          role,
          user = if (exists("UserTurn", envir = ellmer_ns, inherits = FALSE)) {
            ellmer_ns$UserTurn
          },
          assistant = if (
            exists("AssistantTurn", envir = ellmer_ns, inherits = FALSE)
          ) {
            ellmer_ns$AssistantTurn
          },
          system = if (
            exists("SystemTurn", envir = ellmer_ns, inherits = FALSE)
          ) {
            ellmer_ns$SystemTurn
          },
          NULL
        )
        if (!is.null(ctor)) {
          return(ctor(contents = contents))
        }
        # Fall back to Turn(role=...) for ellmer < 0.4.0
        if (exists("Turn", envir = ellmer_ns, inherits = FALSE)) {
          return(ellmer::Turn(role = role, contents = contents))
        }
      }
      list(role = role, contents = contents)
    }

    ellmer_object_props <- function(x) {
      if (is.null(x)) {
        return(list())
      }

      props <- tryCatch(
        S7::props(x),
        error = function(e) NULL
      )
      if (is.list(props) && length(props)) {
        return(props)
      }

      attributes(x) %||% list()
    }

    append_native_history <- function(
      history,
      role,
      content,
      tool_call_id = NA_character_,
      tool_call = FALSE,
      tool_result = FALSE,
      hidden_from_llm = FALSE,
      native_turn_id = NA_character_,
      native_turn_role = NA_character_,
      native_contents = NULL
    ) {
      normalize_native_contents <- function(x) {
        if (is.null(x)) {
          return(list())
        }
        if (is_ellmer_content_object(x)) {
          return(list(x))
        }
        if (!is.list(x)) {
          return(list())
        }

        Filter(Negate(is.null), x)
      }

      row <- data.frame(
        role = as.character(role %||% "assistant"),
        content = as.character(content %||% ""),
        tool_call = tool_call,
        tool_call_id = ifelse(is.null(tool_call_id), NA, tool_call_id),
        tool_result = tool_result,
        hidden_from_llm = hidden_from_llm,
        native_turn_id = as.character(native_turn_id %||% NA_character_),
        native_turn_role = as.character(native_turn_role %||% NA_character_),
        stringsAsFactors = FALSE
      )
      row$native_contents <- list(normalize_native_contents(native_contents))

      dplyr::bind_rows(
        history,
        row
      )
    }

    set_native_turn_metadata <- function(
      history,
      row,
      native_turn_id = NA_character_,
      native_turn_role = NA_character_,
      native_contents = NULL
    ) {
      if (!nrow(history) || row < 1L || row > nrow(history)) {
        return(history)
      }

      if (!"native_turn_id" %in% names(history)) {
        history$native_turn_id <- rep(NA_character_, nrow(history))
      }
      if (!"native_turn_role" %in% names(history)) {
        history$native_turn_role <- rep(NA_character_, nrow(history))
      }
      if (!"native_contents" %in% names(history)) {
        history$native_contents <- vector("list", nrow(history))
      }

      history$native_turn_id[row] <- as.character(
        native_turn_id %||% NA_character_
      )
      history$native_turn_role[row] <- as.character(
        native_turn_role %||% NA_character_
      )
      history$native_contents[[row]] <- if (is.null(native_contents)) {
        list()
      } else if (is_ellmer_content_object(native_contents)) {
        list(native_contents)
      } else if (is.list(native_contents)) {
        Filter(Negate(is.null), native_contents)
      } else {
        list()
      }

      history
    }

    is_ellmer_content_object <- function(x) {
      classes <- class(x) %||% character()
      any(grepl("^ellmer::Content", classes))
    }

    serialize_native_content <- function(x) {
      if (is.null(x)) {
        return("")
      }

      props <- ellmer_object_props(x)
      classes <- class(x) %||% character()
      content_class <- classes[grepl("^ellmer::Content", classes)][1] %||%
        classes[1] %||%
        "Content"

      if (any(grepl("ContentToolRequest|ContentToolResult", classes))) {
        return("")
      }

      if (
        any(grepl("ContentText", classes)) ||
          !is.null(props$text)
      ) {
        return(as.character(props$text %||% ""))
      }

      if (
        any(grepl("ContentThinking", classes)) ||
          !is.null(props$thinking)
      ) {
        return(as.character(props$thinking %||% ""))
      }

      if (any(grepl("ContentJson", classes))) {
        json_text <- props$string %||% NULL
        if (!is.null(json_text) && nzchar(as.character(json_text))) {
          return(as.character(json_text))
        }

        json_text <- tryCatch(
          jsonlite::toJSON(
            props$parsed %||% props$data %||% NULL,
            auto_unbox = TRUE
          ),
          error = function(e) NULL
        )
        if (!is.null(json_text)) {
          return(as.character(json_text))
        }
      }

      if (
        any(grepl("ContentImageRemote", classes)) ||
          !is.null(props$url)
      ) {
        return(paste0("[image: ", as.character(props$url %||% "remote"), "]"))
      }

      if (any(grepl("ContentImageInline", classes))) {
        return(paste0(
          "[image: inline ",
          as.character(props$type %||% "unknown"),
          "]"
        ))
      }

      if (any(grepl("ContentPDF", classes))) {
        return(paste0(
          "[pdf: ",
          as.character(props$filename %||% "document.pdf"),
          "]"
        ))
      }

      fallback <- tryCatch(
        jsonlite::toJSON(props, auto_unbox = TRUE),
        error = function(e) NULL
      )

      if (!is.null(fallback)) {
        return(paste0("[", content_class, "] ", as.character(fallback)))
      }

      paste0("[", content_class, "]")
    }

    stringify_tool_result <- function(x) {
      if (is.null(x)) {
        return("")
      }
      if (is_ellmer_content_object(x)) {
        return(serialize_native_content(x))
      }
      if (is.character(x) && length(x) == 1) {
        return(as.character(x))
      }
      if (is.atomic(x)) {
        return(paste(as.character(x), collapse = ", "))
      }
      if (
        is.list(x) &&
          length(x) > 0 &&
          all(vapply(x, is_ellmer_content_object, logical(1)))
      ) {
        return(paste(
          vapply(x, serialize_native_content, character(1)),
          collapse = "\n"
        ))
      }

      json <- tryCatch(
        jsonlite::toJSON(x, auto_unbox = TRUE),
        error = function(e) NULL
      )
      if (!is.null(json)) {
        return(as.character(json))
      }

      paste(as.character(x), collapse = ", ")
    }

    native_turns_to_history <- function(turns, start_index = 1L) {
      history <- data.frame(
        role = character(),
        content = character(),
        tool_call = logical(),
        tool_call_id = character(),
        tool_result = logical(),
        stringsAsFactors = FALSE
      )
      history$native_turn_id <- character()
      history$native_turn_role <- character()
      history$native_contents <- list()

      for (turn_i in seq_along(turns)) {
        turn <- turns[[turn_i]]
        turn_props <- ellmer_object_props(turn)
        role <- turn_props$role %||% "assistant"
        contents <- turn_props$contents %||% list()
        turn_id <- paste0("ellmer-turn-", start_index + turn_i - 1L)

        for (content_obj in contents) {
          props <- ellmer_object_props(content_obj)
          classes <- class(content_obj) %||% character()

          if (
            any(grepl("ContentToolRequest", classes)) ||
              (!is.null(props$id) &&
                !is.null(props$name) &&
                !is.null(props$arguments))
          ) {
            pretty_args <- tryCatch(
              jsonlite::toJSON(
                props$arguments %||% list(),
                auto_unbox = FALSE,
                pretty = TRUE
              ),
              error = function(e) "null"
            )
            history <- append_native_history(
              history,
              role = "assistant",
              content = paste0(
                "~>> Calling function '",
                as.character(props$name %||% "tool"),
                "' with arguments:\n",
                pretty_args
              ),
              tool_call_id = as.character(props$id %||% NA_character_),
              tool_call = TRUE,
              tool_result = FALSE,
              native_turn_id = turn_id,
              native_turn_role = role,
              native_contents = content_obj
            )
            next
          }

          if (
            any(grepl("ContentToolResult", classes)) ||
              (!is.null(props$request) &&
                ("value" %in% names(props) || "error" %in% names(props)))
          ) {
            request_props <- ellmer_object_props(props$request %||% NULL)
            result_text <- if (!is.null(props$error)) {
              paste0("Error: ", stringify_tool_result(props$error))
            } else {
              stringify_tool_result(props$value)
            }

            history <- append_native_history(
              history,
              role = "tool",
              content = paste0("~>> Result:\n", result_text),
              tool_call_id = as.character(request_props$id %||% NA_character_),
              tool_call = FALSE,
              tool_result = TRUE,
              native_turn_id = turn_id,
              native_turn_role = role,
              native_contents = content_obj
            )
            next
          }

          if (
            any(grepl("ContentThinking", classes)) ||
              !is.null(props$thinking)
          ) {
            thinking <- as.character(props$thinking %||% "")
            if (nzchar(thinking)) {
              history <- append_native_history(
                history,
                role,
                thinking,
                hidden_from_llm = TRUE,
                native_turn_id = turn_id,
                native_turn_role = role,
                native_contents = content_obj
              )
            }
            next
          }

          text <- serialize_native_content(content_obj)
          if (nzchar(text)) {
            history <- append_native_history(
              history,
              role,
              text,
              native_turn_id = turn_id,
              native_turn_role = role,
              native_contents = content_obj
            )
          }
        }
      }

      if (!nrow(history)) {
        return(NULL)
      }

      history
    }

    build_image_content <- function(p) {
      # URL-based image
      if (
        identical(p$source, "url") &&
          !is.null(p$data) &&
          !is.null(ellmer_ns) &&
          isTRUE(exists("content_image_url", ellmer_ns, inherits = FALSE))
      ) {
        return(ellmer::content_image_url(
          url = as.character(p$data),
          detail = p$detail %||% "auto"
        ))
      }

      # Base64-encoded image -> temp file + content_image_file, when available
      if (
        identical(p$source, "b64") &&
          !is.null(p$data) &&
          !is.null(ellmer_ns) &&
          isTRUE(exists("content_image_file", ellmer_ns, inherits = FALSE))
      ) {
        raw_bytes <- tryCatch(
          jsonlite::base64_dec(as.character(p$data)),
          error = function(e) raw()
        )
        if (length(raw_bytes)) {
          ext <- ".png"
          if (!is.null(p$mime) && grepl("jpeg", p$mime)) {
            ext <- ".jpg"
          }
          if (!is.null(p$mime) && grepl("gif", p$mime)) {
            ext <- ".gif"
          }
          if (!is.null(p$mime) && grepl("webp", p$mime)) {
            ext <- ".webp"
          }
          tf <- tempfile(fileext = ext)
          writeBin(raw_bytes, tf)
          on.exit(unlink(tf), add = TRUE)
          img <- tryCatch(
            ellmer::content_image_file(
              path = tf,
              content_type = p$mime %||% "auto"
            ),
            error = function(e) {
              b64 <- jsonlite::base64_enc(raw_bytes)
              mime <- p$mime %||% "image/png"

              # If ellmer can't build from a temp file (for example because
              # an image helper dependency is unavailable), fall back to an
              # inline ellmer content object instead of an OpenAI-style payload.
              if (
                exists(
                  "ContentImageInline",
                  envir = ellmer_ns,
                  inherits = FALSE
                )
              ) {
                return(ellmer_ns$ContentImageInline(
                  type = mime,
                  data = b64
                ))
              }

              if (
                exists("content_image_url", envir = ellmer_ns, inherits = FALSE)
              ) {
                return(ellmer::content_image_url(
                  url = paste0("data:", mime, ";base64,", b64),
                  detail = p$detail %||% "auto"
                ))
              }

              stop(e)
            }
          )
          return(img)
        }
      }

      # Already-constructed ellmer content (e.g., content_image_url/file/plot)
      if (identical(p$source, "ellmer") && !is.null(p$obj)) {
        return(p$obj)
      }

      # Fallback stub when ellmer helpers are unavailable (primarily for tests)
      if (!is.null(p$source) && !is.null(p$data)) {
        return(list(
          source = p$source,
          data = p$data,
          mime = p$mime %||% NA_character_
        ))
      }

      NULL
    }

    history_native_turn_id <- function(history, i) {
      if (!"native_turn_id" %in% names(history)) {
        return(NA_character_)
      }

      as.character(history$native_turn_id[i] %||% NA_character_)
    }

    history_native_turn_role <- function(history, i) {
      if (!"native_turn_role" %in% names(history)) {
        return(NA_character_)
      }

      as.character(history$native_turn_role[i] %||% NA_character_)
    }

    history_native_contents <- function(history, i) {
      if (!"native_contents" %in% names(history)) {
        return(NULL)
      }

      contents <- history$native_contents[[i]]
      if (is.null(contents)) {
        return(NULL)
      }
      if (is_ellmer_content_object(contents)) {
        return(list(contents))
      }
      if (!is.list(contents)) {
        return(NULL)
      }

      contents <- Filter(Negate(is.null), contents)
      if (!length(contents)) {
        return(NULL)
      }

      contents
    }

    # Prepare historical turns (excluding the latest message)
    prior_turns <- list()
    if (nrow(hist)) {
      i <- 1L

      while (i <= nrow(hist)) {
        turn_id <- history_native_turn_id(hist, i)

        if (!is.na(turn_id) && nzchar(turn_id)) {
          grouped_contents <- list()
          turn_role <- history_native_turn_role(hist, i)
          j <- i

          while (
            j <= nrow(hist) &&
              identical(history_native_turn_id(hist, j), turn_id)
          ) {
            grouped_contents <- c(
              grouped_contents,
              history_native_contents(hist, j) %||% list()
            )
            j <- j + 1L
          }

          grouped_contents <- Filter(Negate(is.null), grouped_contents)
          if (length(grouped_contents)) {
            prior_turns[[length(prior_turns) + 1L]] <- as_turn(
              role = if (!is.na(turn_role) && nzchar(turn_role)) {
                turn_role
              } else {
                hist$role[i]
              },
              contents = grouped_contents
            )
            i <- j
            next
          }
        }

        ct <- as_content_text(hist$content[i])
        prior_turns[[length(prior_turns) + 1L]] <- as_turn(
          role = hist$role[i],
          contents = if (is.null(ct)) list() else list(ct)
        )
        i <- i + 1L
      }
    }

    # Prompt = last message (may be converted to multimodal contents below)
    prompt <- if (nrow(chat_history) > 0L) {
      chat_history$content[nrow(chat_history)]
    } else {
      ""
    }
    prompt <- if (length(prompt) == 1L && !is.na(prompt)) {
      as.character(prompt)
    } else {
      ""
    }
    # Merge tools: the cloned chat already carries the user's base tools
    # (registered via $register_tool() / $set_tools() on the provider's
    # ellmer_chat).  Prompt-level tools are layered on top for this request
    # only.  When there are no prompt tools we leave the registry untouched.
    #
    # base_tools is captured once (before any prompt-level merge) so that
    # retries within the same send_prompt() call don't accumulate duplicates.
    prompt_tools <- params$.ellmer_tools %||% list()
    if (length(prompt_tools)) {
      if (is.null(private$.base_tools_snapshot)) {
        private$.base_tools_snapshot <- tryCatch(
          {
            gt <- ch$get_tools
            if (is.function(gt)) gt() else list()
          },
          error = function(e) list()
        )
      }
      all_tools <- c(private$.base_tools_snapshot, prompt_tools)
      if (is.function(ch$set_tools)) {
        ch$set_tools(all_tools)
      } else {
        for (td in prompt_tools) {
          ch$register_tool(td)
        }
      }
    }

    # Check if we are doing structured output
    structured_type <- params$.ellmer_structured_type %||% NULL
    use_structured <- !is.null(structured_type) &&
      is.function(ch$chat_structured)

    # Warn if both tools and structured output are requested:
    # ellmer's chat_structured() suppresses tool use, so both cannot
    # work simultaneously in a single request.
    if (use_structured && !is.null(params$.ellmer_tools)) {
      cli::cli_alert_warning(
        paste0(
          "{.strong `llm_provider_ellmer()`}:\n",
          "* Both structured output and tool use are requested;\n",
          "ellmer's {.fn chat_structured} suppresses tool use, ",
          "so tools will not be called in this request\n",
          "* Consider using {.code type = \"text-based\"} for one of them"
        )
      )
    }

    # Central streaming hook: if provided, we will stream tokens/chunks
    # through this function instead of letting ellmer print to console.
    stream_cb <- self$stream_callback %||%
      getOption("tidyprompt.stream_callback", NULL)

    # Try to detect attached images and use ellmer multimodal helpers if available.
    # `add_image()` normalizes all inputs into `.add_image_parts`; here we
    # translate those parts into ellmer content objects.
    add_parts <- self$parameters$.add_image_parts %||% NULL

    multimodal_contents <- list()
    use_multimodal <- length(add_parts) > 0

    if (use_multimodal) {
      text_content <- as_content_text(prompt)
      if (!is.null(text_content)) {
        multimodal_contents[[length(multimodal_contents) + 1]] <- text_content
      }

      for (p in add_parts) {
        ic <- build_image_content(p)
        if (!is.null(ic)) {
          multimodal_contents[[length(multimodal_contents) + 1]] <- ic
        }
      }

      if (length(multimodal_contents) == 0L) {
        use_multimodal <- FALSE
      }
    }

    turns_to_send <- prior_turns
    prompt_for_model <- prompt

    # For multimodal, pass content objects directly to the chat method
    # instead of pre-seeding the current turn and calling with empty prompt
    # (which would create a duplicate empty user turn).
    multimodal_args <- NULL
    if (use_multimodal) {
      multimodal_args <- multimodal_contents
    }

    ch <- ch$set_turns(turns_to_send)

    # Store the native structured result (if any) so downstream extraction
    # can use it directly without lossy JSON round-tripping.
    native_structured_result <- NULL

    if (use_structured) {
      if (!is.null(multimodal_args)) {
        reply_struct <- do.call(
          ch$chat_structured,
          c(multimodal_args, list(type = structured_type))
        )
      } else {
        reply_struct <- ch$chat_structured(
          prompt_for_model,
          type = structured_type
        )
      }
      native_structured_result <- reply_struct
      # Store a JSON string in the transcript (so downstream plain JSON extractors still work)
      assistant_text <- jsonlite::toJSON(reply_struct, auto_unbox = TRUE) |>
        as.character()
    } else if (isTRUE(params$stream) && is.function(ch$stream)) {
      # --- Streaming path (ellmer-style sync streaming) ----------------------
      stream_error <- NULL
      assistant_text <- NULL

      stream <- tryCatch(
        if (!is.null(multimodal_args)) {
          do.call(ch$stream, multimodal_args)
        } else {
          ch$stream(prompt_for_model)
        },
        error = function(e) {
          stream_error <<- e
          NULL
        }
      )

      if (is.null(stream) && !is.null(stream_error)) {
        # Streaming failed to initialise; fall back to non-streaming chat.
        # (Multimodal paths already did this; now also try for plain text.)
        reply_any <- tryCatch(
          if (use_multimodal) {
            do.call(ch$chat, multimodal_args)
          } else {
            ch$chat(prompt_for_model)
          },
          error = function(e) NULL
        )
        if (!is.null(reply_any)) {
          assistant_text <- as.character(reply_any)
        } else {
          stop(stream_error)
        }
      } else {
        # Create environment to hold partial response
        partial_response_env <- new.env()
        assign("partial_response", "", envir = partial_response_env)

        coro::loop(
          for (chunk in stream) {
            if (length(chunk) == 0L || all(is.na(chunk))) {
              next
            }

            chunk_str <- paste0(as.character(chunk), collapse = "")
            if (!nzchar(chunk_str)) {
              next
            }

            current_response <- get(
              "partial_response",
              envir = partial_response_env
            )
            updated_response <- paste0(current_response, chunk_str)
            assign(
              "partial_response",
              updated_response,
              envir = partial_response_env
            )

            # If a callback is provided, use it; otherwise, mirror HTTP providers
            # by cat()ing chunks when verbose = TRUE.
            if (is.function(stream_cb)) {
              latest_message <- chat_history[nrow(chat_history), , drop = FALSE]

              meta <- list(
                llm_provider = self,
                chat_history = chat_history,
                latest_message = latest_message,
                partial_response = updated_response,
                chunk = chunk_str,
                api_type = "ellmer",
                endpoint = "chat",
                verbose = self$verbose
              )

              tryCatch(
                stream_cb(chunk_str, meta),
                error = function(e) {
                  warning(
                    "stream_callback error (streaming continues): ",
                    conditionMessage(e),
                    call. = FALSE
                  )
                }
              )
            } else if (isTRUE(self$verbose)) {
              cat(chunk_str)
            }
          }
        )

        # After streaming, use accumulated partial_response as assistant text
        assistant_text <- get("partial_response", envir = partial_response_env)
        # If it leads with '\n', strip that
        assistant_text <- sub("^\n", "", assistant_text)
        # If it ends with '\n', strip that
        assistant_text <- sub("\n$", "", assistant_text)
      }
    } else {
      # Regular, non-streaming chat
      reply_any <- if (!is.null(multimodal_args)) {
        do.call(ch$chat, multimodal_args)
      } else {
        ch$chat(prompt_for_model)
      }
      assistant_text <- as.character(reply_any)
    }

    completed <- NULL

    native_turns <- tryCatch(
      {
        gt <- ch$get_turns
        if (is.function(gt)) gt() else NULL
      },
      error = function(e) NULL
    )

    prompt_turn_index <- length(prior_turns) + 1L
    if (length(native_turns) >= prompt_turn_index && nrow(chat_history) > 0) {
      prompt_turn <- native_turns[[prompt_turn_index]]
      prompt_props <- ellmer_object_props(prompt_turn)
      chat_history <- set_native_turn_metadata(
        chat_history,
        row = nrow(chat_history),
        native_turn_id = paste0("ellmer-turn-", prompt_turn_index),
        native_turn_role = prompt_props$role %||%
          chat_history$role[nrow(chat_history)],
        native_contents = prompt_props$contents %||% list()
      )
    }

    first_new_turn <- length(prior_turns) + 2L
    if (length(native_turns) >= first_new_turn) {
      native_rows <- native_turns_to_history(
        native_turns[
          first_new_turn:length(native_turns)
        ],
        start_index = first_new_turn
      )
      if (!is.null(native_rows) && nrow(native_rows)) {
        completed <- dplyr::bind_rows(chat_history, native_rows)
      }
    }

    if (is.null(completed)) {
      completed <- dplyr::bind_rows(
        chat_history,
        data.frame(
          role = "assistant",
          content = assistant_text,
          stringsAsFactors = FALSE
        )
      )
    }

    list(
      completed = completed,
      http = list(request = NULL, response = NULL),
      ellmer_chat = ch,
      native_structured_result = native_structured_result
    )
  }

  klass <- R6::R6Class(
    "llm_provider_ellmer-class",
    inherit = `llm_provider-class`,
    public = list(
      ellmer_chat = NULL,

      get_chat = function() self$ellmer_chat,

      # Replace the underlying ellmer chat object and re-sync `parameters$model`
      set_chat = function(new_chat) {
        stopifnot(is.environment(new_chat), is.function(new_chat$chat))
        self$ellmer_chat <- new_chat
        private$sync_model()
        invisible(self)
      }
    ),
    private = list(
      complete_chat_function = NULL,
      .base_tools_snapshot = NULL,

      # Keep self$parameters$model in sync with ellmer_chat$get_model()
      sync_model = function() {
        m <- tryCatch(
          {
            gm <- self$ellmer_chat$get_model
            if (is.function(gm)) self$ellmer_chat$get_model() else NULL
          },
          error = function(e) NULL
        )
        if (!is.null(m)) {
          self$parameters$model <- as.character(m)
        }
        invisible(NULL)
      }
    )
  )

  provider <- klass$new(
    complete_chat_function = complete_chat,
    parameters = list(),
    verbose = verbose,
    api_type = "ellmer"
  )

  if (length(parameters)) {
    provider$set_parameters(parameters)
  }

  provider$ellmer_chat <- chat
  # Initial sync so $parameters$model reflects the chat's current model
  provider$.__enclos_env__$private$sync_model()

  provider
}