Merge pull request #76 from reconhub/fix74

fix for #74

R/compile_reports.R

@@ -64,7 +64,7 @@ compile_reports <- function(factory = ".", reports = NULL,
     }
   }
 
-  # report output folder (create if it does not already exist)
+  # create output directory
   report_output_dir <- file.path(root, outputs)
   if (!dir.exists(report_output_dir)) {
     dir.create(report_output_dir)
@@ -75,6 +75,10 @@ compile_reports <- function(factory = ".", reports = NULL,
   # loop over all reports
   for (r in report_sources) {
 
+    # get files present in report folder and timestamps
+    files_at_start <- list_report_folder_files(report_template_dir)
+    dirs_at_start <- list_report_folder_files(report_template_dir, directories = TRUE)
+
     # pull yaml from the report
     yaml <- rmarkdown::yaml_front_matter(r)
 
@@ -92,14 +96,15 @@ compile_reports <- function(factory = ".", reports = NULL,
         params_input <- append(params, other_params)
       }
       out_file <- file.path(report_template_dir, "_reportfactory_tmp_.Rmd")
-      on.exit(file.remove(out_file), add = TRUE)
+      on.exit(suppressWarnings(file.remove(out_file)), add = TRUE)
       change_yaml_matter(r, params = params_input, output_file = out_file)
       params_to_print <- params_input
     }
 
     # display just enough information to be useful
     relative_path <- sub(report_template_dir, "", r)
     relative_path <- sub("\\.[a-zA-Z0-9]*$", "", relative_path)
+    relative_path <- sub("^/", "", relative_path)
     message(">>> Compiling report: ", relative_path)
     if (!is.null(names(params_to_print))) {
       message(
@@ -123,6 +128,7 @@ compile_reports <- function(factory = ".", reports = NULL,
         timestamp
       )
     }
+    #dir.create(output_folder, recursive = TRUE)
 
     # render a report in a cleaner environment using `callr::r`.
     # the calls below are a little verbose but currently work (can simplify
@@ -168,8 +174,32 @@ compile_reports <- function(factory = ".", reports = NULL,
       )
     }
 
-    # make a copy of the report
+    # remove the temporary outfile if present
+    if (!is.null(params)) file.remove(out_file)
+
+    # get files present in report folder and timestamps
+    files_at_end <- list_report_folder_files(report_template_dir)
+
+    # work out which files are new
+    new_files <- rows_in_x_not_in_y(files_at_end, files_at_start)$files
+
+    # make a copy of the report and the new files
     file.copy(r, output_folder)
+    new_locations <- sub(dirname(r), output_folder, new_files)
+    for (d in dirname(new_locations))
+      if (!dir.exists(d)) {
+        dir.create(d, recursive = TRUE)
+      }
+    file.rename(new_files, new_locations)
+
+    # remove left over folders
+    dirs_at_end <- list_report_folder_files(report_template_dir, directories = TRUE)
+
+    # work out which files are new
+    new_dirs <- rows_in_x_not_in_y(dirs_at_end, dirs_at_start)$files
+
+    # remove new directories
+    unlink(new_dirs, recursive = TRUE)
   }
 
   message("All done!\n")

R/internals.R

@@ -8,7 +8,7 @@
 #' @noRd
 #' @keywords internal
 factory_root <- function(directory = ".") {
-  
+
   if (!file.exists(directory)) {
     stop(
       sprintf("directory '%s' does not exist!\n", directory),
@@ -22,7 +22,7 @@ factory_root <- function(directory = ".") {
       call. = FALSE
     )
   }
-    
+
   odir <- setwd(directory)
   on.exit(setwd(odir))
   root <- tryCatch(
@@ -36,38 +36,38 @@ factory_root <- function(directory = ".") {
   )
   root
 }
-   
+
 #' check whether a vector is "integer-like" to a given precision
-#' 
+#'
 #' @param x vector to check
 #' @param tol desired tolerance
-#' 
-#' @noRd 
+#'
+#' @noRd
 is.wholenumber <- function(x, tol = .Machine$double.eps^0.5)  {
   all(abs(x - round(x)) < tol)
 }
 
 #' copy a file from the skeleton directory
-#' 
+#'
 #' @param file name of the file you want to copy
 #' @param dest destination to copy to
-#' 
-#' @noRd 
+#'
+#' @noRd
 copy_skeleton_file <- function(file, dest) {
   f <- system.file("skeletons", file, package = "reportfactory")
   file.copy(f, dest)
 }
 
 
 #' Change part of the front yaml matter from an Rmarkdown file
-#' 
+#'
 #' This function was provided on Stack Overflow by user r2evans.
 #' link: https://stackoverflow.com/a/62096216
-#' user: 
+#' user:
 #' @param input_file the .Rmd file
 #' @param output_file where to save the changed output
 #' @param ... named list of yaml to change
-#' 
+#'
 #' @noRd
 change_yaml_matter <- function(input_file, ..., output_file) {
   input_lines <- readLines(input_file, warn = FALSE)
@@ -102,3 +102,18 @@ change_yaml_matter <- function(input_file, ..., output_file) {
     return(invisible(output_lines))
   }
 }
+
+
+#' Return rows of one data.frame not in another
+#'
+#' @param x data.frame
+#' @param y data.frame
+#'
+#' @return data.frame of rows of x not in y
+#'
+#' @noRd
+rows_in_x_not_in_y <- function(x,y) {
+  xx <- apply(x, 1, paste0, collapse = "")
+  yy <- apply(y, 1, paste0, collapse = "")
+  x[!xx %in% yy,]
+}

R/list_report_folder_files.R

@@ -0,0 +1,24 @@
+#' List files and timestamps within the report sources folder
+#'
+#' @inheritParams compile_reports
+#' @param directories should directories be listed
+#'
+#' @noRd
+list_report_folder_files <- function(factory = ".", directories = FALSE) {
+
+  # validate and get the root / report_sources directories of the factory
+  tmp <- validate_factory(factory)
+  root <- tmp$root
+  report_sources <- tmp$report_sources
+
+  # get a listing of all files and folders in report_sources
+  f <- list.files(
+    file.path(root, report_sources),
+    recursive = TRUE,
+    include.dirs = directories
+  )
+  f <- file.path(root, report_sources, f)
+
+  data.frame(files = f, modified = file.mtime(f))
+
+}

inst/skeletons/example_report.Rmd

@@ -25,9 +25,9 @@ library(incidence2)
 dat <- read.csv(here("data", "raw", "example_data.csv"))
 inci <- incidence(dat, date, groups = nhs_region, count = count)
 if (params$grouped_plot) {
-  plot(inci, angle = 45, ylab = "", title = "Reports by date", centre_ticks = TRUE)
+  plot(inci, angle = 45, ylab = "", title = "Reports by date")
 } else {
-  facet_plot(inci, angle = 45, ylab = "", title = "Reports by day", centre_ticks = TRUE)
+  facet_plot(inci, angle = 45, ylab = "", title = "Reports by day")
 }
 
 ```

tests/testthat/test-compile_reports.R

@@ -265,3 +265,44 @@ test_that("logical index for reports", {
 })
 
 
+test_that("figures folders copied correctly reports", {
+  skip_if_pandoc_not_installed()
+  skip_on_os("windows")
+
+  # create factory
+  f <- new_factory(path = path_temp(), move_in = FALSE)
+  on.exit(dir_delete(f))
+
+  # copy test reports over
+  file_copy(
+    path = path("test_reports", "simple_with_figures_folder.Rmd"),
+    path(f, "report_sources")
+  )
+
+  file_delete(path(f, "report_sources", "example_report.Rmd"))
+
+  # compile report
+  compile_reports(f, timestamp = "test")
+  nms <- path_ext_remove(list_reports(f))
+  nms <- paste(nms, collapse = "|")
+  expected_files <- c(
+    file.path("simple_with_figures_folder", "test", "simple_with_figures_folder.Rmd"),
+    file.path("simple_with_figures_folder", "test", "simple_with_figures_folder.html"),
+    file.path("simple_with_figures_folder", "test", "figures", "pressure-1.png")
+  )
+  expected_files <- expected_files[grepl(nms, expected_files)]
+
+
+  output_files <- list_outputs(f)
+  expect_true(all(
+    mapply(
+      grepl,
+      pattern = sort(expected_files),
+      x = sort(output_files),
+      MoreArgs = list(fixed = TRUE)
+    )
+  ))
+
+})
+
+

tests/testthat/test_reports/simple_with_figures_folder.Rmd

@@ -0,0 +1,17 @@
+---
+title: "Simple Report with figures folder"
+output:
+  html_document: default
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(fig.path = "figures/")
+```
+
+# Test Plot
+You can also embed plots, for example:
+
+```{r pressure, echo = FALSE}
+plot(pressure)
+```
+