#' Error class
#'
#' @export
#' @template params
#' @param call.	(logical) indicating if the call should become part
#' of the error message. Default: `FALSE`
#' @param message_template_verbose A verbose message template. optional.
#' use whisker templating. names to use are: reason, status, message.
#' use in template like `{{reason}}`, `{{status}}`, and
#' `{{message}}`. Note that this is ignored here, but is
#' used in the `HTTP*` methods (e.g. `HTTPBadRequest`)
#' @param muffle (logical) whether to not respond when status codes
#' in 1xx-3xx series. Default: `FALSE`
#'
#' @section Methods:
#' * `do(response, mssg, template)`:
#'
#'   Execute condition, whether it be message, warning, or error.
#'
#'   * response: is any response from \pkg{crul}, \pkg{curl}, or \pkg{httr}
#'   Execute condition, whether it be message, warning, error, or your
#'   own custom function. This method uses `message_template_verbose`,
#'   and uses it's default value.
#'   * mssg: character string message to include in call. ignored if
#'   template does not have a `message` entry
#'   * template: set a template; by default uses `message_template`
#'
#' * `set_behavior(behavior)`:
#'
#'   * Set behavior, same as setting behavior on initializing with `$new()`
#'
#' @format NULL
#'
#' @seealso [fauxpas::http], [fauxpas::Error-Classes]
#'
#' @examples
#' Error$new()
#' # reset behavior
#' (z <- Error$new())
#' z$set_behavior("warning")
#' z
Error <- R6::R6Class(
  "Error",
  portable = TRUE,
  public = list(
    name = 'HTTP Error',
    behavior = "stop",
    call. = FALSE,
    message_template = NULL,
    message_template_verbose = NULL,
    muffle = FALSE,

    initialize = function(
      behavior = "stop",
      call. = FALSE,
      message_template,
      message_template_verbose,
      muffle = FALSE
    ) {
      stopifnot(inherits(behavior, "character"))
      if (!behavior %in% c('stop', 'warning', 'message')) {
        stop(
          "'behavior' must be one of stop, warning, or message",
          call. = FALSE
        )
      }
      self$behavior <- behavior
      private$behavior_type <- switch(
        self$behavior,
        stop = "error",
        warning = "warning",
        message = "message"
      )

      if (!missing(call.)) {
        self$call. <- call.
      }

      if (!missing(message_template)) {
        if (!is.null(message_template)) {
          if (!inherits(message_template, "character")) {
            stop("'message_template' must be of class character", call. = FALSE)
          }
          self$message_template <- message_template
        }
      }
      if (missing(message_template)) {
        self$message_template <- "{{reason}} (HTTP {{status}})"
      }

      if (!missing(message_template_verbose)) {
        if (!is.null(message_template_verbose)) {
          if (!inherits(message_template_verbose, "character")) {
            stop(
              "'message_template_verbose' must be of class character",
              call. = FALSE
            )
          }
          self$message_template_verbose <- message_template_verbose
        }
      }
      if (missing(message_template_verbose)) {
        self$message_template_verbose <- "{{reason}} (HTTP {{status}}).\n - {{message}}"
      }

      self$muffle <- muffle
    },

    print = function(...) {
      cat(sprintf("<%s>", self$name), sep = "\n")
      cat(paste0("  behavior: ", self$behavior), sep = "\n")
      cat(
        paste0(
          "  message_template: ",
          gsub("\n", "\\\\n", self$message_template)
        ),
        sep = "\n"
      )
      cat(
        paste0(
          "  message_template_verbose: ",
          gsub("\n", "\\\\n", self$message_template_verbose)
        ),
        sep = "\n"
      )
      invisible()
    },

    do = function(response, mssg = "", template = self$message_template) {
      call <- if (self$call.) sys.call(-1) else NULL
      stat <- private$fetch_status(response)
      if (self$muffle) {
        if (stat < 300) return(invisible(response))
      }
      eval(parse(text = self$behavior))(
        private$make_condition(
          response,
          private$behavior_type,
          call,
          mssg,
          template
        )
      )
    },

    set_behavior = function(behavior) {
      stopifnot(inherits(behavior, "character"))
      if (!behavior %in% c('stop', 'warning', 'message')) {
        stop(
          "'behavior' must be one of stop, warning, or message",
          call. = FALSE
        )
      }
      self$behavior <- behavior
      # and set behavior_type
      private$behavior_type <- switch(
        self$behavior,
        stop = "error",
        warning = "warning",
        message = "message"
      )
    }
  ),

  private = list(
    behavior_type = NULL,
    make_condition = function(x, type, call, mssg, template) {
      status <- private$fetch_status(x)
      reason <- httpcode::http_code(status)$message
      xx <- list(reason = reason, status = status, message = mssg)
      message <- whisker::whisker.render(template, xx)
      status_type <- (status %/% 100) * 100
      http_class <- paste0("http_", unique(c(status, status_type, "error")))
      structure(
        list(message = message, call = call),
        class = c(http_class, type, "condition")
      )
    },

    fetch_status = function(x) {
      switch(
        class(x)[1],
        response = x$status_code, # httr
        Response = x$status_code, # webmockr
        VcrResponse = x$stats$status_code, # vcr
        HttpResponse = x$status_code, # crul
        list = x$status_code # curl
      )
    }
  )
)

fetch_status <- function(x) {
  switch(
    class(x)[1],
    response = x$status_code, # httr
    Response = x$status_code, # webmockr
    VcrResponse = x$stats$status_code, # vcr
    HttpResponse = x$status_code, # crul
    list = x$status_code # curl
  )
}
