feat: correct img path when extracted from html

- embedded html code in qmd now behave like other img

Author: dagousket

DESCRIPTION

@@ -11,13 +11,15 @@ Description: Compile n .qmd (under format revealjs) to one single html
 License: MIT + file LICENSE
 Imports: 
     cli,
+    dplyr,
     furrr,
     future,
     htmltools,
     progressr,
     purrr,
     quarto,
     rvest,
+    stats,
     tools,
     utils,
     yaml

NAMESPACE

@@ -2,13 +2,15 @@
 
 export(clean_rendering_files)
 export(compile_qmd_course)
+export(copy_img_and_edit_path)
 export(create_template_html)
 export(extract_html_slides)
 export(render_single_qmd)
 importFrom(cli,cli_alert_danger)
 importFrom(cli,cli_alert_info)
 importFrom(cli,cli_alert_success)
 importFrom(cli,cli_alert_warning)
+importFrom(dplyr,filter)
 importFrom(furrr,furrr_options)
 importFrom(furrr,future_map_lgl)
 importFrom(future,plan)
@@ -19,14 +21,18 @@ importFrom(htmltools,save_html)
 importFrom(progressr,handlers)
 importFrom(progressr,progressor)
 importFrom(progressr,with_progress)
+importFrom(purrr,discard)
 importFrom(purrr,map)
 importFrom(purrr,map_lgl)
+importFrom(purrr,walk)
+importFrom(purrr,walk2)
 importFrom(quarto,quarto_inspect)
 importFrom(quarto,quarto_render)
 importFrom(rvest,html_attr)
 importFrom(rvest,html_children)
 importFrom(rvest,html_elements)
 importFrom(rvest,read_html)
+importFrom(stats,setNames)
 importFrom(tools,file_ext)
 importFrom(utils,download.file)
 importFrom(utils,unzip)

R/compile_qmd_course.R

@@ -13,10 +13,13 @@
 #' @param mail character. Mail of the trainer
 #' @param phone character. Phone number of the trainer
 #' @param quiet logical. Output info in user console
+#' @param fix_img_path logical. If image path are present as raw html inside files,
+#' use this option to correctly edit their path.
 #'
 #' @importFrom tools file_ext
 #' @importFrom htmltools htmlTemplate renderDocument save_html
 #' @importFrom furrr future_map_lgl furrr_options
+#' @importFrom purrr walk
 #' @importFrom future plan
 #' @importFrom cli cli_alert_info cli_alert_warning cli_alert_success
 #' @importFrom progressr handlers progressor with_progress
@@ -81,7 +84,8 @@ compile_qmd_course <- function(
     trainer = "ThinkR",
     mail = "thinkr.fr",
     phone = "+33 0 00 00 00 00",
-    quiet = TRUE
+    quiet = TRUE,
+    fix_img_path = FALSE
 ) {
   # check paths
   not_all_files_are_qmd <- any(
@@ -163,9 +167,16 @@ compile_qmd_course <- function(
     }
   }
 
-  # read html and extract slides elements
+  # correct remaining img path
   vec_html_path <- gsub("\\.qmd", "\\.html", vec_qmd_path)
 
+  if (fix_img_path) {
+    walk(.x = vec_html_path, .f = \(x) {
+      copy_img_and_edit_path(html_path = x, img_root_dir = img_root_dir)
+    })
+  }
+  
+  # read html and extract slides elements
   html_content <- extract_html_slides(
     vec_html_path = vec_html_path
   )

R/copy_img_and_edit_path.R

@@ -0,0 +1,64 @@
+#' Copy img to root img directory and edit path in html
+#'
+#' @param html_path character. Path to html file.
+#' @param img_root_dir character. Path to img root dir
+#'
+#' @importFrom purrr map discard walk2
+#' @importFrom rvest html_attr read_html html_elements
+#' @importFrom stats setNames
+#' @importFrom dplyr filter
+#'
+#' @return None. Side effet : edit img path in html.
+#' @export
+copy_img_and_edit_path <- function(
+  html_path,
+  img_root_dir
+){
+  # set image sub-folder name
+  chapter <- dirname(html_path)
+  
+  img_dir <- file.path(
+    img_root_dir,
+    paste0(basename(chapter), "_img")
+  )
+  
+  # read html image path
+  img_list <- html_path |> 
+    read_html() |> 
+    html_elements("img")
+  
+  img_df <- map(
+    .x = c("src", "data-src", "class"),
+    .f = \(x){img_list |> html_attr(x)}
+    ) |>
+    setNames(c("src", "data", "img_class")) |>
+    data.frame()
+
+  img_path <- discard(unique(c(img_df$src, img_df$data)), is.na)
+  
+  # correct the ones not in img_root_dir
+  img_correct_path <- grepl(pattern = paste0("^", img_dir), x = img_path)
+  img_to_fix <- img_path[!img_correct_path]
+  
+  if (length(img_to_fix) > 0){
+    
+    html_content <- readLines(html_path, warn = FALSE)
+    
+    walk2(
+      .x = file.path(dirname(html_path), img_to_fix),
+      .y = file.path(dirname(html_path), img_dir, img_to_fix),
+      .f = \(x, y){
+        dir.create(dirname(y), recursive = TRUE, showWarnings = FALSE)
+        file.copy(from = x, to = y, overwrite = TRUE)
+      })
+    
+    html_content <- gsub(
+      pattern = paste0('"(',paste0(img_to_fix, collapse = "|"), ')"'),
+      replacement = paste0('"', img_dir, "\\/", "\\1", '"'),
+      x = html_content
+    )
+    
+    writeLines(text = html_content, con = html_path)
+  }
+  
+}

inst/courses/M01/M01S02/C01-qmd3_for_test.qmd

@@ -18,4 +18,4 @@ Slide with chapter name and png file name identical to a slide from the first ch
 
 This should be a {ggplot2} image.
 
-![](img/logo_1.png)
+<img src="img/logo_1.png">

man/compile_qmd_course.Rd

@@ -59,7 +59,8 @@ test_that("compile_qmd_course renders all input courses inside a unique html out
   html_output <- compile_qmd_course(
     vec_qmd_path = qmds,
     output_dir = temp_dir,
-    output_html = "complete_course.html"
+    output_html = "complete_course.html",
+    fix_img_path = TRUE
   )
 
   file_present_after_rendering <- list.files(
@@ -127,6 +128,9 @@ test_that("compile_qmd_course renders all input courses inside a unique html out
       rvest::html_text()
   })
 
+  #' @description test that img path from embedded html is correct
+  expect_true(grepl("complete_course_img/M01S02_img/img/logo_1.png", slide_content))
+
   #' @description test html content is present
   expect_snapshot(x = slide_content_by_cat)
 
@@ -147,8 +151,8 @@ test_that("compile_qmd_course HTML preview looks ok", {
       "\nYou have 26 slides, all with footer and logo ?",
       "\nMain titles are centered, all titles are orange ?",
       "\nImage and code chunk appear properly sized and colored ?",
-      "\nGraphics are visible in slides 19 and 20 ?",
-      "\nTable is visible in slide 21 ?"
+      "\nGraphics are visible in slides 23 and 24 ?",
+      "\nTable is visible in slide 25 ?"
       )
 
     answers <- sapply(