echarter: R Interface to Echarts

#' Construct aesthetic mappings
#'
#' Aesthetic mappings describe how variables in the data are mapped to visual
#' properties (aesthetics) of option.
#'
#' This function also standardises aesthetic names by converting `colour` to `color`.
#'
#' @section Quasiquotation:
#'
#' `ecaes()` is a [quoting function][rlang::quotation]. This means that
#' its inputs are quoted to be evaluated in the context of the
#' data. This makes it easy to work with variables from the data frame
#' because you can name those directly. The flip side is that you have
#' to use [quasiquotation][rlang::quasiquotation] to program with
#' `ecaes()`. See a tidy evaluation tutorial such as the [dplyr
#' programming vignette](http://dplyr.tidyverse.org/articles/programming.html)
#' to learn more about these techniques.
#'
#' @param x,y,... List of name-value pairs in the form `aesthetic = variable`
#'   describing which variables in the data should be mapped to which
#'   aesthetics used by the option. The expression `variable` is
#'   evaluated within the data, so there is no need to refer to
#'   the original dataset (i.e., use `ecaes(variable)`
#'   instead of `ecaes(df$variable)`). The names for x and y aesthetics
#'   are typically omitted because they are so common; all other aesthetics must be named.
#' @seealso [aes()] Construct aesthetic mappings for ggplot.
#' @return A list with class `uneval` and `ecaes`. Components of the list are either
#'   quosures or constants.
#' @export
#' @examples
#' \dontrun{
#' ecaes(x = mpg, y = wt)
#' ecaes(mpg, wt)
#'
#' # You can also map aesthetics to functions of variables
#' ecaes(x = mpg ^ 2, y = wt / cyl)
#'
#' # Or to constants
#' ecaes(x = 1, color = "smooth")
#'
#' # Aesthetic names are automatically standardised
#' ecaes(col = x)
#' ecaes(fg = x)
#' ecaes(color = x)
#' ecaes(colour = x)
#' ecaes(shape = y)
#' ecaes(size = z)
#'
#' # Tidy evaluation ----------------------------------------------------
#' # ecaes() automatically quotes all its arguments.
#' scatter_by <- function(data, ...) {
#'   echart() %>% ec_add_series(data, type = 'scatter', mapping = ecaes(...))
#' }
#' scatter_by(mtcars, disp, drat)
#'
#' # If your wrapper has a more specific interface with named arguments,
#' # you need "enquote and unquote":
#' scatter_by <- function(data, x, y) {
#'   x <- enquo(x)
#'   y <- enquo(y)
#'
#'   echart() %>%
#'     ec_add_series(data, type = 'scatter', mapping = ecaes(!!x, !!y))
#' }
#' scatter_by(mtcars, disp, drat)
#'
#' # Note that users of your wrapper can use their own functions in the
#' # quoted expressions and all will resolve as it should!
#' cut3 <- function(x) cut_number(x, 3)
#' scatter_by(mtcars, cut3(disp), drat)
#' }
ecaes <- function (x, y, ...) {
  exprs <- rlang::enquos(x = x, y = y, ..., .ignore_empty = "all")
  mapping <- ggplot2:::new_aes(exprs, env = parent.frame())
  structure(rename_ecaes(mapping), class = c("uneval", "ecaes"))
}

#' @export
is.ecaes <- function(x) {
  inherits(x, "ecaes")
}

#' @export
ecaes_ <- function (x, y, ...) {
  mapping <- list(...)
  if (!missing(x)) mapping["x"] <- list(x)
  if (!missing(y)) mapping["y"] <- list(y)

  caller_env <- parent.frame()

  as_quosure_aes <- function(x) {
    if (ggplot2:::is.formula(x) && length(x) == 2) {
      rlang::as_quosure(x)
    } else if (is.call(x) || is.name(x) || is.atomic(x)) {
      ggplot2:::new_aesthetic(x, caller_env)
    } else {
      abort("Aesthetic must be a one-sided formula, call, name, or constant.")
    }
  }
  mapping <- lapply(mapping, rlang::as_quosure_aes)
  structure(rename_ecaes(mapping), class = c("uneval", "ecaes"))
}

#' @export
ecaes_string <- function (x, y, ...) {
  mapping <- list(...)
  if (!missing(x)) mapping["x"] <- list(x)
  if (!missing(y)) mapping["y"] <- list(y)

  caller_env <- parent.frame()
  mapping <- lapply(mapping, function(x) {
    if (is.character(x)) {
      x <- parse_expr(x)
    }
    ggplot2:::new_aesthetic(x, env = caller_env)
  })
  structure(rename_ecaes(mapping), class = c("uneval", "ecaes"))
}



standardise_ecaes_names <- function(x) {
  # convert UK to US spelling of color
  x <- sub("colour", "color", x, fixed = TRUE)
  # convert non-standard aesthetics names
  ggplot2:::revalue(x, echarter_global$base_to_echarter)
}

# x is a list of aesthetic mappings, as generated by ecaes()
rename_ecaes <- function(x) {
  names(x) <- standardise_ecaes_names(names(x))
  duplicated_names <- names(x)[duplicated(names(x))]
  if (length(duplicated_names) > 0L) {
    duplicated_message <- paste0(unique(duplicated_names), collapse = ", ")
    warn(glue("Duplicated aesthetics after name standardisation: {duplicated_message}"))
  }
  x
}