all-classes.R

#' @include ggproto.R
#' @include ggplot-global.R
NULL

# Docs -------------------------------------------------------------

#' Class definitions
#'
#' The S7 object oriented programming system requires class definitions.
#' Here, we provide definitions of classes that are home to ggplot2.
#'
#' @section S7 classes:
#'
#' A general advice the S7 package gives is to name class definition objects
#' the same as the class name, which then becomes the constructor for the class.
#' The classes listed below deviate from that advice for historical reasons,
#' because some constructors like `ggplot()` are also S3 generics with methods.
#' The have the `class_`-prefix to indicate their role.
#'
#' * [`class_ggplot`] is an S7 class used for objects generated by [ggplot()].
#' * [`class_ggplot_built`] is an S7 class used for objects generated by
#'   [ggplot_build()].
#' * [`class_mapping`] is an S7 class used for objects generated by [aes()].
#' * [`class_theme`] is an S7 class used for objects generated by [theme()].
#' * [`class_labels`] is an S7 class used for objects generated by [labs()].
#'
#' @section Theme elements:
#'
#' The theme elements follow the advice of the S7 package that the class names
#' are also the class definitions and constructors.
#'
#' * [`element`] is an abstract S7 class used to invoke similar behaviour among
#'   theme element objects.
#' * [`element_blank`] is an S7 class for not drawing theme elements.
#' * [`element_rect`] is an S7 class for drawing rectangles.
#' * [`element_line`] is an S7 class for drawing lines.
#' * [`element_text`] is an S7 class for rendering text.
#' * [`element_polygon`] is an S7 class for drawing polygons.
#' * [`element_point`] is an S7 class for drawing points.
#' * [`element_geom`] is an S7 class holding geom defaults.
#' * [`margin`] is an S7 class for declaring margins.
#'
#' @section ggproto classes:
#'
#' The ggproto classes are S3 classes of the type environment that form the
#' backbone of most systems in ggplot2 and are in particular crucial to the
#' extension system.
#'
#' @section S3 classes:
#'
#' Some simple classes remain S3, primarily because they aren't meant to be
#' recycled into new classes.
#'
#' @name class_definitions
#' @keywords internal
NULL

#' @rdname class_definitions
#' @section S7 classes:
#' * `class_gg` is an abstract S7 class to used invoke similar behaviour among
#'   ggplot objects.
#' @export
#' @format NULL
#' @usage NULL
class_gg <- S7::new_class("gg", abstract = TRUE)

# ggproto classes ---------------------------------------------------------

#' @rdname class_definitions
#' @section ggproto classes:
#' * `class_ggproto` is an S3 class used for the objects generated by
#'   [ggproto()] which are of the type environment.
#' @export
#' @format NULL
#' @usage NULL
class_ggproto <- S7::new_S3_class("ggproto")

# We don't own this class, so we don't export or describe it
class_gtable <- S7::new_S3_class("gtable")

#' @rdname class_definitions
#' @section ggproto classes:
#' * `class_scale` is a subclass of `class_ggproto` and is more described in
#'   the [Scale] documentation.
#' @export
#' @format NULL
#' @usage NULL
class_scale <- S7::new_S3_class("Scale")

#' @rdname class_definitions
#' @section ggproto classes:
#' * `class_guides` is a subclass of `class_ggproto` and is considered an
#'   internal class.
#' @export
#' @format NULL
#' @usage NULL
class_guides <- S7::new_S3_class("Guides")

#' @rdname class_definitions
#' @section ggproto classes:
#' * `class_guide` is a subclass of `class_ggproto` and is more described in the
#'   [Guide] documentation.
#' @export
#' @format NULL
#' @usage NULL
class_guide  <- S7::new_S3_class("Guide")

#' @rdname class_definitions
#' @section ggproto classes:
#' * `class_coord` is a subclass of `class_ggproto` and is more described in the
#'   [Coord] documentation.
#' @export
#' @format NULL
#' @usage NULL
class_coord  <- S7::new_S3_class("Coord")


#' @rdname class_definitions
#' @section ggproto classes:
#' * `class_facet` is a subclass of `class_ggproto` and is more described in the
#'   [Facet] documentation.
#' @export
#' @format NULL
#' @usage NULL
class_facet  <- S7::new_S3_class("Facet")

#' @rdname class_definitions
#' @section ggproto classes:
#' * `class_layer` is a subclass of `class_ggproto` and is used for the objects
#'   generated by [layer()]. The class itself is considered internal and is
#'   described in more detail in the [Layer] documentation.
#' @export
#' @format NULL
#' @usage NULL
class_layer  <- S7::new_S3_class("Layer")

