tools/wasm/check-pages-site.R

In OpenSpecy: Analyze, Process, Identify, and Share Raman and (FT)IR Spectra

#!/usr/bin/env Rscript

check_pages_site <- function(site_dir, max_bytes = 950 * 1024^2,
                             shell_only = FALSE) {
  fail <- function(...) stop(paste0(...), call. = FALSE)
  need_file <- function(path) {
    if (!file.exists(path)) fail("Missing expected Pages file: ", path)
  }
  need_nonempty_file <- function(path) {
    need_file(path)
    bytes <- file.info(path)$size
    if (!is.finite(bytes) || bytes <= 0) {
      fail("Expected a non-empty Pages file: ", path)
    }
  }
  read_text <- function(path) {
    paste(readLines(path, warn = FALSE), collapse = "\n")
  }
  need_markers <- function(text, markers, label) {
    missing <- markers[
      !vapply(markers, grepl, logical(1), x = text, fixed = TRUE)
    ]
    if (length(missing)) {
      fail(label, " is missing: ", paste(missing, collapse = ", "), ".")
    }
  }

  root_index <- file.path(site_dir, "index.html")
  app_index <- file.path(site_dir, "app", "index.html")
  pkgdown_index <- file.path(site_dir, "pkgdown", "index.html")
  landing_css <- file.path(site_dir, "assets", "site.css")
  landing_js <- file.path(site_dir, "assets", "site.js")
  robots <- file.path(site_dir, "robots.txt")
  sitemap <- file.path(site_dir, "sitemap.xml")
  need_file(root_index)
  need_file(app_index)
  need_file(pkgdown_index)
  need_nonempty_file(landing_css)
  need_nonempty_file(landing_js)
  need_nonempty_file(robots)
  need_nonempty_file(sitemap)

  if (dir.exists(file.path(site_dir, "wasm"))) {
    fail("The public Pages artifact must not contain a wasm repository tree.")
  }

  root_text <- read_text(root_index)
  if (grepl("Generated by pkgdown", root_text, fixed = TRUE)) {
    fail("The Pages root must be the static landing page, not pkgdown output.")
  }
  need_markers(root_text, c(
    "data-openspecy-embed",
    "id=\"openspecy-app-frame\"",
    "src=\"app/\"",
    "href=\"pkgdown/",
    "<meta name=\"description\"",
    "<link rel=\"canonical\"",
    "application/ld+json",
    "property=\"og:title\"",
    "<main"
  ), "The static landing page")
  if (!grepl("<title>[^<]*OpenSpecy", root_text, ignore.case = TRUE)) {
    fail("The static landing page title must identify OpenSpecy.")
  }
  if (grepl("src=\"/app/", root_text, fixed = TRUE) ||
      grepl("href=\"/pkgdown/", root_text, fixed = TRUE)) {
    fail("Landing routes must remain relative for fork-safe GitHub Pages hosting.")
  }
  need_markers(read_text(robots), c(
    "User-agent: *",
    "Sitemap: https://"
  ), "robots.txt")
  need_markers(read_text(sitemap), c(
    "<urlset",
    "<loc>https://",
    "/app/</loc>",
    "/pkgdown/</loc>"
  ), "sitemap.xml")
  embed_pos <- regexpr("data-openspecy-embed", root_text, fixed = TRUE)[[1]]
  frame_pos <- regexpr("id=\"openspecy-app-frame\"", root_text,
                       fixed = TRUE)[[1]]
  source_positions <- gregexpr('class="sourceCode"', root_text,
                               fixed = TRUE)[[1]]
  if (any(source_positions > embed_pos & source_positions < frame_pos)) {
    fail("The embedded app markup was rendered as a source-code block.")
  }

  pkgdown_text <- read_text(pkgdown_index)
  if (!grepl("Generated by pkgdown", pkgdown_text, fixed = TRUE)) {
    fail("The /pkgdown/ route does not look like generated pkgdown output.")
  }
  if (grepl("data-openspecy-embed", pkgdown_text, fixed = TRUE) ||
      grepl("id=\"openspecy-app-frame\"", pkgdown_text, fixed = TRUE)) {
    fail("The /pkgdown/ homepage must not duplicate the landing-page app embed.")
  }

  app_text <- read_text(app_index)
  placeholder <- grepl("data-openspecy-app-placeholder", app_text,
                       fixed = TRUE)
  if (isTRUE(shell_only)) {
    if (!placeholder) {
      fail("Shell-only validation requires the explicit ",
           "data-openspecy-app-placeholder marker under /app/.")
    }
    if (grepl("runExportedApp", app_text, fixed = TRUE)) {
      fail("Shell-only validation received a Shinylive export; run the strict ",
           "action-equivalent check instead.")
    }
  } else {
    if (placeholder) {
      fail("Strict validation rejects the shell-only /app/ placeholder.")
    }
    if (!grepl("runExportedApp", app_text, fixed = TRUE)) {
      fail("The /app/ route does not look like a Shinylive export.")
    }
  }

  files <- list.files(site_dir, recursive = TRUE, full.names = TRUE,
                      all.files = TRUE, no.. = TRUE)
  bytes <- sum(file.info(files)$size, na.rm = TRUE)
  if (!is.finite(bytes) || bytes >= max_bytes) {
    fail("The assembled Pages site is too large: ", bytes,
         " bytes (limit ", max_bytes, ").")
  }

  label <- if (isTRUE(shell_only)) {
    "Pages shell check passed (NOT action-equivalent)"
  } else {
    "Pages site check passed"
  }
  cat(label, ": ", normalizePath(
    site_dir, winslash = "/", mustWork = FALSE
  ), " (", bytes, " bytes)\n", sep = "")
  invisible(bytes)
}

if (sys.nframe() == 0L) {
  args <- commandArgs(trailingOnly = TRUE)
  shell_only <- "--shell-only" %in% args
  paths <- args[args != "--shell-only"]
  if (length(paths) > 1L) {
    stop("Usage: check-pages-site.R [site-dir] [--shell-only]", call. = FALSE)
  }
  site_dir <- if (length(paths)) paths[[1]] else "_site"
  check_pages_site(site_dir, shell_only = shell_only)
}