htmlDependencies.R

#!/usr/bin/env Rscript

if (requireNamespace("cli", quietly = TRUE)) {
  message <- function(..., .envir = parent.frame()) {
    cli::cli_progress_step(paste0(...), .envir = .envir)
  }
}

message("Checking for node / npm")
if (Sys.which("npm")[["npm"]] == "") {
  stop("Please install node / npm before running script")
}

versions <- list()

# Use local lib path for installing packages so we don't pollute the user's library
message("Installing GitHub packages: bslib, shiny, htmltools")
withr::local_temp_libpaths()
ignore <- capture.output({
  pak::pkg_install(c(
    "rstudio/bslib@main",
    "rstudio/shiny@main",
    "rstudio/sass@main",
    "rstudio/htmltools@main"
  ))
  #pak::pkg_install(c("rstudio/bslib@main", "rstudio/shiny@main", "rstudio/htmltools@main"))
})

versions["shiny_html_deps"] <- as.character(packageVersion("shiny"))
versions["bslib"] <- as.character(packageVersion("bslib"))
versions["htmltools"] <- as.character(packageVersion("htmltools"))

pkg_source_version <- function(pkg_name) {
  pkg_info <- sessioninfo::package_info(pkg_name)
  pkg_info_list <- pkg_info[pkg_info$package == pkg_name, , drop = TRUE]
  pkg_info_list$source
}
write_json <- function(file, x, ..., pretty = TRUE, auto_unbox = TRUE) {
  jsonlite::write_json(
    c(
      list("note!" = "This file is auto-generated by scripts/htmlDependencies.R"),
      x
    ),
    file,
    ...,
    pretty = pretty, auto_unbox = auto_unbox
  )
}

bslib_version <- pkg_source_version("bslib")
shiny_version <- pkg_source_version("shiny")
htmltools_version <- pkg_source_version("htmltools")

library(htmltools, quietly = TRUE, warn.conflicts = FALSE)
library(bslib, quietly = TRUE, warn.conflicts = FALSE)

shiny_path <- fs::path(getwd(), "shiny")
www <- fs::path(shiny_path, "www")
www_shared <- fs::path(www, "shared")

www_bslib_components <- fs::path(www_shared, "bslib", "components")
www_htmltools_fill <- fs::path(www_shared, "htmltools", "fill")

# Copy over shiny's www/shared directory
copy_from_pkg <- function(pkg_name, pkg_dir, local_dir, version_dir = fs::path_dir(local_dir)) {
  # `version_dir` is "equal to" or "contains" `local_dir`
  stopifnot(fs::path_has_parent(local_dir, version_dir))
  if (fs::dir_exists(version_dir)) fs::dir_delete(version_dir)
  fs::dir_create(local_dir)

  stopifnot(local_dir != ".")

  # Copy other folder into local parent folder
  fs::dir_copy(
    system.file(pkg_dir, package = pkg_name),
    dirname(local_dir)
  )
  # Rename folder to local folder name
  if (basename(local_dir) != basename(pkg_dir)) {
    file.rename(
      fs::path(dirname(local_dir), basename(pkg_dir)),
      local_dir
    )
  }
  # Save pkg version info
  write_json(
    fs::path(version_dir, "_version.json"),
    list(
      package = pkg_name,
      version = pkg_source_version(pkg_name)
    )
  )
}

# Set sass compilation options
local_sass_options <- withr::local_(function(x) rlang::exec(sass::sass_options_set, !!!x))
local_sass_options(list(
  output_style = "compressed",
  source_comments = FALSE,
  source_map_embed = FALSE
))


# ------------------------------------------------------------------------------
# Must come first!
message("Copy shiny www/shared")
# Copy over shiny's www/shared directory
copy_from_pkg("shiny", "www/shared", www_shared, www_shared)

# ------------------------------------------------------------------------------
message("Copy bslib components")
# Copy over bslib's components directory
copy_from_pkg("bslib", "components/dist", www_bslib_components)
# Remove non-minified files
fs::file_delete(
  fs::dir_ls(
    www_bslib_components,
    type = "file",
    recurse = TRUE,
    regexp = "\\.(min\\.|css)",
    invert = TRUE
  )
)

# ------------------------------------------------------------------------------
message("Copy htmltools - fill")
# Copy over htmltools's fill directory
copy_from_pkg("htmltools", "fill", www_htmltools_fill)