#' @rdname class_definitions
#' @section ggproto classes:
#' * `class_layout` is a subclass of `class_ggproto` and is considered an
#'   internal class. It is described in more detail in the [Layout]
#'   documentation.
#' @export
#' @format NULL
#' @usage NULL
class_layout <- S7::new_S3_class("Layout")

#' @rdname class_definitions
#' @section ggproto classes:
#' * `class_scales_list` is a subclass of `class_ggproto` and is considered an
#'   internal class.
#' @export
#' @format NULL
#' @usage NULL
class_scales_list <- S7::new_S3_class("ScalesList")

# S3 classes --------------------------------------------------------------

#' @rdname class_definitions
#' @section S3 classes:
#' * `r lifecycle::badge("superseded")` `class_S3_gg` is a temporary S3 class
#'   until R 4.3.0 is the minimum  supported version. It is exported and
#'   listed here for completeness, but its use is heavily discouraged. It
#'   is superseded by `class_gg`.
#' @export
#' @format NULL
#' @usage NULL
class_S3_gg <- S7::new_S3_class("gg")

#' @rdname class_definitions
#' @section S3 classes:
#' * `class_rel` is an S3 class used in [element] properties.
#' @export
#' @format NULL
#' @usage NULL
class_rel <- S7::new_S3_class("rel")

#' @rdname class_definitions
#' @section S3 classes:
#' * `class_zero_grob` is an S3 class used to indicate empty drawings.
#' @export
#' @format NULL
#' @usage NULL
class_zero_grob <- S7::new_S3_class("zeroGrob")

#' @rdname class_definitions
#' @section S3 classes:
#' * `class_waiver` is an S3 sentinel value class used in various places.
#' @export
#' @format NULL
#' @usage NULL
class_waiver <- S7::new_S3_class("waiver")

#' @rdname class_definitions
#' @section S3 classes:
#' * `class_derive` is an S3 sentinel value class used primarily in [sec_axis()].
#' @export
#' @format NULL
#' @usage NULL
class_derive <- S7::new_S3_class("derive")

# User facing classes -----------------------------------------------------

## Theme -------------------------------------------------------------------

#' The theme class
#'
#' The theme class holds information on how non-data elements of the plot
#' should be rendered. The preferred way to construct an object of this class
#' is through the [`theme()`] function.
#'
#' @param elements A named list containing theme elements.
#' @param ... Reserved for future expansion.
#' @param complete A boolean value stating whether a theme is complete.
#' @param validate A boolean value stating whether a theme should still be
#'   validated.
#'
#' @keywords internal
#' @export
class_theme <- S7::new_class(
  "theme", class_S3_gg,
  properties = list(
    complete = S7::class_logical,
    validate = S7::class_logical
  ),
  constructor = function(elements = list(), ..., complete = FALSE, validate = TRUE) {
    warn_dots_empty()
    S7::new_object(
      elements,
      complete = complete,
      validate = validate
    )
  }
)

## Labels ------------------------------------------------------------------

#' The labels class
#'
#' The labels class holds a list with label information to display as titles
#' of plot components. The preferred way to construct an object of the labels
#' class is to use the [`labs()`] function.
#'
#' @param labels A named list.
#' @param ... Reserved for future expansion.
#'
#' @details
#' All members of `labels` are expected to be named and names should be unique.
#'
#'
#' @keywords internal
#' @export
class_labels <- S7::new_class(
  "labels", parent = class_S3_gg,
  constructor = function(labels = list(), ...) {
    warn_dots_empty()
    S7::new_object(labels)
  },
  validator = function(self) {
    if (!is.list(self)) {
      return("labels must be a list.")
    }
    if (!is_named2(self)) {
      return("every label must be named.")
    }
    dups <- unique(names(self)[duplicated(names(self))])
    if (length(dups) > 0) {
      dups <- oxford_comma(dups, final = "and")
      return(paste0("labels cannot contain duplicate names (", dups, ")."))
    }
    return(NULL)
  }
)

## Mapping -----------------------------------------------------------------

#' The mapping class
#'
#' The mapping class holds a list of quoted expressions
#' ([quosures][rlang::topic-quosure]) or constants. An object is typically
#' constructed using the [`aes()`] function.
#'
#' @param x A list of quosures and constants.
#' @param ... Reserved for future expansion.
#' @param env An environment for symbols that are not quosures or constants.
#'
#' @keywords internal
#' @export
class_mapping <- S7::new_class(
  "mapping", parent = class_S3_gg,
  constructor = function(x = list(), ..., env = globalenv()) {
    warn_dots_empty()
    check_object(x, is.list, "a {.cls list}")
    x <- lapply(x, new_aesthetic, env = env)
    x <- S7::new_object(x)
    class(x) <- union(c("ggplot2::mapping", "uneval"), class(x))
    x
  }
)

## ggplot ------------------------------------------------------------------

