readr_yaml_roundtrip.R

order_by_name <- function(x) {
  x[order(names(x))]
}
type_to_collector <- function(type) {
  # Code adopted from `readr:::collector_find()`
  get(paste0("col_", type), envir = asNamespace("readr"))
}
specs_to_list <- function(specs) {
  if (inherits(specs, "col_spec")) {
    specs <- specs$cols
  }
  specs_list <- lapply(specs, function(x) {
    type <- gsub("collector_", "", class(x)[1])
    if (type == "factor") {
      x[c("ordered", "include_na")] <- NULL
    }
    modifyList(list(type = type), x)
  })
  order_by_name(specs_list)
}
specs_from_list <- function(specs_list) {
  lapply(specs_list, function(x) {
    collector <- type_to_collector(x$type)
    do.call(collector, x[names(x) != "type"])
  })
}

read_parsed_specs <- function(file) {
  specs_from_list(yaml::read_yaml(file))
}
update_yaml_list <- function(old, new, overwrite = TRUE) {
  overlap <- names(new)[names(new) %in% names(old)]
  if (length(overlap) > 0) {
    different <- names(setdiff(new[overlap], old[overlap]))
  } else {
    return(order_by_name(c(new, old)))
  }
  if (length(different) > 0) {
    diff_vars <- paste(different, collapse = ", ")
    if (overwrite) {
      message("Overwriting: ", diff_vars)
    } else {
      stop("Set `overwrite = TRUE` to update: ", diff_vars)
    }
  }
  updated <- order_by_name(modifyList(old, new))
  updated
}
write_parsed_specs <- function(parsed_specs, file, overwrite = TRUE) {
  message("Writing parsed specs to ", file)
  specs_list <- specs_to_list(parsed_specs)
  cat(yaml::as.yaml(specs_list))
  if (file.exists(file)) {
    existing <- yaml::read_yaml(file)
    specs_list <- update_yaml_list(existing, specs_list)
  }
  yaml::write_yaml(specs_list, file)
}