# ------------------------------------------------------------------------------
message("Cleanup shiny www/shared")
# Don't need legacy (hopefully)
fs::dir_delete(fs::path(www_shared, "legacy"))
# Don't need dataTables (hopefully)
fs::dir_delete(fs::path(www_shared, "datatables"))
# Don't need sass files (hopefully)
fs::dir_delete(fs::path(www_shared, "shiny_scss"))

# jQuery will come in via bslib (below)
fs::file_delete(
  fs::dir_ls(www_shared, type = "file", regexp = "jquery")
)


# ------------------------------------------------------------------------------
message("Save ionRangeSlider dep")

# Upgrade to Bootstrap 5 by default
shiny_theme <- bslib::bs_theme(version = 5, preset = "shiny")
# Save iorange slider dep
# Get _dynamic_ ionrangeslider dep
ion_dep <- shiny:::ionRangeSliderDependencyCSS(shiny_theme)
ion_dep_css <- fs::path(ion_dep$src$file, ion_dep$stylesheet)
# Preset="shiny" additional ionRangeSlider rules
ion_preset_rules <- system.file("builtin", "bs5", "shiny", "ionrangeslider", "_rules.scss", package = "bslib")
ion_preset_compiled <-
  sass::sass_partial(
    readLines(ion_preset_rules),
    shiny_theme,
    write_attachments = FALSE,
    cache = FALSE
  )
# Append preset styles to the base ionRangeSlider CSS
cat(
  c("\n\n/* shiny preset styles */\n\n", ion_preset_compiled),
  file = ion_dep_css, sep = "\n", append = TRUE
)
if (inherits(ion_dep, "html_dependency")) {
  ion_dep <- list(ion_dep)
}
# Save to temp folder
temp_ion_dep_dir <- fs::path_temp("shiny-ion-range-slider")
fs::dir_create(temp_ion_dep_dir)
withr::with_options(
  list(htmltools.dir.version = FALSE),
  ignore <- lapply(ion_dep, htmltools::copyDependencyToDir, temp_ion_dep_dir)
)
# Overwrite css file
ion_dep_dir <- fs::path(www_shared, "ionrangeslider")
fs::file_move(
  fs::path(temp_ion_dep_dir, "ionRangeSlider", "ionRangeSlider.min.css"),
  fs::path(ion_dep_dir, "css", "ion.rangeSlider.css")
)
# Cleanup
fs::dir_delete(temp_ion_dep_dir)

# TODO - make a UI object and save its dependencies. Loop through the different UI elements of bslib and save them accordingly. Similar to shiny::input_slider? instead of reaching into the `:::`


message("Save bootstrap bundle")
# Save htmldeps
deps <- bslib::bs_theme_dependencies(shiny_theme)
withr::with_options(
  list(htmltools.dir.version = FALSE),
  ignore <- lapply(deps, function(dep) {
    if (dep$name %in% c("bslib-component-css", "bslib-component-js")) {
      return()
    }
    copyDependencyToDir(dep, www_shared)
  })
)
bs_ver <- names(bslib::versions())[bslib::versions() == "5"]
versions["bootstrap"] <- bs_ver
write_json(
  fs::path(www_shared, "bootstrap/_version.json"),
  list(
    shiny_version = shiny_version,
    bslib_version = bslib_version,
    htmltools_version = htmltools_version,
    bootstrap_version = bs_ver
  )
)

message("Reduce font files")
font_txt <- unlist(strsplit(readLines(fs::path(www_shared, "bootstrap/font.css")), ";"))
woff_files <- list.files(fs::path(www_shared, "bootstrap/fonts"), pattern = "\\.woff", full.names = TRUE)
ignored <- lapply(woff_files, function(woff_file) {
  file_name <- basename(woff_file)
  if (!any(grepl(file_name, font_txt, fixed = TRUE))) {
    unlink(woff_file)
  }
})

# ------------------------------------------------------------------------------
message("Render shiny.min.css with bs_theme()")



shiny_css_dep <- shiny:::shinyDependencyCSS(shiny_theme)
shiny_css_bslib <- fs::path(shiny_css_dep$src$file, shiny_css_dep$stylesheet)
shiny_css_shared <- fs::path(www_shared, "shiny.min.css")
writeLines(
  c(
    readLines(shiny_css_shared, n = 1), # keep header of original minified css
    readLines(shiny_css_bslib)
  ),
  con = shiny_css_shared
)

