tools/yarn_install.R

In rstudio/bootstraplib: Custom 'Bootstrap' 'Sass' Themes for 'shiny' and 'rmarkdown'

#!/usr/bin/env Rscript
library(sass)
library(rprojroot)
library(brio)
library(withr)


if (!identical(getwd(), find_package_root_file())) {
  stop("This script must be run from the top directory of the bslib package")
}

if (Sys.which("yarn") == "") {
  stop("The yarn CLI must be installed and in your PATH")
}

# Build _our_ JS assets (e.g., accordion component)
system("yarn install")
system("yarn build")

# only install the direct deps
with_dir("inst", system("yarn install --production"))

unlink("inst/lib", recursive = TRUE)
file.rename("inst/node_modules/", "inst/lib/")

# not used
unlink("inst/lib/.yarn-integrity")

# jquery comes in via jquerylib (R package)
unlink("inst/lib/jquery", recursive = TRUE)

# bootstrap is a peer dependency of bs-colorpicker?
unlink("inst/lib/bootstrap", recursive = TRUE)

# bootstrap.bundle.min.js includes popper (but not jQuery)
# https://getbootstrap.com/docs/4.4/getting-started/introduction/#js
unlink("inst/lib/popper.js", recursive = TRUE)


# ----------------------------------------------------------------------
# Add known vendor prefixes to all scss files since we don't want
# to rely on a node run-time to prefix after compilation
# https://github.com/twbs/bootstrap/blob/d438f3/package.json#L30
# ----------------------------------------------------------------------
scss_files <- dir("inst", pattern = "\\.scss$", recursive = TRUE, full.names = TRUE)
# These libs should already have prefixes in their source
# TODO: add test(s) that we aren't missing vendor prefixes
scss_files <- scss_files[!grepl("^inst/(lib/bs3|bs3compat|themer|components|bslib-scss|builtin|examples)", scss_files)]

scss_src <- lapply(scss_files, readLines)

add_property_prefixes <- function(src, property, ok_values = NULL, vendors = c("-webkit-", "-moz-", "-ms-", "-o-")) {
  pattern <- paste0("^\\s*", property, ":\\s*(.+);")
  idx <- grep(pattern, src)
  for (i in idx) {
    prop <- src[[i]]
    if (length(ok_values)) {
      value <- regmatches(prop, regexec(pattern, prop))[[1]][2]
      vals <- strsplit(value, "\\s+")[[1]]
      if (all(vals %in% c(ok_values, "!important"))) next
    }
    leading_ws <- regmatches(prop, regexpr("^\\s+", prop))
    src[[i]] <- paste0(
      leading_ws,
      c("", vendors),
      sub("^\\s+", "", prop),
      collapse = "\n"
    )
  }
  src
}

# Unconditionally prefix the following CSS properties for all vendors
needs_prefix <- c(
  "appearance", "user-select", "backdrop-filter",
  "backface-visibility", "touch-action",
  "animation-duration"
)
for (prop in needs_prefix) {
  scss_src <- lapply(scss_src, add_property_prefixes, prop)
}

# Only add webkit prefix for BS5+ since other vendors aren't really relevant anymore
for (prop in c('mask-image', 'mask-size', 'mask-position')) {
  scss_src <- lapply(scss_src, add_property_prefixes, prop, vendors = "-webkit-")
}

# Print specific vendor prefixes
scss_src <- lapply(scss_src, add_property_prefixes, "color-adjust", vendors = "-webkit-print-")

# phantomjs 2.1.1 needs webkit vendor prefix on flex properties to work correctly
flex_props <- c(
  "flex-direction", "flex-wrap", "flex-flow",  "justify-content",
  "align-items", "align-content", "order", "flex-grow", "flex-shrink",
  "flex-basis", "flex", "align-self"
)
for (prop in flex_props) {
  scss_src <- lapply(scss_src, add_property_prefixes, prop, vendors = "-webkit-")
}

# Conditionally prefix text-decoration if its not CSS2 compliant
# https://www.w3.org/TR/CSS2/text.html#lining-striking-props
# https://developer.mozilla.org/en-US/docs/Web/CSS/text-decoration
# https://caniuse.com/#search=text-decoration
scss_src <- lapply(
  scss_src, add_property_prefixes, "text-decoration",
  ok_values = c("none", "underline", "overline", "line-through", "blink", "inherit")
)