#' The ggplot class
#'
#' The ggplot class collects the needed information to render a plot.
#' This class can be constructed using the [`ggplot()`] function.
#'
#' @param data A property containing any data coerced by [`fortify()`].
#' @param ... Reserved for future expansion.
#' @param layers A list of layer instances created by [`layer()`].
#' @param scales A ScalesList ggproto object.
#' @param guides A Guides ggproto object created by [`guides()`].
#' @param mapping A mapping class object created by [`aes()`].
#' @param theme A theme class object created by [`theme()`].
#' @param coordinates A Coord ggproto object created by `coord_*()` family of
#'   functions.
#' @param facet A Facet ggproto object created by `facet_*()` family of
#'   functions.
#' @param layout A Layout ggproto object.
#' @param labels A labels object created by [`labs()`].
#' @param meta A list for additional metadata. This will be deprecated in the
#'   future.
#' @param plot_env An environment.
#'
#' @keywords internal
#' @export
class_ggplot <- S7::new_class(
  name = "ggplot", parent = class_gg,
  properties = list(
    data    = S7::class_any,
    layers  = S7::class_list,
    scales  = class_scales_list,
    guides  = class_guides,
    mapping = class_mapping,
    theme   = class_theme,
    coordinates = class_coord,
    facet   = class_facet,
    layout  = class_layout,
    labels  = class_labels,
    meta    = S7::class_list,
    version = S7::new_S3_class("package_version"),
    plot_env = S7::class_environment
  ),
  constructor = function(
    data = waiver(),
    ...,
    layers = list(),
    scales = NULL,
    guides = NULL,
    mapping = aes(),
    theme = NULL,
    coordinates = coord_cartesian(default = TRUE),
    facet = facet_null(),
    layout = NULL,
    labels = labs(),
    meta = list(),
    plot_env = parent.frame()
  ) {
    warn_dots_empty()
    S7::new_object(
      S7::S7_object(),
      data        = data,
      layers      = layers,
      scales      = scales %||% scales_list(),
      guides      = guides %||% guides_list(),
      mapping     = mapping,
      theme       = theme %||% theme(),
      coordinates = coordinates,
      facet       = facet,
      layout      = layout %||% ggproto(NULL, Layout),
      labels      = labels,
      meta        = meta,
      version     = current_version,
      plot_env    = plot_env
    )
  }
)

## Built ggplot ------------------------------------------------------------

#' The ggplot built class
#'
#' The ggplot built class is an intermediate class and represents a processed
#' ggplot object ready for rendering. It is constructed by calling
#' [`ggplot_build()`] on a [ggplot][class_ggplot] object and is not meant to be
#' instantiated directly. The class can be rendered to a gtable object by
#' calling the [`ggplot_gtable()`] function on a ggplot built class object.
#'
#' @param ... Reserved for future expansion.
#' @param data A list of plain data frames; one for each layer.
#' @param layout A Layout ggproto object.
#' @param plot A completed ggplot class object.
#'
#' @keywords internal
#' @export
class_ggplot_built <- S7::new_class(
  "ggplot_built", parent = class_gg,
  properties = list(
    data   = S7::class_list,
    layout = class_layout,
    plot   = class_ggplot
  ),
  constructor = function(..., data = NULL, layout = NULL, plot = NULL) {
    warn_dots_empty()
    if (is.null(data) || is.null(layout) || is.null(plot)) {
      cli::cli_abort(
        "The {.cls ggplot_built} class should be constructed by {.fn ggplot_build}."
      )
    }
    S7::new_object(
      S7::S7_object(),
      data = data,
      layout = layout,
      plot = plot
    )
  }
)

# Methods -----------------------------------------------------------------

#' @importFrom S7 convert
# S7 currently attaches the S3 method to the calling environment which gives `ggplot2:::as.list`
# Wrap in `local()` to provide a temp environment which throws away the attachment
local({
  list_classes <- class_mapping | class_theme | class_labels
  prop_classes <- class_ggplot | class_ggplot_built

  S7::method(convert, list(from = prop_classes, to = S7::class_list)) <-
    function(from, to, ...) S7::props(from)

  S7::method(convert, list(from = list_classes, to = S7::class_list)) <-
    function(from, to, ...) S7::S7_data(from)

  # We're not using union classes here because of S7#510
  S7::method(as.list, class_gg) <-
    S7::method(as.list, class_mapping) <-
    S7::method(as.list, class_theme) <-
    S7::method(as.list, class_labels) <-
    function(x, ...) convert(x, S7::class_list)

  S7::method(convert, list(from = S7::class_list, to = prop_classes)) <-
    function(from, to, ...) inject(to(!!!from))

  S7::method(convert, list(from = S7::class_list, to = list_classes)) <-
    function(from, to, ...) to(from)
})