#' @include content.R
NULL

#' A chatbot provider
#'
#' A Provider captures the details of one chatbot service/API. This captures
#' how the API works, not the details of the underlying large language model.
#' Different providers might offer the same (open source) model behind a
#' different API.
#'
#' To add support for a new backend, you will need to subclass `Provider`
#' (adding any additional fields that your provider needs) and then implement
#' the various generics that control the behavior of each provider.
#'
#' @export
#' @param name Name of the provider.
#' @param model Name of the model.
#' @param base_url The base URL for the API.
#' @param params A list of standard parameters created by [params()].
#' @param credentials A zero-argument function that returns the credentials to use
#'   for authentication. Can either return a string, representing an API key,
#'   or a named list of headers.
#' @param extra_args Arbitrary extra arguments to be included in the request body.
#' @param extra_headers Arbitrary extra headers to be added to the request.
#' @return An S7 Provider object.
#' @examples
#' Provider(
#'   name = "CoolModels",
#'   model = "my_model",
#'   base_url = "https://cool-models.com"
#' )
Provider <- new_class(
  "Provider",
  properties = list(
    name = prop_string(),
    model = prop_string(),
    base_url = prop_string(),
    params = class_list,
    extra_args = class_list,
    extra_headers = class_character,
    credentials = class_function | NULL
  )
)

test_provider <- function(name = "", model = "", base_url = "", ...) {
  Provider(name = name, model = model, base_url = base_url, ...)
}

# Create a request------------------------------------

base_request <- new_generic("base_request", "provider", function(provider) {
  S7_dispatch()
})

base_request_error <- new_generic(
  "base_request_error",
  "provider",
  function(provider, req) {
    S7_dispatch()
  }
)

chat_request <- new_generic(
  "chat_request",
  "provider",
  function(
    provider,
    stream = TRUE,
    turns = list(),
    tools = list(),
    type = NULL
  ) {
    S7_dispatch()
  }
)

method(chat_request, Provider) <- function(
  provider,
  stream = TRUE,
  turns = list(),
  tools = list(),
  type = NULL
) {
  req <- base_request(provider)
  req <- req_url_path_append(req, chat_path(provider))

  body <- chat_body(
    provider = provider,
    stream = stream,
    turns = turns,
    tools = tools,
    type = type
  )
  body <- modify_list(body, provider@extra_args)
  req <- req_body_json(req, body)
  req <- req_headers(req, !!!provider@extra_headers)

  req
}

chat_body_tools <- new_generic(
  "chat_body_tools",
  "provider",
  function(provider, tools) S7_dispatch()
)

method(chat_body_tools, Provider) <- function(provider, tools) {
  as_json(provider, unname(tools))
}

chat_body <- new_generic(
  "chat_body",
  "provider",
  function(
    provider,
    stream = TRUE,
    turns = list(),
    tools = list(),
    type = NULL
  ) {
    S7_dispatch()
  }
)

chat_path <- new_generic("chat_path", "provider", function(provider) {
  S7_dispatch()
})

chat_resp_stream <- new_generic(
  "chat_resp_stream",
  "provider",
  function(provider, resp) {
    S7_dispatch()
  }
)
method(chat_resp_stream, Provider) <- function(provider, resp) {
  resp_stream_sse(resp)
}

chat_params <- new_generic(
  "chat_params",
  "provider",
  function(provider, params) {
    S7_dispatch()
  }
)

# Extract data from streaming results ------------------------------------

stream_parse <- new_generic(
  "stream_parse",
  "provider",
  function(provider, event) {
    S7_dispatch()
  }
)
stream_content <- new_generic(
  "stream_content",
  "provider",
  function(provider, event) {
    S7_dispatch()
  }
)

stream_text <- function(provider, event) {
  content <- stream_content(provider, event)
  if (is.null(content)) {
    return(NULL)
  }
  content_text(content)
}