add_value_prefixes <- function(src, value, vendors = c("-webkit-", "-moz-", "-ms-", "-o-")) {
  pattern <- paste0("^\\s*[^/]+:\\s*", value, "\\s*(!important)?\\s*;")
  idx <- grep(pattern, src)
  for (i in idx) {
    prop_val <- strsplit(src[[i]], ":\\s*")[[1]]
    src[[i]] <- paste0(
      prop_val[1], ": ", c("", vendors), prop_val[2],
      collapse = "\n"
    )
  }
  src
}

# https://caniuse.com/?search=min-content
scss_src <- lapply(scss_src, add_value_prefixes, "min-content")
scss_src <- lapply(scss_src, add_value_prefixes, "max-content")

# phantomjs 2.1.1 needs `display: -webkit-flex` to work properly
scss_src <- lapply(scss_src, add_value_prefixes, "flex", vendors = "-webkit-")

# Write modified source to disk
invisible(Map(writeLines, scss_src, scss_files))

# ----------------------------------------------------------------------
# Check to make sure we're not missing any vendor prefixes
# that we don't already know about in the distributed CSS
# ----------------------------------------------------------------------

find_prefixed_css <- function(css) {
  vendors <- c("webkit", "moz", "ms")
  prefixes <- lapply(vendors, function(vendor) {
    pattern <- sprintf("-%s-([^:|;| |\\|,)]+)", vendor)
    prefixes <- regmatches(css, regexec(pattern, css))
    lapply(prefixes, function(x) if (length(x) > 1) x[2] else NULL)
  })
  unique(unlist(prefixes, recursive = TRUE))
}

# TODO: do for each bootstrap?
src_prefixes <- find_prefixed_css(unlist(scss_src))
dist_prefixes <- find_prefixed_css(
  c(
    readLines("inst/lib/bs4/dist/css/bootstrap.css"),
    readLines("inst/lib/bs5/dist/css/bootstrap.css")
  )
)
auto_prefixes <- setdiff(dist_prefixes, src_prefixes)

whitelist <- c(
  # https://caniuse.com/#feat=flexbox
  "flex", "inline-flex", "inline-flexbox",
  # https://caniuse.com/#feat=mdn-api_csskeyframesrule
  "keyframes",
  # https://caniuse.com/#feat=mdn-css_properties_transition
  "transition",
  # https://caniuse.com/#feat=css-animation
  "animation",
  # https://caniuse.com/#feat=transforms2d
  "transform",
  # https://caniuse.com/#feat=mdn-css_properties_column-count
  "column-count",
  # https://caniuse.com/#feat=mdn-css_properties_column-gap_multicol_context
  "column-gap",
  # https://caniuse.com/#feat=css-placeholder
  "placeholder", "input-placeholder",
  # https://developer.mozilla.org/en-US/docs/Web/CSS/text-decoration-skip-ink
  "text-decoration-skip-ink",
  # webkit prefix doesn't seem necessary? And Bootstrap docs warn about IE...
  # https://caniuse.com/#search=sticky
  "sticky",
  # Already applied conditional prefixing
  "text-decoration",
  "text-decoration-color",
  # IE11 technically needs a prefix, but this is just for floating labels
  # and I'm lazy https://caniuse.com/?search=placeholder-shown
  "placeholder-shown",
  # False positive?
  "margin-end"
)

unknown_prefixes <- setdiff(
  # whitelist flexbox props (there are many)
  auto_prefixes[!grepl("^flex-*", auto_prefixes)],
  whitelist
)
if (length(unknown_prefixes)) {
  stop(
    "Unknown vendor prefixes introduced by Bootstrap's autoprefixer. ",
    "Use either add_property_prefixes() to add prefixes or whitelist them ",
    "(if they're not needed for modern browsers): ",
    "'", paste(collapse = "', '", unknown_prefixes), "'.",
    call. = FALSE
  )
}


# ----------------------------------------------------------------------
# Now, get rid of files that we don't need to bundle with the package
# ----------------------------------------------------------------------

