Adding tests and non breaking rearrangements

R/auth.R

@@ -78,7 +78,6 @@ authorize <- function(token = NULL, cache = FALSE, ...) {
 #' }
 #'
 auth_from_secret <- function(access_token = NULL, refresh_token = NULL) {
-
   # If no tokens are specified, we'll grab the default ones.
   if (is.null(access_token) | is.null(refresh_token)) {
     decrypted <- openssl::aes_cbc_decrypt(

R/bookdown_to_leanpub.R

@@ -1,134 +1,6 @@
 #' Convert Bookdown to Leanpub
 #'
 #' @param path path to the bookdown book, must have a `_bookdown.yml` file
-#' @param output_dir output directory to put files.  It should likely be
-#' relative to path
-#' @param render if `TRUE`, then [bookdown::render_book()] will be run on each Rmd.
-#' @param verbose print diagnostic messages
-#' @param remove_resources_start remove the word `resources/` at the front
-#' of any image path.
-#' @param run_quiz_checks TRUE/FALSE run quiz checks
-#' @param make_book_txt Should [ottrpal::bookdown_to_book_txt()] be run
-#' to create a `Book.txt` in the output directory?
-#' @param quiz_dir directory that contains the quiz .md files that should be
-#' checked and incorporated into the Book.txt file. If you don't have quizzes,
-#' set this to NULL
-#' @param clean_up TRUE/FALSE the old output directory should be deleted and
-#' everything created fresh.
-#' @param footer_text Optionally can add a bit of text that will be added to the
-#' end of each file before the references section.
-#'
-#' @return A list of output files and diagnostics
-#' @export
-#'
-bookdown_to_leanpub <- function(path = ".",
-                                render = TRUE,
-                                output_dir = "manuscript",
-                                make_book_txt = FALSE,
-                                quiz_dir = "quizzes",
-                                run_quiz_checks = FALSE,
-                                remove_resources_start = FALSE,
-                                verbose = TRUE,
-                                footer_text = NULL,
-                                clean_up = FALSE) {
-  # Run the set up
-  set_up_leanpub(
-    path = path,
-    embed = FALSE,
-    clean_up = clean_up,
-    render = render,
-    output_dir = output_dir,
-    make_book_txt = make_book_txt,
-    quiz_dir = quiz_dir,
-    run_quiz_checks = run_quiz_checks,
-    remove_resources_start = remove_resources_start,
-    verbose = verbose,
-    footer_text = footer_text
-  )
-
-  # Establish path
-  path <- bookdown_path(path)
-
-  rmd_regex <- "[.][R|r]md$"
-
-  # Extract the names of the Rmd files (the chapters)
-  rmd_files <- bookdown_rmd_files(path = path)
-
-  bib_files <- list.files(pattern = "[.]bib$")
-
-  if (length(bib_files) > 0) {
-    pandoc_args <- paste0("--bibliography=", path.expand(normalizePath(bib_files)))
-  } else {
-    pandoc_args <- NULL
-  }
-
-  # run_env = new.env()
-  md_files <- sub(rmd_regex, ".md", rmd_files, ignore.case = TRUE)
-  md_files <- file.path(output_dir, basename(md_files))
-
-  for (file in md_files) {
-    if (verbose > 1) {
-      message("Replacing HTML for ", file)
-    }
-    infile <- normalizePath(file)
-
-    infile <- replace_single_html(infile,
-      verbose = verbose > 1,
-      remove_resources_start = remove_resources_start,
-      footer_text = footer_text
-    )
-
-    if (length(bib_files) > 0) {
-      if (verbose > 1) {
-        message("Making references for ", file)
-      }
-      writeLines(simple_references(infile, bib_files, add_reference_header = TRUE),
-        con = infile, sep = "\n"
-      )
-    }
-  }
-  ####################### Book.txt creation ####################################
-  out <- NULL
-  if (make_book_txt) {
-    if (verbose > 1) {
-      message("Running bookdown_to_book_txt")
-    }
-    bookdown_to_book_txt(
-      md_files = rmd_files,
-      output_dir = output_dir,
-      quiz_dir = quiz_dir,
-      verbose = verbose
-    )
-    out <- book_txt_file <- file.path(output_dir, "Book.txt")
-  } else {
-    # If false, look for Book.txt file to copy to output folder.
-    book_txt_file <- file.path(path, "Book.txt")
-
-    if (file.exists(book_txt_file)) {
-      # Copy over an existing book.txt file if it exists
-      file.copy(from = book_txt_file, to = file.path(output_dir, "Book.txt"))
-
-      out <- book_txt_file <- file.path(output_dir, "Book.txt")
-    } else {
-      # If none exists and make_book_txt is false: stop.
-      stop(paste0(
-        "Book.txt file does not exist in the main directory: ", path, "and make_book_txt is set to FALSE.",
-        "There is no Book.txt file. Leanpub needs one. Either make one and place it in the directory path or ",
-        "use make_book_txt = TRUE and one will be generated for you."
-      ))
-    }
-  }
-  ############################# Wrapping up ####################################
-  message(paste(
-    "Leanpub ready files are saved to",
-    output_dir,
-    "Go to https://leanpub.com/ to publish them using the GitHub writing mode."
-  ))
-}
-
-#' Convert Bookdown to Embed version of Leanpub
-#'
-#' @param path path to the bookdown book, must have a `_bookdown.yml` file
 #' @param chapt_img_key File path to a TSV whose contents are the chapter urls (`url`),
 #' the chapter titles (`chapt_title`), the file path to the image to be used for the chapter (`img_path`).
 #' Column names `url`, `chapt_title`, and `img_path` must be used.

R/data.R

@@ -1,3 +1,49 @@
+#' Download files from main OTTR_Template to test
+#'
+#' @param dir What relative file path should the files be downloaded
+#' @param type Which OTTR repo are we downloading? Options are "rmd", "quarto", "rmd_website", "quarto_website"
+#'
+#' @return This downloads the main branch repo files from the respective repo for testing purposes
+#' @export
+download_ottr_template <- function(dir = "inst/extdata", type = "rmd") {
+  if (!dir.exists(dir)) dir.create(dir, recursive = TRUE, showWarning = FALSE)
+
+  possible_types <- c("rmd", "quarto", "rmd_website", "quarto_website")
+
+  if (!(type %in% possible_types)) {
+    stop(
+      "The `type` argument provided can only be one of these types: \n ",
+      paste(possible_types, collapse = " ")
+    )
+  }
+
+  url <- switch(type,
+    rmd = "https://github.com/jhudsl/OTTR_Template/archive/refs/heads/main.zip",
+    quarto = "https://github.com/fhdsl/ottr/archive/refs/heads/main.zip",
+    rmd_website = "https://github.com/jhudsl/OTTR_Template_Website/archive/refs/heads/main.zip",
+    quarto_website = "https://github.com/fhdsl/OTTR_Quarto_Website/archive/refs/heads/main.zip"
+  )
+
+  file_name <- switch(type,
+    rmd = "OTTR_Template-main.zip",
+    quarto = "OTTR_Quarto-main.zip",
+    rmd_website = "OTTR_Template_Website-main.zip",
+    quarto_website = "OTTR_Quarto_Website-main.zip"
+  )
+
+  file_path <- file.path(dir, file_name)
+
+  if (!file.exists(file_path)) {
+    download.file(url,
+      destfile = file_path
+    )
+
+    unzip(file_path, exdir = dir)
+  }
+  output_dir <- stringr::str_remove(file.path(dir, file_name), ".zip")
+
+  return(output_dir)
+}
 
 #' Get file path to an key encryption RDS
 key_encrypt_creds_path <- function() {

R/notes_to_fig_alt.R

@@ -21,7 +21,7 @@ get_gs_pptx <- function(id) {
     fr_header <- result$headers$`x-frame-options`
     if (!is.null(fr_header)) {
       if (all(fr_header == "DENY")) {
-       warn_them <- TRUE
+        warn_them <- TRUE
       }
     }
     if (httr::status_code(result) >= 300) {
@@ -30,15 +30,15 @@ get_gs_pptx <- function(id) {
     # don't write something if not really a pptx
     ctype <- result$headers$`content-type`
     if (httr::status_code(result) >= 400 &&
-        !is.null(ctype) && grepl("html", ctype)) {
+      !is.null(ctype) && grepl("html", ctype)) {
       file.remove(pptx_file)
     }
     if (grepl("ServiceLogin", result$url)) {
       warn_them <- TRUE
     }
     if (warn_them) {
       warning(
-       paste0(
+        paste0(
           "This presentation may not be available, ",
           "did you turn link sharing on?"
         )
@@ -50,11 +50,12 @@ get_gs_pptx <- function(id) {
 
 
 export_url <- function(id, page_id = NULL, type = "pptx") {
-  url = paste0(
+  url <- paste0(
     "https://docs.google.com/presentation/d/",
-    id, "/export/", type, "?id=", id)
+    id, "/export/", type, "?id=", id
+  )
   if (!is.null(page_id)) {
-    url = paste0(url, "&pageid=", page_id)
+    url <- paste0(url, "&pageid=", page_id)
   }
   url
 }
@@ -300,22 +301,25 @@ xml_notes <- function(file, collapse_text = TRUE, xpath = "//a:r//a:t") {
 #' extract_object_id(slide_url = "https://docs.google.com/presentation/d/1H5aF_ROKVxE-H
 #'                                FHhoOy9vU2Y-y2M_PiV0q-JBL17Gss/edit?usp=sharing")
 #' }
-extract_object_id = function(slide_url, token = NULL, access_token = NULL, refresh_token = NULL) {
+extract_object_id <- function(slide_url, token = NULL, access_token = NULL, refresh_token = NULL) {
   # Get Slide ID from URL
   id <- get_slide_id(slide_url)
   # Using Slide ID, create url that we'll send to GET
   get_url <- gsub("{presentationId}", id,
-              "https://slides.googleapis.com/v1/presentations/{presentationId}", fixed=TRUE)
+    "https://slides.googleapis.com/v1/presentations/{presentationId}",
+    fixed = TRUE
+  )
 
   # if token not provided, fetch token
   if (is.null(token)) {
-
     token_try <- try(get_token(), silent = TRUE)
 
     # We will supply credentials if none can be grabbed by get_token()
     if (is.null(token_try)) {
-      auth_from_secret(access_token = access_token,
-                       refresh_token = refresh_token)
+      auth_from_secret(
+        access_token = access_token,
+        refresh_token = refresh_token
+      )
     }
     token <- get_token()
   } # else user provides token
@@ -341,7 +345,7 @@ extract_object_id = function(slide_url, token = NULL, access_token = NULL, refre
 #'
 #' @examples
 #' \dontrun{
-#'  get_object_id_notes("https://docs.google.com/presentation/d/
+#' get_object_id_notes("https://docs.google.com/presentation/d/
 #'                       1H5aF_ROKVxE-HFHhoOy9vU2Y-y2M_PiV0q-JBL17Gss/edit?usp=sharing")
 #' }
 get_object_id_notes <- function(slide_url) {
@@ -356,4 +360,3 @@ get_object_id_notes <- function(slide_url) {
 
   data.frame(id = object_ids, notes = speaker_notes)
 }
-