R/google_material.R

In icons: Easily Insert SVG Icons into R Outputs

#' @param version Version of the library
#' @rdname google_material
#' @export
download_google_material <- function(version = "dev"){
  if(version == "dev" || package_version(version) >= package_version("4.0.0")) {
    svg_ext <- "24px\\.svg"
    if(requireNamespace("gh")) {
      meta <- list(
        version = gh::gh("GET /repos/:owner/:repo/releases/latest", owner="google", repo="material-design-icons")$tag_name,
        license = gh::gh("GET /repos/:owner/:repo", owner="google", repo="material-design-icons")$license$name
      )
    } else {
      cli::cli_warn(
        c(
          "!" = "Obtaining the most recent version and license automatically requires the {.pkg gh} package.",
          "i" = "Using last known license, which may not be current."
        )
      )
      meta <- list(
        version = version,
        license = "Apache License 2.0"
      )
    }

    # v4.0.0+ keeps every SVG under a single top-level `src/` folder, so a
    # sparse git checkout of just that path avoids downloading the rest of
    # this multi-gigabyte repository (fonts, sprites, docs, ...).
    install_icon_git(
      "google_material",
      repo = "google/material-design-icons",
      ref = if(version == "dev") "master" else version,
      sparse_path = "src",
      svg_path = function(path) file.path(path, "src"),
      svg_pattern = svg_ext, svg_dest = mdi_svg_dest(meta$version),
      meta = list(name = "Material Design Icons", version = meta$version, licence = meta$license)
    )
  } else {
    # Pre-4.0.0 releases scatter `svg/` folders throughout many per-category
    # directories rather than one common path, so a single sparse checkout
    # path doesn't cleanly cover them; fall back to the full archive.
    svg_ext <- "_48px\\.svg"
    meta <- jsonlite::read_json(glue("https://raw.githubusercontent.com/google/material-design-icons/{version}/package.json"))
    url <- glue("https://github.com/google/material-design-icons/archive/{version}.zip")

    install_icon_zip(
      "google_material", url, svg_path = mdi_svg_paths(meta$version),
      svg_pattern = svg_ext, svg_dest = mdi_svg_dest(meta$version),
      meta = list(name = "Material Design Icons", version = meta$version, licence = meta$license)
    )
  }

  invisible(google_material)
}

# Only used for pre-4.0.0 releases (see download_google_material()); the
# 4.0.0+ path is handled directly via install_icon_git()'s svg_path.
mdi_svg_paths <- function(version) {
  function(path){
    repo_dirs <- list.dirs(list.dirs(path, recursive = FALSE),recursive = FALSE)
    svg_dirs <- Filter(function(x) "svg" %in% basename(list.dirs(x, recursive = FALSE)), repo_dirs)
    file.path(svg_dirs, "svg")
  }
}

mdi_svg_dest <- function(version) {
  if(package_version(version) >= package_version("4.0.0")) {
    function(svgs) {
      style <- factor(
        basename(dirname(svgs)),
        levels = c("materialicons", "materialiconsoutlined", "materialiconsround",
                   "materialiconssharp", "materialiconstwotone"),
        labels = c("filled", "outlined", "round", "sharp", "twotone")
      )
      name <- basename(dirname(dirname(svgs)))
      group <- basename(dirname(dirname(dirname(svgs))))
      file.path(style, group, paste0(name, ".svg"))
    }
  } else {
    function(svgs){
      svg_production <- basename(dirname(svgs)) == "production"
      svg_group <- basename(dirname(dirname(dirname(svgs))))
      svg_dest <- rep(NA_character_, length(svgs))
      svg_dest[svg_production] <- file.path(
        svg_group[svg_production],
        gsub("^ic_", "", gsub("_48px\\.svg$", "\\.svg", basename(svgs[svg_production]))))
      svg_dest
    }
  }
}

#' Google's Material design icons
#'
#' @param name Name of the icon
#' @param category The icon's category, either "action", "alert", "av",
#'   "communication", "content", "device", "editor", "file", "hardware", "home",
#'   "image", "maps", "navigation", "notification", "places", "social", or
#'   "toggle"
#' @param theme The style variant for the icon, requires v4.0.0 or greater.
#'   Available themes vary by icon, but can be either "filled", "outlined",
#'   "round", "sharp", or "twotone". If NULL, it will default to the
#'   first available variant in this order.
#'
#' @seealso <https://fonts.google.com/icons>
#'
#' @section License:
#' Material Design Icons are distributed under the
#' [Apache License 2.0](https://github.com/google/material-design-icons/blob/master/LICENSE).
#'
#' @return `download_google_material()` invisibly returns the
#'   `google_material` icon set after downloading and installing its SVG
#'   files locally.
#'
#'   `google_material(name, category, theme)` returns an `icons` vector (an
#'   SVG tag) for the requested icon.
#'
#' @rdname google_material
#' @export
google_material <- new_icon_set(
  "google_material",
  function(name, category = NULL, theme = NULL){
    if(is.null(category)){
      icon_guess(name, "google_material", pattern = theme)
    } else {
      icon_fn$get(c(theme, category, name))
    }
  }
)