with_dir(
  "inst/lib", {
    # Downsize Bootstrap
    for (bs in c("bs5", "bs4")) {
      unlink(file.path(bs, "dist/css"), recursive = TRUE)
      unlink(file.path(bs, "js"), recursive = TRUE)
      js_dist <- file.path(bs, "dist/js")
      non_bundle <- setdiff(
        dir(js_dist), c("bootstrap.bundle.min.js", "bootstrap.bundle.min.js.map")
      )
      file.remove(file.path(js_dist, non_bundle))
    }

    # Only keep Bootswatch's Sass source files
    for (bsw in c("bsw5", "bsw4")) {
      file.remove(Sys.glob(file.path(bsw, "dist/*/*.css")))
      file.remove(Sys.glob(file.path(bsw, "dist/*/*.map")))
      unlink("bsw5/docs", recursive = TRUE)
      # Remove hidden files
      unlink(
        dir(bsw, pattern = "^\\.[a-z]+", all.files = TRUE, full.names = TRUE), recursive = TRUE
      )
    }
    file.remove(c(
      Sys.glob("bsw3/*/bootstrap.css"),
      Sys.glob("bsw3/*/bootstrap.min.css"),
      Sys.glob("bsw3/*/thumbnail.png"),
      Sys.glob("bsw3/*/*.less")
    ))
    unlink("bsw3/docs", recursive = TRUE)
    unlink("bsw3/.github", recursive = TRUE)
    unlink("bsw3/fonts", recursive = TRUE) # have fonts via tools/download_fonts.R

    # Downsize bootstrap-accessibility
    with_dir("bs-a11y-p", {
      discard <- setdiff(dir(), c("src", "plugins", "LICENSE.md", "package.json"))
      unlink(discard, recursive = TRUE)
    })

    # Downsize bootstrap-colorpicker
    with_dir(
      "bs-colorpicker", {
        file.rename("dist/css", "css")
        file.rename("dist/js", "js")
        # For the sake of simplicity, a patch is applied to just the
        # non-minified version (and the minified version isn't used)
        unlink(Sys.glob("js/*.min.js"))
        unlink("node_modules", recursive = TRUE)
        unlink("dist", recursive = TRUE)
        unlink("src", recursive = TRUE)
        unlink("logo.png")
      }
    )

    # GitHub reports security issues of devDependencies, but that's irrelevant to us
    remove_dev_dependencies <- function(pkg_file) {
      if (!file.exists(pkg_file)) return()
      json <- jsonlite::fromJSON(pkg_file)
      json <- json[setdiff(names(json), "devDependencies")]
      jsonlite::write_json(json, pkg_file, pretty = TRUE, auto_unbox = TRUE)
    }
    invisible(lapply(Sys.glob("*/package.json"), remove_dev_dependencies))

    # Get BS4/BS3 versions (for bslib::bs_dependencies() version-ing)
    version_bs5 <- sub("-beta[0-9]+", "", jsonlite::fromJSON("bs5/package.json")$version)
    version_bs4 <- jsonlite::fromJSON("bs4/package.json")$version
    version_bs3 <- jsonlite::fromJSON("bs3/package.json")$version
    version_accessibility <- jsonlite::fromJSON("bs-a11y-p/package.json")$version
  }
)

writeLines(
  c(
    '# DO NOT EDIT',
    '# This file is auto-generated by tools/yarn_install.R',
    paste0('version_bs5 <- ', deparse( version_bs5)),
    paste0('version_bs4 <- ', deparse(version_bs4)),
    paste0('version_bs3 <- ',  deparse(version_bs3)),
    paste0('version_accessibility <- ',  deparse(version_accessibility))
  ),
  "R/versions.R"
)


# ----------------------------------------------------------------------
# Apply any patches to source
# ----------------------------------------------------------------------

patch_files <- list.files(
  find_package_root_file("tools/patches"),
  full.names = TRUE
)

rej_pre <- dir(pattern = "\\.rej$", recursive = TRUE)
for (patch in patch_files) {
  message(sprintf("Applying %s", basename(patch)))
  res <- system(sprintf("git apply --reject --whitespace=fix '%s'", patch))
  if (res > 0) stop("Couldn't successfully apply patch: ", patch, call. = FALSE)
}
rej_post <- dir(pattern = "\\.rej$", recursive = TRUE)
if (length(rej_post) > length(rej_pre)) {
  warning(
    "Running `git apply --reject` generated `.rej` files. \n",
    "An 'easy' way to do this is to first `git add` the new source changes, ",
    "then manually make the relevant changes from the patch file,",
    "then `git diff` to get the relevant diff output and update the patch diff with the new diff."
  )
}

