#' @include provider-openai-compatible.R
NULL

#' Chat with one of the many models hosted on OpenRouter
#'
#' @description
#' Sign up at <https://openrouter.ai>.
#'
#' Support for features depends on the underlying model that you use; see
#' <https://openrouter.ai/models> for details.
#'
#' @export
#' @family chatbots
#' @param api_key `r lifecycle::badge("deprecated")` Use `credentials` instead.
#' @param credentials `r api_key_param("OPENROUTER_API_KEY")`
#' @param model `r param_model("gpt-4o")`
#' @param params Common model parameters, usually created by [params()].
#' @inheritParams chat_openai
#' @inherit chat_openai return
#' @examples
#' \dontrun{
#' chat <- chat_openrouter()
#' chat$chat("Tell me three jokes about statisticians")
#' }
chat_openrouter <- function(
  system_prompt = NULL,
  api_key = NULL,
  credentials = NULL,
  model = NULL,
  params = NULL,
  api_args = list(),
  echo = c("none", "output", "all"),
  api_headers = character()
) {
  model <- set_default(model, "gpt-4o")
  echo <- check_echo(echo)

  credentials <- as_credentials(
    "chat_openrouter",
    function() openrouter_key(),
    credentials = credentials,
    api_key = api_key
  )

  params <- params %||% params()

  provider <- ProviderOpenRouter(
    name = "OpenRouter",
    base_url = "https://openrouter.ai/api/v1",
    model = model,
    params = params,
    extra_args = api_args,
    credentials = credentials,
    extra_headers = api_headers,
    preserve_thinking = TRUE
  )
  Chat$new(provider = provider, system_prompt = system_prompt, echo = echo)
}

chat_openrouter_test <- function(..., echo = "none") {
  chat_openrouter(..., model = "openai/gpt-4o-mini-2024-07-18", echo = echo)
}

ProviderOpenRouter <- new_class(
  "ProviderOpenRouter",
  parent = ProviderOpenAICompatible,
)

method(chat_params, ProviderOpenRouter) <- function(provider, params) {
  # https://openrouter.ai/docs/api-reference/parameters
  standardise_params(
    params,
    c(
      temperature = "temperature",
      top_p = "top_p",
      top_k = "top_k",
      frequency_penalty = "frequency_penalty",
      presence_penalty = "presence_penalty",
      seed = "seed",
      max_tokens = "max_tokens",
      logprobs = "log_probs",
      stop = "stop_sequences"
    )
  )
}

openrouter_key <- function() {
  key_get("OPENROUTER_API_KEY")
}

method(base_request, ProviderOpenRouter) <- function(provider) {
  req <- base_request(super(provider, ProviderOpenAICompatible))
  # https://openrouter.ai/docs/api-keys
  req <- req_headers(
    req,
    `HTTP-Referer` = "https://ellmer.tidyverse.org",
    `X-Title` = "ellmer"
  )

  req
}

method(value_turn, ProviderOpenRouter) <- function(
  provider,
  result,
  has_type = FALSE
) {
  # https://openrouter.ai/docs/errors
  check_openrouter_error(result$error)

  value_turn(
    super(provider, ProviderOpenAICompatible),
    result = result,
    has_type = has_type
  )
}

method(stream_parse, ProviderOpenRouter) <- function(provider, event) {
  if (is.null(event) || identical(event$data, "[DONE]")) {
    return(NULL)
  }

  result <- jsonlite::parse_json(event$data)
  check_openrouter_error(result$error)
  result
}

check_openrouter_error <- function(error, call = caller_env()) {
  if (is.null(error)) {
    return()
  }
  message <- error$message
  if (is.null(error$metadata$raw$data)) {
    details <- NULL
  } else {
    details <- prettify(error$metadata$raw$data)
    # don't line wrap
    details <- gsub(" ", "\u00a0", details, fixed = TRUE)
  }

  abort(
    c("message", i = if (!is.null(details)) details),
    call = call
  )
}

method(chat_resp_stream, ProviderOpenRouter) <- function(provider, resp) {
  repeat {
    event <- resp_stream_sse(resp)
    if (is.null(event)) {
      break
    }

    # https://openrouter.ai/docs/responses#sse-streaming-comments
    if (!identical(event$data, character())) {
      break
    }
    Sys.sleep(0.1)
  }

  event
}

method(as_json, list(ProviderOpenRouter, ContentText)) <- function(
  provider,
  x,
  ...
) {
  if (identical(x@text, "")) {
    # Tool call requests can include a Content with empty text,
    # but it doesn't like it if you send this back
    NULL
  } else {
    list(type = "text", text = x@text)
  }
}
