diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 4c6b03f059c9ace7e0940bf5647166dbd4944f9e..8fe16fa6a505467f630faacc54c205a5bf22ea05 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -19,7 +19,7 @@ before_script: - mkdir -p $R_LIBS_USER - echo "R_LIBS='$R_LIBS_USER'" > .Renviron - R -q -e 'if (!require(remotes)) install.packages(c("remotes", "testthat"))' - - R -q -e 'remotes::install_deps(dep = T)' + - R -q -e 'devtools::install(dependencies = TRUE)' test_all: stage: checks @@ -39,7 +39,6 @@ pages: rules: - if: $CI_COMMIT_REF_NAME == $CI_DEFAULT_BRANCH script: - - R -q -e 'devtools::install(dependencies = TRUE)' - R -q -e 'fairify::build_site()' artifacts: paths: diff --git a/DESCRIPTION b/DESCRIPTION index bcb3e4c2348b96c6eb3b5673ad925bfd026dc8aa..ea0976f590461a34ca5d42f1ace12f020f538d4c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,7 +16,6 @@ Imports: dplyr, fs, gert, - here, httr, jsonlite, magrittr, @@ -25,8 +24,10 @@ Imports: readr, rlang, stringr, + this.path, urltools, usethis, + xfun, yaml, zlib Suggests: diff --git a/NAMESPACE b/NAMESPACE index 452ab8ef47caefa3dacedc87720f51f7c6a53bfd..ba18bafeca08cb021a95d8f1de90cb5e01e936e2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,7 +18,9 @@ export(mermaid_gen_link) export(pkg_sys) export(purge_string) export(render_report) +export(render_report_setup) export(render_reports) +export(source_template_setup) export(updateMermaid) export(update_fairify) import(utils) diff --git a/R/add_report.R b/R/add_report.R index b7719815d1c0d26b2ead08cda594ea4aefa1e5db..a71d30a3e84a1f109998cf506be86da8e7d0f9d7 100644 --- a/R/add_report.R +++ b/R/add_report.R @@ -74,11 +74,12 @@ add_report <- function(name, writeLines(tex_content, file.path(destpath, sprintf("%s.tex", x))) }) # Setting template dependency - writeLines(template, file.path(destpath, ".template_dependencies")) + yaml::write_yaml(list(template = template), + file.path(destpath, "_fairify.yml")) # Setting the setup R script - cat(NULL, file = file.path(destpath, ".here")) writeLines( - c(sprintf("source(here::here(\"templates/%s/setup.R\"))\n", template_location[2]), + c("# Fairify configuration: don't change the following line", + "fairify::render_report_setup(this.path::this.dir())", "# pkgload::load_all() # Uncomment to load current fairyfied project code and data\n", "# Add your own settings below to append or overwrite template settings"), file.path(destpath, "setup.R") @@ -111,12 +112,12 @@ write_output_yml <- function(path) { get_template_dependencies <- function(path) { dep_chain <- NULL i <- 0 - while(file.exists(file.path(path, ".template_dependencies"))) { - dep_chain <- rbind(dep_chain, - data.frame(path = unname(path), - template = readLines( - file.path(path, ".template_dependencies") - ))) + while (file.exists(file.path(path, "_fairify.yml"))) { + template <- yaml::read_yaml(file.path(path, "_fairify.yml"))$template + dep_chain <- rbind( + dep_chain, + data.frame(path = unname(path), template = template) + ) i <- i + 1 path <- get_template_location(dep_chain$template[i])["path"] } diff --git a/R/getDataPath.R b/R/getDataPath.R index 06507121fb9e94036b0851bdb55283f9c62eeabe..6bd9439506bcf5874cdf786c707062a5375cf823 100644 --- a/R/getDataPath.R +++ b/R/getDataPath.R @@ -31,6 +31,14 @@ getDataPath <- function(path, cfg, root = cfg$data[[cfg$data$mode]], cache) { + if (missing(cfg) || missing(cache)) { + # fairify::getDataPath is called directly, we must + # find the fairified package and call its getDataPath instead + pkg <- findFairifiedPackage() + if (!is.null(pkg)) { + return(get("getDataPath", pos = pkg)(path, ..., use_cache = use_cache, root = root)) + } + } path <- file.path(path, ...) stopifnot(is.character(path), length(path) == 1) diff --git a/R/loadConfig.R b/R/loadConfig.R index c06bc098021be2dd8d8040570df291ce9dcabc73..ab804440434cc0459b1f1b8d9b8fb2bf26012e0f 100644 --- a/R/loadConfig.R +++ b/R/loadConfig.R @@ -6,27 +6,44 @@ #' User file configuration (by default the `config.yml` file in the working #' directory) can overwrite items of the default configuration (See examples). #' -#' @param userFile location of the user config YML file +#' @param userFile location of the user config YML file (Use NULL or empty character to ignore) #' @param pathDefaultCfg The location of the default configuration (located in "inst/config.yml" of the package by default) #' #' @return A configuration as it is returned by [config::get] #' @export #' loadConfig <- function(userFile = "config.yml", pathDefaultCfg) { - if (userFile == basename(userFile)) { - # Search in package sub folders - pkg_path <- pkgload::pkg_path() - current_path <- getwd() - repeat { - userFile <- file.path(current_path, basename(userFile)) - if (file.exists(userFile) || current_path == pkg_path) break - current_path <- dirname(current_path) + if (missing(pathDefaultCfg)) { + # fairify::loadConfig is called directly, we must + # find the fairified package and set its default config folder + pkg <- findFairifiedPackage() + if (!is.null(pkg)) { + pathDefaultCfg <- system.file("config.yml", package = sub("^package:", "", pkg)) } } cfg <- config::get(file = pathDefaultCfg) - if (file.exists(userFile)) { - message("Read user configuration from: ", userFile) - cfg = config::merge(cfg,config::get(file = userFile)) + if (!is.null(userFile) && userFile != "") { + if (userFile == basename(userFile)) { + # Search in package sub folders + pkg_path <- tryCatch({ + pkgload::pkg_path() + }, + error = function(cond) { + warning("Project directory not found up to ", getwd()) + getwd() + }) + current_path <- getwd() + repeat { + userFile <- file.path(current_path, basename(userFile)) + if (file.exists(userFile) || current_path == pkg_path) + break + current_path <- dirname(current_path) + } + } + if (file.exists(userFile)) { + message("Read user configuration from: ", userFile) + cfg = config::merge(cfg, config::get(file = userFile)) + } } stopifnot(cfg$data$mode %in% c("local", "remote"), is.logical(cfg$data$write_results)) @@ -36,3 +53,21 @@ loadConfig <- function(userFile = "config.yml", pathDefaultCfg) { } cfg } + +allParents = function(env = globalenv(), result = list()) { + result = c(list(parent.env(env)), result) + if(!identical(result[[1]], emptyenv())) { + result <- allParents(result[[1]], result) + } + return(result) +} + +findFairifiedPackage <- function() { + att_pkgs <- search() + for (pkg in att_pkgs) { + if ("loadConfig" %in% ls(pos = pkg)) { + return(pkg) + } + } + return(NULL) +} diff --git a/R/render_report.R b/R/render_report.R index 531b57ee989fe949c0aba05b0c6d47b75ac32c2a..ad5cdf8d745b73599d0d5856cdb9201f72030d3b 100644 --- a/R/render_report.R +++ b/R/render_report.R @@ -8,56 +8,74 @@ render_report <- function(input, ...) { stopifnot(output_format %in% c("bookdown::gitbook", "bookdown::pdf_book")) + if (!file.exists(input)) { + stop("input path not found: ", input) + } + input_index <- "" + if (!dir.exists(input)) { + # The input is a file, we need the path to work in it + input <- dirname(input) + input_index <- basename(input) + } + if (clean_cache) { + clean_cache_report(input) + } + owd <- setwd(input) + on.exit({setwd(owd)}) + input <- getwd() + + add_before_chapter_script(input) if (output_format == "bookdown::pdf_book") { - if (!requireNamespace("tinytex", quietly = TRUE)) install.packages("tinytex") - if (dir.exists(input)) { - babel_lang <- yaml::read_yaml(file.path(input, "_bookdown.yml"))$babel_lang - if (!is.null(babel_lang)) { - tinytex_install_babel_language_support(babel_lang) - } + if (!requireNamespace("tinytex", quietly = TRUE)) + install.packages("tinytex") + babel_lang <- + yaml::read_yaml("_bookdown.yml")$babel_lang + if (!is.null(babel_lang)) { + tinytex_install_babel_language_support(babel_lang) } } message("output_format=", output_format) + writeLines("options(knitr.duplicate.label = 'allow')", ".Rprofile") + on.exit({ + unlink(file.path(input, c(".Rprofile", "templates")), + recursive = TRUE) + }) + args <- list( + input = file.path(input, input_index), + output_format = output_format, + output_dir = output_dir + ) + args <- c(args, list(...)) + xfun::Rscript_call( + fun = bookdown::render_book, + args = args + ) + invisible() +} + +#' @rdname render_reports +#' @export +render_report_setup <- function(input = getwd(), clean_cache = FALSE) { if (clean_cache) { - cache_dir <- list.files(path = input, - pattern = "_cache$", - include.dirs = TRUE, - full.names = TRUE) - unlink(cache_dir, recursive = TRUE) + clean_cache_report(input) } - on.exit({unlink(file.path(input, "templates"), recursive = TRUE)}) copy_templates(input) cfg_bookdown <- yaml::read_yaml(file.path(input, "_bookdown.yml")) unlink(file.path(input, paste0(cfg_bookdown$book_filename, ".*"))) - attached_packages <- (.packages()) - here:::do_refresh_here(input) - bookdown::render_book(input, - output_format = output_format, - output_dir = output_dir, - envir = new.env(), - ...) - # detach all packages used in the knit - sapply( - setdiff((.packages()), attached_packages), - function(x) detach(paste0("package:", x), - unload = TRUE, - character.only = TRUE)) - invisible() + options(knitr.duplicate.label = "allow") + template <- yaml::read_yaml(file.path(input, "_fairify.yml"))$template + source_template_setup(template) } copy_templates <- function(input) { - if (file.exists(input) && !dir.exists(input)) { - # Remove index.Rmd or whatever the file to get the folder - template <- basename(template) - } templates_path <- file.path(input, "templates") dir.create(templates_path, showWarnings = FALSE) template_dependencies <- get_template_dependencies(input) - templates <- lapply(template_dependencies, function(x) { - get_template_location(x) + templates <- lapply(template_dependencies, function(template) { + get_template_location(template) }) sapply(templates, function(template) { ok <- file.copy( @@ -96,3 +114,20 @@ get_template_location <- function(template, err_msg = "") { } return(c(template_location, path = template_folder)) } + +clean_cache_report <- function(input) { + cache_dir <- list.files(path = input, + pattern = "_cache$", + include.dirs = TRUE, + full.names = TRUE) + unlink(cache_dir, recursive = TRUE) +} + +add_before_chapter_script <- function(input) { + stopifnot(file.exists(file.path(input, "_bookdown.yml"))) + cfg_bd <- yaml::read_yaml(file.path(input, "_bookdown.yml")) + if (is.null(cfg_bd$before_chapter_script)) { + cfg_bd$before_chapter_script = "setup.R" + yaml::write_yaml(cfg_bd, file.path(input, "_bookdown.yml")) + } +} diff --git a/R/render_reports.R b/R/render_reports.R index 02245e016407936c7499238058c86a2f084c5862..6ec829469ca0bfa032e0b9aa55542d9035e310f1 100644 --- a/R/render_reports.R +++ b/R/render_reports.R @@ -1,5 +1,13 @@ #' Render fairify reports #' +#' `render_reports` renders all reports in the specified `report_dir` folder. +#' +#' `render_report` renders one report specified by its folder. +#' +#' `render_report_setup` prepare the report for rendering. This function should be +#' called in the first chunk of the report in order to make the templates available +#' for rendering. +#' #' @inheritParams list_reports #' @param publish_dir [character] rendering output path relatively to the report #' folder which is in format `"./reports/my_report"` @@ -18,9 +26,6 @@ render_reports <- function(reports_dir = file.path(pkgload::pkg_path(), "reports reports = list.dirs(reports_dir, full.names = FALSE, recursive = FALSE), publish_dir = file.path(dirname(reports_dir), "public/reports"), ...) { - - options(knitr.duplicate.label = 'allow') - message("folder list:") invisible(sapply(reports, message)) diff --git a/R/source_template_setup.R b/R/source_template_setup.R new file mode 100644 index 0000000000000000000000000000000000000000..1402f9e63fba701408c7b2c8bc926af23cad1d35 --- /dev/null +++ b/R/source_template_setup.R @@ -0,0 +1,15 @@ +#' Source the "setup.R" file of a template +#' +#' @param template Template name in the format `[package]:[name]` +#' +#' @return Nothing, used for side effect +#' @export +#' +#' @examples +#' # Launch basic configuration for reports +#' source_template_setup("fairify:basic") +#' +source_template_setup <- function(template) { + template_location <- get_template_location(template) + source(file.path(template_location["path"], "setup.R")) +} diff --git a/inst/bookdown_template/_bookdown.yml b/inst/bookdown_template/_bookdown.yml index 115c9cf219d09de570a4d5945d504ba6c43a5e9d..e3d1095614453ed1b8e42c44d4438b5599f4518f 100644 --- a/inst/bookdown_template/_bookdown.yml +++ b/inst/bookdown_template/_bookdown.yml @@ -1,3 +1,4 @@ book_filename: "report" delete_merged_file: true new_session: false +before_chapter_script: "setup.R" diff --git a/inst/bookdown_template/index.Rmd b/inst/bookdown_template/index.Rmd index 4c82d2d240c4e47d6fedbd6048b2f7865ddf1b14..250d5259476b56bca623658e4c264f7b176ad3d0 100644 --- a/inst/bookdown_template/index.Rmd +++ b/inst/bookdown_template/index.Rmd @@ -12,24 +12,42 @@ description: "" always_allow_html: true --- -```{r setup, include = FALSE, file = 'setup.R'} -``` +# Introduction to fairify report + +## Global options: the "setup.R" script + +Before each Rmd document composing the report the script "setup.R" located in the +same folder is executed. It prepares the report for knitting and loads global +configuration given by the templates. It can also be used by you to add your own +settings like [chunk options](https://yihui.org/knitr/options/). -Tout à partir d'ici peut être effacé. +## How to cite and handle a bibliography -# Titre du premier chapitre +See the [Citations section in the bookdown reference book](https://bookdown.org/yihui/bookdown/citations.html). -## Titre de la première section +An example of a citation in the text without brackets: @knuth84. -Avec une référence sans parenthèses: @knuth84. +An example in brackets [@knuth84]. -Mais on peut aussi y faire référence comme ceci [@knuth84] +## Equations -## Titre de la deuxième section +Excerpt from [Section 2.2.1 of bookdown reference book](https://bookdown.org/yihui/bookdown/markdown-extensions-by-bookdown.html#equations). + +To number and refer to equations\index{equation}\index{cross-reference}, put them in the equation environments and assign labels to them using the syntax `(\#eq:label)`, e.g., + +```latex +\begin{equation} + f\left(k\right) = \binom{n}{k} p^k\left(1-p\right)^{n-k} + (\#eq:binom) +\end{equation} +``` +It renders the equation below: +\begin{equation} +f\left(k\right)=\binom{n}{k}p^k\left(1-p\right)^{n-k} (\#eq:binom) +\end{equation} -# Nouveau chapitre +You may refer to it using `\@ref(eq:binom)`, e.g., see Equation \@ref(eq:binom). -Ceci est un nouveau chapitre. diff --git a/inst/templates/inrae/.template_dependencies b/inst/templates/inrae/.template_dependencies deleted file mode 100644 index 775b482bf5d87303ce8a7fe6f6474868aff61346..0000000000000000000000000000000000000000 --- a/inst/templates/inrae/.template_dependencies +++ /dev/null @@ -1 +0,0 @@ -fairify:basic diff --git a/inst/templates/inrae/_fairify.yml b/inst/templates/inrae/_fairify.yml new file mode 100644 index 0000000000000000000000000000000000000000..7ec33a2e5c0ed4fcd1f3d1bbd481fc124feda0cf --- /dev/null +++ b/inst/templates/inrae/_fairify.yml @@ -0,0 +1 @@ +template: fairify:basic diff --git a/inst/templates/inrae/setup.R b/inst/templates/inrae/setup.R index 67ef853bbb3c1f86a91629df7227c54e5b961871..ffbf1073b5389428a5a67790f0290f69c921de67 100644 --- a/inst/templates/inrae/setup.R +++ b/inst/templates/inrae/setup.R @@ -1 +1 @@ -source(here::here("templates/basic/setup.R")) +fairify::source_template_setup("fairify:basic") diff --git a/inst/templates/umr_geau/.template_dependencies b/inst/templates/umr_geau/.template_dependencies deleted file mode 100644 index 345bf387f8669dd11dae47aa5182e3de25b22211..0000000000000000000000000000000000000000 --- a/inst/templates/umr_geau/.template_dependencies +++ /dev/null @@ -1,2 +0,0 @@ -fairify:inrae -fairify:basic diff --git a/inst/templates/umr_geau/_fairify.yml b/inst/templates/umr_geau/_fairify.yml new file mode 100644 index 0000000000000000000000000000000000000000..8482bbe052150b080502ffe09d9e01ec4995a863 --- /dev/null +++ b/inst/templates/umr_geau/_fairify.yml @@ -0,0 +1 @@ +template: fairify:inrae diff --git a/inst/templates/umr_geau/setup.R b/inst/templates/umr_geau/setup.R index ce24fd2f9e550e956950f38540b45ac1e454bded..60faabf24c4dce6d6f948ff8d7b7234a7624e6df 100644 --- a/inst/templates/umr_geau/setup.R +++ b/inst/templates/umr_geau/setup.R @@ -1 +1 @@ -source(here::here("templates/inrae/setup.R")) +fairify::source_template_setup("fairify:inrae") diff --git a/man/loadConfig.Rd b/man/loadConfig.Rd index c44d4c6d852db7c246f9b262aab722f3b6fa7123..8fe528fcca3b39bb133edf54dd3968dad906d7fa 100644 --- a/man/loadConfig.Rd +++ b/man/loadConfig.Rd @@ -7,7 +7,7 @@ loadConfig(userFile = "config.yml", pathDefaultCfg) } \arguments{ -\item{userFile}{location of the user config YML file} +\item{userFile}{location of the user config YML file (Use NULL or empty character to ignore)} \item{pathDefaultCfg}{The location of the default configuration (located in "inst/config.yml" of the package by default)} } diff --git a/man/render_reports.Rd b/man/render_reports.Rd index 9ccc9a2c126e931624e926b83a8c294d2c2a773c..a9e4b3a1c2f595c7834066916e25d9732b9d35ab 100644 --- a/man/render_reports.Rd +++ b/man/render_reports.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/render_report.R, R/render_reports.R \name{render_report} \alias{render_report} +\alias{render_report_setup} \alias{render_reports} \title{Render fairify reports} \usage{ @@ -13,6 +14,8 @@ render_report( ... ) +render_report_setup(input = getwd(), clean_cache = FALSE) + render_reports( reports_dir = file.path(pkgload::pkg_path(), "reports"), reports = list.dirs(reports_dir, full.names = FALSE, recursive = FALSE), @@ -50,7 +53,14 @@ folder which is in format \code{"./reports/my_report"}} \code{NULL}, this function is used for side effect. } \description{ -Render fairify reports +\code{render_reports} renders all reports in the specified \code{report_dir} folder. +} +\details{ +\code{render_report} renders one report specified by its folder. + +\code{render_report_setup} prepare the report for rendering. This function should be +called in the first chunk of the report in order to make the templates available +for rendering. } \examples{ # Create a fairify project in a temporary folder diff --git a/man/source_template_setup.Rd b/man/source_template_setup.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c56a961245aa06f9f403b2d3cf78bdcd8dc32d53 --- /dev/null +++ b/man/source_template_setup.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/source_template_setup.R +\name{source_template_setup} +\alias{source_template_setup} +\title{Source the "setup.R" file of a template} +\usage{ +source_template_setup(template) +} +\arguments{ +\item{template}{Template name in the format \verb{[package]:[name]}} +} +\value{ +Nothing, used for side effect +} +\description{ +Source the "setup.R" file of a template +} +\examples{ +# Launch basic configuration for reports +source_template_setup("fairify:basic") + +} diff --git a/tests/testthat/test-add_report.R b/tests/testthat/test-add_report.R index b9822c7173a98e23daba9271e02a03c628183dc3..150ec1933ed0116277b6e10240c17f856f63c64c 100644 --- a/tests/testthat/test-add_report.R +++ b/tests/testthat/test-add_report.R @@ -24,11 +24,11 @@ test_that("add_report should create a report", { sapply(file.path(path, "reports/test", c(list.files(pkg_sys("bookdown_template")), - ".template_dependencies", + "_fairify.yml", "_output.yml")), function(x) expect_true(file.exists(!!x))) - expect_equal(readLines(file.path(path, "reports/test/.template_dependencies")), - "fairify:umr_geau") + expect_equal(readLines(file.path(path, "reports/test/_fairify.yml")), + "template: fairify:umr_geau") output_yml <- yaml::read_yaml(file.path(path, "reports/test/_output.yml")) expect_true(grepl("templates/inrae", output_yml$`bookdown::gitbook`$config$toc$before)) unlink(path, recursive = TRUE) diff --git a/tests/testthat/test-loadConfig.R b/tests/testthat/test-loadConfig.R index 6dabbd76bf0388ea6642ffb63da664891455e60d..42dcf2c10aae449d22d8a77c5fdb9c42ed543a46 100644 --- a/tests/testthat/test-loadConfig.R +++ b/tests/testthat/test-loadConfig.R @@ -24,3 +24,9 @@ test_that("loadConfig works", { file.path(path_pkg, "config.yml"))) unlink(path_pkg, recursive = TRUE) }) + +test_that("loadConfig works outside of a project folder", { + owd <- setwd("/") + expect_warning(loadConfig(), regexp = "not found") + expect_type(suppressWarnings(loadConfig()), "list") +})