# Tracking changes in solar isn't so important since we've basically
# re-implemented it using a proper color system
# TODO: do the same for BS5?
writeLines(
  sass::as_sass(list(
    "white" = "#092B36 !default",
    "gray-100" = "#173741 !default",
    "gray-200" = "#25434B !default",
    "gray-300" = "#324E56 !default",
    "gray-400" = "#405A61 !default",
    "gray-500" = "#4E666B !default",
    "gray-600" = "#5C7276 !default",
    "gray-700" = "#6A7E81 !default",
    "gray-800" = "#77898C !default",
    "gray-900" = "#859596 !default",
    "black" = "#93A1A1 !default",
    "blue" = "#b58900 !default",
    "indigo" = "#6610f2 !default",
    "purple" = "#6f42c1 !default",
    "pink" = "#e83e8c !default",
    "red" = "#d33682 !default",
    "orange" = "#fd7e14 !default",
    "yellow" = "#cb4b16 !default",
    "green" = "#2aa198 !default",
    "teal" = "#20c997 !default",
    "cyan" = "#268bd2 !default",
    "enable-gradients" = "true !default",
    "secondary" = "$gray-800 !default",
    # Darker green and lighter green than `$black` and `$white`
    "color-contrast-dark" = "#031014 !default",
    "color-contrast-light" = "#BBD0D0 !default"
  )),
  "inst/lib/bsw4/dist/solar/_variables.scss"
)
writeLines(
  c(
    '$web-font-path: "https://fonts.googleapis.com/css2?family=Source+Sans+Pro:wght@400;600;700&display=swap" !default;',
    '@import url($web-font-path);'
  ),
  "inst/lib/bsw4/dist/solar/_bootswatch.scss"
)

# ----------------------------------------------------------------------
# Apply minification to patched files
# ----------------------------------------------------------------------

with_dir("inst", {
  local({
    # install all deps
    system("yarn install")
    # remove node modules
    on.exit({
      unlink("node_modules", recursive = TRUE)
    }, add = TRUE)

    bslib_plugin_paths <- file.path(
      "lib", "bs-a11y-p", "plugins", "js", c(
        "bootstrap-accessibility.js"
      ))

    for (unminified_file in c(
      bslib_plugin_paths
    )) {
      message("Minifying ", basename(unminified_file))
      cmd <- paste0(
        "yarn parcel",
        " build ", unminified_file,
        " --no-source-maps",
        " --no-cache",
        " --out-dir ", dirname(unminified_file),
        " --out-file ", sub(".js", ".min.js", fixed = TRUE, basename(unminified_file))
      )

      system(cmd)
    }

  })

})

# Clean up
unlink("inst/yarn.lock")
unlink("inst/node_modules", recursive = TRUE)

# ----------------------------------------------------------------------
# Precompile Bootstrap CSS
# ----------------------------------------------------------------------

# This generates precompiled builds of Bootstrap's css. It would be nice to do
# it at binary package build time, but I couldn't get that to work, using either
# src/install.libs.R (because the bslib functions used in this script
# aren't available yet), or by putting this code directly in the R/ directory
# (because the R/ files are evaluated only after the inst directory is copied
# over).
library(bslib)

precompiled_dir <- find_package_root_file("inst/css-precompiled")
unlink(precompiled_dir, recursive = TRUE)
dir.create(precompiled_dir, recursive = TRUE)

invisible(lapply(versions(), function(version) {
  res <- bs_theme_dependencies(
    bs_theme(version), precompiled = FALSE,
    sass_options = sass_options(output_style = "compressed"),
    cache = NULL
  )
  # Extract the Bootstrap dependency object (as opposed to, say, jQuery)
  bs_dep <- Filter(res, f = function(x) { identical(x$name, "bootstrap") })[[1]]

  tmp_css <- file.path(bs_dep$src$file, bs_dep$stylesheet)
  dest_dir <- file.path(precompiled_dir, version)
  if (!dir.exists(dest_dir)) {
    dir.create(dest_dir)
  }
  file.copy(tmp_css, dest_dir)

  # Also save the BS5+ Sass code used to generate the pre-compiled CSS.
  # This is primarily here to help Quarto more easily replicate bs_theme()'s Sass.
  if (version >= 5) {
    theme_sass <- gsub(
      paste0("@import \"", getwd(), "/"),
      "@import \"",
      as_sass(bs_theme(version))
    )
    writeLines(theme_sass, file.path(dest_dir, "bootstrap.scss"))
    # Sanity check that we we can compile by moving file to home dir
    file.copy(file.path(dest_dir, "bootstrap.scss"), "bootstrap.scss")
    on.exit(unlink("bootstrap.scss"), add = TRUE)
    testthat::expect_error(sass(sass_file("bootstrap.scss")), NA)
  }
}))