tools/update_icons.R

In bsicons: Easily Work with 'Bootstrap' Icons

library(rvest)

# https://github.com/twbs/icons/releases
version <- "1.11.1"

pkg_home <- rprojroot::find_package_root_file()
pkgload::load_all(pkg_home)

if (!exists("icon_info")) {
  stop("Loading bsicons should introduce a icon_info object")
}

new_icon_info <- NULL

withr::with_tempdir({
  download.file(
    sprintf("https://github.com/twbs/icons/archive/refs/tags/v%s.zip", version),
    "icons.zip"
  )
  unzip("icons.zip")
  setwd(paste0("icons-", version))

  icon_files <- dir("icons", full.names = TRUE)
  icon_html <- lapply(icon_files, function(x) {
    read_html(paste(readLines(x), collapse = "\n"))
  })

  # Make sure there is one svg tag per file
  svgs <- lapply(icon_html, html_elements, "svg")
  stopifnot(unique(lengths(svgs)) == 1)

  # -------------------------------------------------------
  # Appears as though all icons are designed to be 1:1
  # aspect ratio and used with fill=currentColor, so we don't
  # need that information.
  # -------------------------------------------------------
  widths <- vapply(svgs, html_attr, character(1), "width")
  heights <- vapply(svgs, html_attr, character(1), "height")
  fills <- vapply(svgs, html_attr, character(1), "fill")
  vbs <- vapply(svgs, html_attr, character(1), "viewbox")
  stopifnot(
    unique(widths) == "16",
    unique(heights) == "16",
    unique(fills) == "currentColor",
    unique(vbs) == "0 0 16 16"
  )

  # -------------------------------------------------------
  # All the classes are just "bi bi-name"
  # -------------------------------------------------------
  classes <- vapply(svgs, html_attr, character(1), "class")
  classes <- strsplit(classes, "\\s+")
  icon_names <- sub("^bi-", "", vapply(classes, "[[", character(1), 2))

  stopifnot(
    unique(lengths(classes)) == 2,
    unique(vapply(classes, "[[", character(1), 1)) == "bi",
    all(icon_names == tools::file_path_sans_ext(basename(icon_files)))
  )

  # --------------------------------------------------------
  # Make sure there's no other svg attributes that we're missing
  # --------------------------------------------------------
  missing_attrs <- lapply(svgs, function(x) {
    setdiff(
      names(html_attrs(x)[[1]]),
      c("width", "height", "fill", "viewbox", "class", "xmlns")
    )
  })
  stopifnot(sum(lengths(missing_attrs)) == 0)

  # N.B. some icons (e.g., align-bottom) have elements other
  # than just <path>s (e.g., <rect>)
  contents <- lapply(svgs, html_elements, "*")

  new_icon_info <<- list(
    name = icon_names,
    contents = vapply(contents, function(x) paste(as.character(x), collapse = "\n"), character(1))
  )
})


if (is.null(new_icon_info)) {
  stop("Failed to get new icons")
}

missing_icons <- setdiff(icon_info$name, new_icon_info$name)
if (length(missing_icons)) {
  stop(
    "New version of Bootstrap icons dropped the following icons: '",
    paste(missing_icons, collapse = "', '"),
    "'. Consider keeping them for backwards-compatibility.")
}


cat(
  "# Generated by tools/update_icons.R: do not edit by hand\n\n",
  "icon_info <- ",
  paste(capture.output(dput(new_icon_info)), collapse = ""),
  sep = "",
  file = file.path(pkg_home, "R", "icons.R")
)