Read and write defaults from/to files

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: fisdata
 Title: Query Data from the FIS Web Page
-Version: 0.2.0.9001
+Version: 0.2.0.9002
 Authors@R: 
   person("Stefan", "Lanz", , "slanz1137@gmail.com", role = c("aut", "cre"))
 Description: Query data from the web site of the International Ski and
@@ -28,17 +28,18 @@ Imports:
     rlang,
     cli,
     magrittr,
-    clipr,
     cachem,
+    jsonlite
+Suggests:
     ggplot2,
-    grid,
     scales,
     colorspace,
     ggnewscale,
     ggiraph,
+    grid,
     png,
-    jpeg
-Suggests: 
+    jpeg,
+    clipr,
     roxygen2,
     spelling,
     withr,

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export("%>%")
 export(browse_url)
 export(fd_def)
 export(get_athlete_image)
@@ -17,10 +18,13 @@ export(query_events)
 export(query_race)
 export(query_results)
 export(query_standings)
+export(read_fisdata_defaults)
 export(reset_fisdata_defaults)
 export(set_fisdata_defaults)
 export(show_url)
 export(summarise_results)
+export(write_current_fisdata_defaults)
+export(write_fisdata_defaults)
 importFrom(dplyr,"%>%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)

R/defaults.R

@@ -38,58 +38,20 @@ set_fisdata_defaults <- function(sector = NULL,
     }
   }
 
