diff --git a/.gitignore b/.gitignore index 13a64cb..cd82e17 100644 --- a/.gitignore +++ b/.gitignore @@ -2,7 +2,6 @@ .Rhistory .RData inst/doc -docs *.xlsx sqlnet.log /doc/ diff --git a/NAMESPACE b/NAMESPACE index c01f64f..07ec504 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -56,6 +56,7 @@ importFrom(methods,is) importFrom(openxlsx,addStyle) importFrom(openxlsx,makeHyperlinkString) importFrom(openxlsx,writeFormula) +importFrom(purrr,reduce2) importFrom(rlang,":=") importFrom(rlang,.data) importFrom(scales,manual_pal) diff --git a/R/insert_index_sheet.R b/R/insert_index_sheet.R index 2a4c228..b018599 100644 --- a/R/insert_index_sheet.R +++ b/R/insert_index_sheet.R @@ -34,7 +34,7 @@ insert_index_sheet <- function( 3:18, style_subtitle(), "source") ### Table of content caption - writeText(wb, sheetname, getOption("statR_index_title"), + writeText(wb, sheetname, getOption("statR_index_toc_title"), namedRegionLastRow(wb, sheetname, "source") + 3, 3, style_indextitle(), "toc") diff --git a/R/output_xlsx.R b/R/output_xlsx.R index eda003d..ad83f13 100644 --- a/R/output_xlsx.R +++ b/R/output_xlsx.R @@ -37,6 +37,7 @@ #' in inches (1 inch = 2.54 cm), or a list of the same length as `datasets` #' @param index_title Title to be put on the index sheet. #' @param index_source Source to be shown below the index title. +#' @param index_toc_title Title shown above the table of content. #' @param metadata_sheet A list with named elements 'title', 'source', and 'text'. #' Intended for conveying long-form information. Default is NULL, not included. #' @param overwrite Overwrites the existing excel files with the same file name. @@ -124,12 +125,12 @@ datasetsXLSX <- function( file, datasets, sheetname = NULL, title = NULL, source = NULL, metadata = NULL, grouplines = NULL, group_names = NULL, plot_width = NULL, - plot_height = NULL, index_title = NA, index_source = NA, logo = NA, - contactdetails = NA, homepage = NA, openinghours = NA, auftrag_id = NULL, + plot_height = NULL, index_title = NA, index_source = NA, index_toc_title = NA, + logo = NA, contactdetails = NA, homepage = NA, openinghours = NA, auftrag_id = NULL, author = "user", metadata_sheet = NULL, overwrite = TRUE, config = "default") { - get_user_config(config, c(index_title, index_source, logo, + get_user_config(config, c(index_title, index_source, index_toc_title, logo, contactdetails, homepage, openinghours)) # "Optional" input arguments @@ -178,7 +179,7 @@ datasetsXLSX <- function( sheetname <- verifyInputSheetnames(sheetname) wb <- openxlsx::createWorkbook() - insert_index_sheet(wb, sheetname = "Index", title = index_title, + insert_index_sheet(wb, sheetname = "Index", title = getOption("statR_index_title"), auftrag_id = auftrag_id, logo = logo, contactdetails = getOption("statR_contactdetails"), homepage = getOption("statR_homepage"), diff --git a/R/user_config.R b/R/user_config.R index e388b9a..2e25573 100644 --- a/R/user_config.R +++ b/R/user_config.R @@ -21,9 +21,7 @@ initUserConfigStore <- function(store_path = "~/.config/R/statR") { } - addUserConfig(store_path = store_path) - } @@ -47,12 +45,16 @@ addUserConfig <- function(name = "default", path = NULL, store_path = "~/.config/R/statR") { store_file <- file.path(store_path, "statR_profile.csv") + configs <- readUserConfigStore(store_path) - if(!file.exists(store_file)){ + lib_path <- dirname(dirname(system.file(package = "statR"))) + current_path <- configs[configs$config_name == name, "config_path"] + default_path <- system.file("extdata/config/default.yaml", package = "statR") + + if (!file.exists(store_file)){ initUserConfigStore(store_path) } - configs <- readUserConfigStore(store_path) if (is.null(path) && name != "default") { stop("Kein Pfad zu config file angegeben") } @@ -62,22 +64,30 @@ addUserConfig <- function(name = "default", path = NULL, } if (name == "default" && is.null(path)) { - path <- system.file("extdata/config/default.yaml", package = "statR") + + if (length(current_path) == 0) { + path <- default_path + + } else if (grepl(lib_path, current_path)) { + curr_vers <- paste0(version$major, ".", gsub(".[0-9]+$", "", version$minor)) + path <- gsub("[0-9.]+/statR/extdata/config/", + paste0(curr_vers, "/", "statR/extdata/config/"), current_path) + updateUserConfig("default", path, store_path) + } } - if (name == "default" & "default" %in% configs$config_name){ + if (name == "default" && "default" %in% configs$config_name){ return("Alles bereit") } if (name %in% configs$config_name){ - if (configs[configs$config_name == name, "config_path"] == path){ + if (current_path == path){ stop("Diese Konfiguration existiert bereits! Verwende die ", "updateUserConfig()-Funktion um den Pfad zu aendern.") } else { - stop("Der Konfigurationsname: ", - configs[configs$config_name == name, "config_name"], + stop("Der Konfigurationsname: ", name, " existiert bereits. Setze einen neuen Pfad mit der ", "updateUserConfig()-Funktion") } @@ -95,18 +105,22 @@ addUserConfig <- function(name = "default", path = NULL, #' @inheritParams initUserConfigStore #' @export updateUserConfig <- function(name, path, store_path = "~/.config/R/statR"){ - if (!is.null(path) && !file.exists(path)) { - stop("No config file found at ", path) - } configs <- readUserConfigStore(store_path) - configs[configs$config_name == name, "config_path"] <- path + if (name == "default") { + curr_vers <- paste0(version$major, ".", gsub(".[0-9]+$", "", version$minor)) + path <- gsub("[0-9.]+/statR/extdata/config/", + paste0(curr_vers, "/", "statR/extdata/config/"), path) + } - out <- configs + if (!is.null(path) && !file.exists(path)) { + stop("No config file found at ", path) + } + configs[configs$config_name == name, "config_path"] <- path store_file <- file.path(store_path, "statR_profile.csv") - write.table(out, store_file, row.names = FALSE, sep = ",") + write.table(configs, store_file, row.names = FALSE, sep = ",") } #' Loeschen eines Konfigurations-Eintrages @@ -145,39 +159,35 @@ readUserConfig <- function(name = "default", store_path = "~/.config/R/statR") { } - - - - +#' Extrahiert Defaults aus User Config und ersetzt Werte +#' @param config Name der User Config +#' @param params_to_check Vektor mit Parametern +#' @importFrom purrr reduce2 +#' @keywords internal get_user_config <- function(config, params_to_check){ initUserConfigStore() - user_config <- readUserConfig(config) - out <- unlist(user_config, recursive = FALSE) - names(out) <- gsub(".*\\.", "", names(out)) - config_name <- tail(paste0("statR_", substitute(params_to_check)), -1) - - - user_config <- purrr::reduce2(params_to_check, config_name, ~ replace_by_parameter(..1, ..2, ..3), .init = out) - + user_config <- purrr::reduce2(params_to_check, config_name, + ~ replace_by_parameter(..1, ..2, ..3), + .init = out) options(user_config) - - if(!("statR_contactdetails" %in% names(user_config))){ + if (!("statR_contactdetails" %in% names(user_config))){ user_config$statR_contactdetails <- inputHelperContactInfo() - options(user_config) } - - - } +#' Ersetzt Werte in aktiver Config mit gesetzten Parametern +#' @param yaml_file Inhalt der aktiven Config +#' @param parameter Wert des Parameters +#' @param config_param_name Name des Parameters +#' @keywords internal replace_by_parameter <- function(yaml_file, parameter, config_param_name) { if (!is.na(parameter)) { @@ -185,15 +195,9 @@ replace_by_parameter <- function(yaml_file, parameter, config_param_name) { yaml_file[config_param_name] <- parameter } else { yaml_file$add <- parameter - new_names <- c(head(names(yaml_file),-1), config_param_name) - names(yaml_file) <- new_names } - } - return(yaml_file) } - - diff --git a/docs/.nojekyll b/docs/.nojekyll new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/docs/.nojekyll @@ -0,0 +1 @@ + diff --git a/docs/404.html b/docs/404.html index c8012a1..d172469 100644 --- a/docs/404.html +++ b/docs/404.html @@ -50,6 +50,9 @@