message("Render selectize.min.js with bs_theme()")
selectize_css_dep <- shiny:::selectizeDependencyFunc(shiny_theme)
selectize_css_bslib <- fs::path(
  selectize_css_dep$src$file,
  selectize_css_dep$stylesheet
)
selectize_shared <- fs::path(www_shared, "selectize", "css")
fs::file_delete(fs::path(selectize_shared, "selectize.bootstrap3.css"))
fs::file_copy(
  selectize_css_bslib,
  fs::path(selectize_shared, "selectize.min.css"),
  overwrite = TRUE
)

message("Render datepicker.min.css with bs_theme()")
datepicker_css_dep <- shiny:::datePickerCSS(shiny_theme)
datepicker_css_bslib <- fs::path(
  datepicker_css_dep$src$file,
  datepicker_css_dep$stylesheet
)
datepicker_shared <- fs::path(www_shared, "datepicker", "css")
fs::file_copy(
  datepicker_css_bslib,
  fs::path(datepicker_shared, "bootstrap-datepicker3.min.css"),
  overwrite = TRUE
)

# ------------------------------------------------------------------------------
message("Cleanup bootstrap bundle")
# This additional bs3compat HTMLDependency() only holds
# the JS shim for tab panel logic, which we don't need
# since we're generating BS5+ tab markup. Note, however,
# we still do have bs3compat's bundled CSS on the page, which
# comes in naturally via the bootstrap HTMLDependency()
fs::dir_delete(fs::path(www_shared, "bs3compat"))

# Remove non-minified or unused files
fs::file_delete(
  fs::path(www_shared, c(
    "datepicker/css/bootstrap-datepicker3.css",
    "datepicker/js/bootstrap-datepicker.js",
    "datepicker/scss",
    "ionrangeslider/js/ion.rangeSlider.js",
    "ionrangeslider/scss",
    "jquery/jquery-3.6.0.js",
    "jqueryui/jquery-ui.css",
    "jqueryui/jquery-ui.js",
    "jqueryui/jquery-ui.structure.css",
    "jqueryui/jquery-ui.structure.min.css",
    "jqueryui/jquery-ui.theme.css",
    "jqueryui/jquery-ui.theme.min.css",
    "selectize/accessibility/js/selectize-plugin-a11y.js",
    "selectize/js/selectize.js"
  ))
)


# ------------------------------------------------------------------------------
message("Save requirejs")
requirejs_version <- "2.3.6"
versions["requirejs"] <- requirejs_version
requirejs <- fs::path(www_shared, "requirejs")
fs::dir_create(requirejs)
download.file(
  paste0("https://cdnjs.cloudflare.com/ajax/libs/require.js/", requirejs_version, "/require.min.js"),
  fs::path(requirejs, "require.min.js"),
  quiet = TRUE
)

shims <- fs::path(getwd(), "scripts", "define-shims.js")

cat(
  "\n\n",
  paste(readLines(shims), collapse = "\n"),
  file = fs::path(requirejs, "require.min.js"),
  append = TRUE
)


# ------------------------------------------------------------------------------
message("Save _versions.py")
version_vars <- paste0(names(versions), " = ", "\"", versions, "\"\n", collapse = "")
version_all <- paste0(
  collapse = "",
  "__all__ = (\n",
  paste0("    \"", names(versions), "\",\n", collapse = ""),
  ")\n"
)
cat(
  file = fs::path(shiny_path, "_versions.py"),
  version_vars,
  "\n",
  version_all,
  sep = ""
)




# ------------------------------------------------------------------------------
message("Copy ./js deps via npm")

js_path <- fs::path_abs(fs::path(shiny_path, "..", "js"))
ignore <- system(
  paste0("cd ", js_path, " && npm install && npm run build"),
  intern = TRUE
)


# ------------------------------------------------------------------------------
message("Save spinner types")
spinner_types <- Sys.glob(file.path(www_shared, "busy-indicators", "spinners", "*.svg"))
spinner_types <- tools::file_path_sans_ext(basename(spinner_types))

template <- r"(# Generated by scripts/htmlDependencies.R: do not edit by hand

from __future__ import annotations

from typing import Literal

BusySpinnerType = Literal[
%s
])"

py_lines <- function(x) {
  x <- paste(sprintf('"%s"', x), collapse = ",\n    ")
  paste0("    ", x, ",")
}

writeLines(
  sprintf(template, py_lines(spinner_types)),
  file.path(shiny_path, "ui", "_busy_spinner_types.py")
)