1MIN_PILLAR_WIDTH <- 5L
2
3style_type <- function(x) {
4  force(x)
5  x <- style_subtle(x)
6  crayon_italic(x)
7}
8
9#' Prepare a column type for formatting
10#'
11#' Calls [type_sum()] to format the type.
12#' Call [format()] on the result to render column types.
13#'
14#' @param x A vector for which the type is to be retrieved.
15#' @inheritParams ellipsis::dots_empty
16#' @export
17#' @examples
18#' format(new_pillar_type(iris$Species))
19new_pillar_type <- function(x, ...) {
20  "!!!!DEBUG new_pillar_type(`v(class(x))`)"
21  if (!missing(...)) {
22    check_dots_empty(action = warn)
23  }
24
25  type <- get_pillar_type(x)
26
27  # Must wrap in a list, because type_sum() can return a classed object
28  ret <- structure(list(type), class = "pillar_type")
29  extent <- get_extent(format_type_sum(type, NULL))
30  ret <- set_width(ret, width = max(extent, MIN_PILLAR_WIDTH))
31  ret <- set_min_width(ret, MIN_PILLAR_WIDTH)
32  ret
33}
34
35get_pillar_type <- function(x, shaft) {
36  type <- type_sum(x)
37  if (length(type) == 0L) type <- "?"
38  # Can return a classed object to be formatted by format_type_sum()
39  type[] <- as.character(type[[1L]])
40  type
41}
42
43#' @export
44format.pillar_type <- function(x, width = NULL, ...) {
45  format_type_sum(x[[1]], width)
46}
47
48format_full_pillar_type <- function(x) {
49  type <- get_pillar_type(x)
50  format_type_sum(type, NULL)
51}
52
53#' Format a type summary
54#'
55#' Called on values returned from [type_sum()] for defining the description
56#' in the capital.
57#'
58#' Two methods are implemented by default for this generic: the default method,
59#' and the method for the `"AsIs"` class.
60#' Return `I("type")` from your [type_sum()] implementation to format the type
61#' without angle brackets.
62#' For even more control over the formatting, implement your own method.
63#'
64#' @param x A return value from `type_sum()`
65#' @param width The desired total width. If the returned string still is
66#'   wider, it will be trimmed. Can be `NULL`.
67#' @inheritParams ellipsis::dots_used
68#'
69#' @export
70#' @examples
71#' # Default method: show the type with angle brackets
72#' format_type_sum(1, NULL)
73#' pillar(1)
74#'
75#' # AsIs method: show the type without angle brackets
76#' type_sum.accel <- function(x) {
77#'   I("kg m/s^2")
78#' }
79#'
80#' accel <- structure(9.81, class = "accel")
81#' pillar(accel)
82format_type_sum <- function(x, width, ...) {
83  if (!missing(...)) {
84    check_dots_used(action = warn)
85  }
86
87  UseMethod("format_type_sum")
88}
89
90# https://github.com/r-lib/pkgdown/issues/1540
91type_sum.accel <- function(x) {
92  I("kg m/s^2")
93}
94
95#' @export
96#' @rdname format_type_sum
97format_type_sum.default <- function(x, width, ...) {
98  if (!is.null(width) && width - 2 < get_extent(x)) {
99    x <- substr(x, 1, max(width - 2, 0))
100  }
101  style_type(paste0("<", x, ">"))
102}
103
104#' @export
105#' @rdname format_type_sum
106format_type_sum.AsIs <- function(x, width, ...) {
107  if (!is.null(width) && width < get_extent(x)) {
108    x <- substr(x, 1, width)
109  }
110  style_type(unclass(x))
111}
112