-  if (!is.null(sector)) {
-    use_sector <- find_code(sector, "sector")
-    options(fisdata_sector = use_sector)
-    alert_default("sector", use_sector, verbose)
-  }
-
-  if (!is.null(season)) {
-    season_int <- suppressWarnings(as.integer(season))
-    if (season == "") {
-      options(fisdata_season = "")
-      alert_default("season", season, verbose)
-    } else if (is.na(season_int) | season_int < 1950 |
-        season_int > lubridate::year(today()) + 1) {
-      cli::cli_warn("'{season}' is not a valid season.")
-    } else {
-      options(fisdata_season = as.character(season_int))
-      alert_default("season", season_int, verbose)
-    }
-  }
-
-  if (!is.null(gender)) {
-    use_gender <- standardise_gender(gender)
-    if (!use_gender %in% c("", "M", "W")) {
-      cli::cli_warn("'{gender}' is not a valid gender code.")
-    } else {
-      options(fisdata_gender = use_gender)
-      alert_default("gender", use_gender, verbose)
-    }
-  }
-
-  if (!is.null(category)) {
-    use_category <- find_code(category, "category")
-    options(fisdata_category = use_category)
-      alert_default("category", use_category, verbose)
-  }
-
-  if (!is.null(discipline)) {
-    # when matching the discipline, use the default value for the sector
-    # if set_fisdata_defaults has been called with a sector, it's value has
-    # already been set as the default such that it will also be used here
-    use_discipline <- find_code(discipline, "discipline",
-                                sector = fd_def("sector"))
-    options(fisdata_discipline = use_discipline)
-    alert_default("discipline", use_discipline, verbose)
-  }
-
-  if (!is.null(active_only)) {
-    if (!active_only %in% c(TRUE, FALSE)) {
-      cli::cli_warn("'{active_only}' is not valid for active_only.")
-    } else {
-      options(fisdata_active_only = active_only)
-      alert_default("active_only", active_only, verbose)
+  defs <- prepare_defaults(sector = sector,
+                           season = season,
+                           gender = gender,
+                           category = category,
+                           discipline = discipline,
+                           active_only = active_only)
+
+  for (name in names(defs)) {
+    value <- defs[[name]]
+    if (!is.null(value)) {
+      options(
+        magrittr::set_names(list(value), paste0("fisdata_", name))
+      )
+      alert_default(name, verbose)
     }
   }
 }
@@ -127,13 +89,165 @@ fd_def <- function(name = c("sector", "season", "gender",
 }
 
 
+#' Read and Write Defaults from a JSON File
+#'
+#' Default settings can be written to a JSON file and read again from
+#' this file. If the file `.fisdata.json` exists in the user's home
+#' it is read automatically when fisdata is loaded in an interactive
+#' session (see 'Details' for how to configure this behaviour).
+#' 
+#' @param file name of the JSON file to read or write
+#' @param overwrite should an existing file be overwritten?
+#' @inheritParams query_athletes
+#' @inheritParams query_results
+#' 
+#' @details
+#' When fisdata is loaded in an interactive session, it tries to load defaults
+#' from a file `fisdata.json`. You can use another file by setting the environment
+#' variable `FISDATA_DEFAULTS_FILE` to the path to this file before loading
+#' fisdata. To do this once, you can use [Sys.setenv()], to configure R to always
+#' load a different file, you can set `FISDATA_DEFAULTS_FILE` in your `.Renviron`
+#' file. 
+#' 
+#' @returns
+#' `write_fisdata_defaults()` and `write_current_fisdata_defaults()` return the json-string that
+#' was written to the file (invisibly). `read_fisdata_defaults()` returns the default
+#' values that were read as a tibble (invisibly).
+#' 
+#' @export
+
+write_fisdata_defaults <- function(file = "~/.fisdata.json",
+                                   overwrite = FALSE,
+                                   sector = "",
+                                   season = "",
+                                   gender = "",
+                                   category = "",
+                                   discipline = "",
+                                   active_only = FALSE) {
+  defs <- prepare_defaults(sector = sector,
+                           season = season,
+                           gender = gender,
+                           category = category,
+                           discipline = discipline,
+                           active_only = active_only)
+  write_fisdata_defaults_(defs, file, overwrite)
+}
+
+
+#' @rdname write_fisdata_defaults
+#' @export
+
+write_current_fisdata_defaults <- function(file = "~/.fisdata.json",
+                                           overwrite = FALSE) {
+  write_fisdata_defaults_(get_fisdata_defaults(), file, overwrite)
+}
+
+
+# helper function that writes a list or tibble of defaults to a JSON file
+write_fisdata_defaults_ <- function(defaults, 
+                                    file = "~/.fisdata.json",
+                                    overwrite = FALSE,
+                                    error_call = rlang::caller_env()) {
+
+  if (file.exists(file) && !overwrite) {
+    cli::cli_abort("The file {file} exists. Use `overwrite = TRUE` to overwrite it.")
+  }
+
+  # don't write NULL for any default to the file
+  def_is_null <- purrr::map_lgl(defaults, is.null)
+  if (any(def_is_null)) {
+    null_names <- names(def_is_null)[def_is_null]
+    cli::cli_abort(
+      c(
+        "!" = "Defaults must no be NULL when writing to a json file.", 
+        "i" = "The following value{?s} {?is/are} NULL: {null_names}."
+      ),
+      call = error_call
+    )
+  }
+
+  json <- defaults %>%
+    # convert to a list to avoid having an unnecessary length-one array
+    as.list() %>% 
+    jsonlite::toJSON(pretty = TRUE, auto_unbox = TRUE)
+
+  writeLines(json, file)
+
+  invisible(json)
+}
+
+
+#' @param apply should the defaults be applied? 
+#' @param verbose should the function create output. This defaults
+#'  to `TRUE` in interactive sessions or when `apply` is `FALSE`.
+#' @rdname write_fisdata_defaults
+#' 
+#' @export
+
+read_fisdata_defaults <- function(file = "~/.fisdata.json", 
+                          apply = TRUE,
+                          verbose = !apply || interactive()) {
+
+  if (!file.exists(file)) {
+    cli::cli_abort("The file {file} does not exist.")
+  }
+
+  raw <- purrr::possibly(jsonlite::fromJSON)(file)
+  if (is.null(raw)) {
+    cli::cli_abort("Failed to parse file {file} as JSON.")
+  }
+
+  # check that all the expected values are present.
+  expected <- c("sector", "season", "gender", "category", "discipline", "active_only")
+  is_present <- expected %in% names(raw)
+  if (any(!is_present)) {
+    cli::cli_abort("Some defaults have no value set: {expected[!is_present]}")
+  }
+
+  # run the contents of the file through prepare_defs() to check
+  # that the values are valid.
+  error_call = rlang::current_call()
+  defs <- tryCatch(
+    do.call(prepare_defaults, raw[names(raw) %in% expected]),
+    error = function(e) {
+      cli::cli_abort(c("The contents of file {file} are not valid.",
+                       "i" = "Error message: {e$message}"),
+                      call = error_call)
+    },
+    warning = function(w) {
+      cli::cli_abort(c("The contents of file {file} are not valid.",
+                       "i" = "Warning message: {w$message}"),
+                      call = error_call)
+    }
+  )
+
+  # if verbose and the default are not to be applied, print them here
+  # in case the defaults are applied, set_fisdata_defaults() will create output.
+  if (verbose && !apply) {
+    cli::cli_alert_info("The file {file} contains the following defaults:")
+    print(dplyr::as_tibble(defs))
+  }
+
+  # if requested, apply the defaults
+  if (apply) {
+    do.call(set_fisdata_defaults, c(defs, list(verbose = verbose)))
+  }
+
+  invisible(dplyr::as_tibble(defs))
+}
+
+
 # issue a message describing the default value that has been set.
-alert_default <- function(type, value, verbose) {
+# The function must be called AFTER setting the default.
+alert_default <- function(type, verbose) {
 
   if (!verbose) {
     return(NULL)
   }
 
+  # get the default value that has been set
+  value <- fd_def(type)
+
   # if the value is an empty string, issue a message saying this
   if (value == "") {
     cli::cli_alert_info("The default for '{type}' has been set to ''.")
@@ -151,3 +265,66 @@ alert_default <- function(type, value, verbose) {
     }
   }
 }
+
+
+# prepare inputs for default values
+prepare_defaults <- function(sector = NULL,
+                             season = NULL,
+                             gender = NULL,
+                             category = NULL,
+                             discipline = NULL,
+                             active_only = NULL) {
+
+  if (!is.null(sector)) {
+    sector <- find_code(sector, "sector")
+  }
+
+  if (!is.null(season)) {
+    season_int <- suppressWarnings(as.integer(season))
+    if (season == "") {
+      season <- ""
+    } else if (is.na(season_int) | season_int < 1950 |
+        season_int > lubridate::year(today()) + 1) {
+      cli::cli_warn("'{season}' is not a valid season.")
+      season <- NULL
+    } else {
+      season <- as.character(season_int)
+    }
+  }
+
+  if (!is.null(gender)) {
+    std_gender <- standardise_gender(gender)
+    if (!std_gender %in% c("", "M", "W")) {
+      cli::cli_warn("'{gender}' is not a valid gender code.")
+      gender <- NULL
+    } else {
+      gender <- std_gender
+    }
+  }
+
+  if (!is.null(category)) {
+    category <- find_code(category, "category")
+  }
+
+  if (!is.null(discipline)) {
+    # discipline depends on sector. If a sector has been passed to this
+    # function, use it. Otherwise, use the current default.
+    discipline_sector <- if (!is.null(sector)) sector else fd_def("sector")
+    discipline <- find_code(discipline, "discipline",
+                            sector = discipline_sector)
+  }
+
+  if (!is.null(active_only)) {
+    if (!active_only %in% c(TRUE, FALSE)) {
+      cli::cli_warn("'{active_only}' is not valid for active_only.")
+      active_only <- NULL
+    }
+  }
+
+  list(sector = sector,
+       season = season,
+       gender = gender,
+       category = category,
+       discipline = discipline,
+       active_only = active_only)
+}

R/fisdata-package.R

@@ -27,6 +27,23 @@ cache <- new.env()
 
   # set options to default values
   reset_fisdata_defaults()
+
+  # determine the file that defaults should be read from. The file name is
+  # taken from the environment variable FISDATA_DEFAULTS_FILE. If the variable
+  # is unset, fall back to "~/.fisdata.json".
+  defaults_file <- Sys.getenv("FISDATA_DEFAULTS_FILE", "~/.fisdata.json")
+
+  # if the file exists and R is running interactively,
+  # read defaults from it.
+  if (interactive() && file.exists(defaults_file)) {
+    cli::cli_alert_info("Reading default values from {defaults_file} ...")
+    read_fisdata_defaults(defaults_file, verbose = TRUE)
+  }
 }
 
 # nocov end
+
+
+# reexport %>% for convenience
+#' @export
+dplyr::`%>%`