scripts/build.R

In ropenscilabs/colorpiler: Provides community-driven color palettes

#!/usr/bin/env Rscript

vlapply <- function(X, FUN, ...) {
  vapply(X, FUN, logical(1), ...)
}
vcapply <- function(X, FUN, ...) {
  vapply(X, FUN, character(1), ...)
}

generate_create_palette <- function(schema, dest) {
  d <- jsonlite::fromJSON(schema)

  ## There's a bit of a faff in here trying to get the arguments into
  ## the correct order for a sane function definition.
  args <- names(d$properties)
  req <- vlapply(d$properties, function(x) isTRUE(x$required))

  default <- ifelse(req, "", "NULL")
  default[["date"]] <- "Sys.Date()"
  req <- !nzchar(default)

  args <- c(args[req], args[!req])
  req <- req[args]
  default <- default[args]

  unbox <- !vlapply(d$properties[args], function(x) identical(x$type, "array"))
  desc <- vcapply(d$properties[args], "[[", "description")


  fmt <- "# NOTE: this is autogenerated -- do not edit by hand
#' create palette for colorpile
#'
#' @title Create palette for colorpile
%s
#'
#' @export
create_palette <- function(%s) {
  palette_data <- drop_null(list(%s))
  palette_str <- jsonlite::toJSON(palette_data, pretty = TRUE)
  write(palette_str, file = sprintf(\"%%s.json\", name))
}"

  parms <- paste(sprintf("#' @param %s %s", names(desc), unname(desc)),
                 collapse="\n")
  fn_args <- paste(unname(ifelse(!nzchar(default), args,
                                 sprintf("%s=%s", args, default))),
                   collapse=", ")
  fn_list <- paste(unname(sprintf(
    ifelse(unbox, "%s = jsonlite::unbox(%s)", "%s = %s"),
    args, args)), collapse=", ")
  txt <- sprintf(fmt, parms, fn_args, fn_list)
  str <- formatR::tidy_source(text=txt, width.cutoff=50)$text.tidy
  writeLines(gsub("\\s\n", "\n", str), dest)
}

dir.create("inst/schemas", FALSE, TRUE)
curl::curl_download("https://raw.githubusercontent.com/ropenscilabs/colorpile/master/schemas/group.json", "inst/schemas/group.json")
curl::curl_download("https://raw.githubusercontent.com/ropenscilabs/colorpile/master/schemas/palette.json", "inst/schemas/palette.json")
generate_create_palette("inst/schemas/palette.json", "R/create_palette.R")