content_text <- function(content) {
  switch(
    class(content)[1],
    "ellmer::ContentThinking" = content@thinking,
    "ellmer::ContentText" = content@text,
    format(content)
  )
}
stream_merge_chunks <- new_generic(
  "stream_merge_chunks",
  "provider",
  function(provider, result, chunk) {
    S7_dispatch()
  }
)

# Extract data from non-streaming results --------------------------------------

value_turn <- new_generic("value_turn", "provider")

# Extract token counts from API response
# Returns a named list produced by token_usage()
value_tokens <- new_generic(
  "value_tokens",
  "provider",
  function(provider, json) {
    S7_dispatch()
  }
)
method(value_tokens, Provider) <- function(provider, json) {
  tokens()
}

value_finish_reason <- new_generic(
  "value_finish_reason",
  "provider",
  function(provider, result) {
    S7_dispatch()
  }
)
method(value_finish_reason, Provider) <- function(provider, result) {
  NA_character_
}

# Convert to JSON
as_json <- new_generic(
  "as_json",
  c("provider", "x"),
  function(provider, x, ...) {
    S7_dispatch()
  }
)

method(as_json, list(Provider, class_list)) <- function(provider, x, ...) {
  compact(lapply(x, as_json, provider = provider, ...))
}

method(as_json, list(Provider, ContentJson)) <- function(provider, x, ...) {
  if (!is.null(x@string)) {
    string <- x@string
  } else {
    string <- unclass(jsonlite::toJSON(x@data, auto_unbox = TRUE))
  }
  as_json(provider, ContentText(string), ...)
}

# Token counting -------------------------------------------------------------

count_tokens <- new_generic(
  "count_tokens",
  "provider",
  function(provider, ..., system_prompt = NULL, tools = list(), type = NULL) {
    S7_dispatch()
  }
)

method(count_tokens, Provider) <- function(
  provider,
  ...,
  system_prompt = NULL,
  tools = list(),
  type = NULL
) {
  cli::cli_abort(
    "{provider@name} doesn't support token counting.",
    class = "not_implemented"
  )
}

# Models -------------------------------------------------------------------

models_list <- new_generic("models_list", "provider", function(provider) {
  S7_dispatch()
})

method(models_list, Provider) <- function(provider) {
  cli::cli_abort(
    "{.arg provider} doesn't support model listing.",
    class = "not_implemented"
  )
}

method(models_list, new_S3_class("Chat")) <- function(provider) {
  models_list(provider$get_provider())
}

# Batch AI ---------------------------------------------------------------

# Does the provider support batch uploads?
has_batch_support <- new_generic(
  "has_batch_support",
  "provider",
  function(provider) {
    S7_dispatch()
  }
)
method(has_batch_support, Provider) <- function(provider) {
  FALSE
}

# Submit a batch, return an object "batch" object that will be passed to
# batch_poll() and batch_retrieve()
batch_submit <- new_generic(
  "batch_submit",
  "provider",
  function(provider, conversations, type = NULL) {
    S7_dispatch()
  }
)

# Get batch status. Returns an opaque list.
batch_poll <- new_generic(
  "batch_poll",
  "provider",
  function(provider, batch) {
    S7_dispatch()
  }
)

# Given batch status, return a standardised list:
# * working - TRUE/FALSE
# * n_processing = number of requests still processing
# * n_succeeded = number of requests that succeeded
# * n_failed = number of requests that failed
batch_status <- new_generic(
  "batch_status",
  "provider",
  function(provider, batch) {
    S7_dispatch()
  }
)

# Download batched results
batch_retrieve <- new_generic(
  "batch_retrieve",
  "provider",
  function(provider, batch) {
    S7_dispatch()
  }
)

# Process a single result. Returns either a turn or NULL, if the turn
# did not succeed
batch_result_turn <- new_generic(
  "batch_result_turn",
  "provider",
  function(provider, result, has_type = FALSE) {
    S7_dispatch()
  }
)
