fix: examples sandbox

Author: c1au6i0

DESCRIPTION

@@ -26,6 +26,7 @@ Depends:
 Imports:
     cli,
     condathis,
+    fs,
     httr2,
     janitor,
     pingr,

NAMESPACE

@@ -13,5 +13,5 @@ export(extr_pubchem_fema)
 export(extr_pubchem_ghs)
 export(extr_tetramer)
 export(extr_tox)
-export(with_extr_sandbox)
+export(with_sandbox_dir)
 export(write_dataframes_to_excel)

R/cache.R

@@ -82,34 +82,6 @@ read_from_cache <- function(file_name, verbose = FALSE) {
 }
 
 
-#' Run Code in a Temporary Sandbox Environment
-#'
-#' This function creates a temporary directory and sets it as `R_USER_CACHE_DIR`
-#' before executing the provided code block. It is used for testing or running
-#' code without affecting the user's default cache directory as required by CRAN
-#' for the examples .This function is not  designed to be used by package users.
-#' Shamelessly "inspired" by some @luciorq code.
-#' @param code The code to be executed inside the sandbox. Should be an
-#'    expression.
-#' @param temp_dir A temporary directory created using `temdir()`.
-#' @return The result of the executed code.
-#' @keywords internal
-#' @examples
-#' with_extr_sandbox(Sys.getenv("R_USER_CACHE_DIR"))
-#' with_extr_sandbox(tools::R_user_dir("extractox", "cache"))
-with_extr_sandbox <- function(code, temp_dir = tempdir()) {
-  if (base::missing(code)) {
-    cli::cli_abort("The argument {.field {file_name}} is required.")
-  }
-
-  withr::with_envvar(
-    new = c("R_USER_CACHE_DIR" = temp_dir),
-    code = {
-      eval(substitute(code), envir = parent.frame())
-    }
-  )
-}
-
 #' Execute Code in a Temporary Directory
 #'
 #' @description
@@ -118,8 +90,8 @@ with_extr_sandbox <- function(code, temp_dir = tempdir()) {
 #' and ensures that no data is written to the user's file space.
 #' Environment variables such as `HOME`, `APPDATA`, `R_USER_DATA_DIR`,
 #' `XDG_DATA_HOME`, `LOCALAPPDATA`, and `USERPROFILE` are redirected to
-#' temporary directories. This function was implemented by @luciorq in 
-#' {condathis} dev
+#' temporary directories. This function was implemented by @luciorq in
+#' `condathis` dev.
 #'
 #' @details
 #' This function is not designed for direct use by package users. It is
@@ -182,4 +154,4 @@ with_sandbox_dir <- function(code, .local_envir = base::parent.frame()) {
   code <- base::substitute(expr = code)
   rlang::eval_bare(expr = code, env = .local_envir)
   return(invisible(NULL))
-}
+}

R/extr_pprtv.R

@@ -1,18 +1,17 @@
 #' Extract Data from EPA PPRTVs
 #'
-#' Extracts data for specified identifiers (CASRN or chemical names) from the EPA's
-#' Provisional Peer-Reviewed Toxicity Values (PPRTVs) database. The function
-#' retrieves and processes data, with options to use cached files or force a
-#' fresh download.
+#' Extracts data for specified identifiers (CASRN or chemical names) from the
+#' EPA's Provisional Peer-Reviewed Toxicity Values (PPRTVs) database. The
+#' function retrieves and processes data, with options to use cached files
+#' or force a fresh download.
 #'
 #' @param ids Character vector of identifiers to search (e.g., CASRN or chemical
 #'   names).
-#' @param search_type Character string specifying the type of identifier: "casrn"
-#'    or "name".
-#'   Default is "casrn". If `search_type` is "name", the function performs a
-#'   partial match search for the chemical name. NOTE: Since partial mached is
-#'   use, multiple seraches might match the same chemical, therefore chemical ids
-#'   might not be  uniques.
+#' @param search_type Character string specifying the type of identifier:
+#'   "casrn" or "name". Default is "casrn". If `search_type` is "name", the
+#'   function performs a partial match search for the chemical name. NOTE:
+#'   Since partial mached is use, multiple seraches might match the same
+#'   chemical, therefore chemical ids might not be  uniques.
 #' @param verbose Logical indicating whether to display progress messages.
 #'   Default is TRUE.
 #' @param force Logical indicating whether to force a fresh download of the
@@ -22,27 +21,29 @@
 #'   This is was introduced for debugging purposes.
 #' @return A data frame with extracted information matching the specified
 #'   identifiers, or NULL if no matches are found.
-#' @seealso \href{https://www.epa.gov/pprtv/provisional-peer-reviewed-toxicity-values-pprtvs-assessments}{EPA PPRTVs}
+#' @seealso \href{https://www.epa.gov/pprtv/provisional-peer-reviewed-toxicity-values-pprtvs-assessments}{EPA PPRTVs} # nolint
 #' @export
 #' @examples
 #' \donttest{
-#' with_extr_sandbox({ # this is to write on tempdir as for CRAN policies
+#' condathis::with_sandbox_dir({ # this is to write on tempdir as for CRAN policies # nolint
 #'   # Extract data for a specific CASRN
 #'   extr_pprtv(ids = "107-02-8", search_type = "casrn", verbose = TRUE)
 #'
 #'   # Extract data for a chemical name
-#'   extr_pprtv(
+#'   out <- extr_pprtv(
 #'     ids = "Acrolein", search_type = "name", verbose = TRUE,
 #'     force = FALSE
 #'   )
+#'   print(out)
 #'
 #'   # Extract data for multiple identifiers
-#'   extr_pprtv(
+#'   out2 <- extr_pprtv(
 #'     ids = c("107-02-8", "79-10-7", "42576-02-3"),
 #'     search_type = "casrn",
 #'     verbose = TRUE,
 #'     force = FALSE
 #'   )
+#'   print(out2)
 #' })
 #' }
 extr_pprtv <- function(ids, search_type = "casrn", verbose = TRUE, force = TRUE,

R/utils.R

@@ -52,7 +52,7 @@ download_db <- function(url,
 
   if (isTRUE(check_need_libcurl_condathis())) {
     condathis_downgrade_libcurl()
-    
+
     url_to_use <-
       paste0(
         url,
@@ -164,7 +164,7 @@ search_and_match <- function(dat,
 #'
 #' @param df_list A named list of dataframes to write to the Excel file.
 #' @param filename The name of the Excel file to create.
-#' @return No return value. The function prints a message indicating 
+#' @return No return value. The function prints a message indicating
 #'   the completion of the Excel file writing.
 #' @export
 #' @examples

data-raw/Untitled-1.R

@@ -3,8 +3,9 @@ temp_dir <- tempdir()
 
 condathis::with_sandbox_dir({ # this is to write on tempdir as for CRAN policies
 
-  with_extr_sandbox(temp_dir = temp_dir,
-   # Extract data for a specific CASRN
-  dat  <- extr_pprtv(ids = "107-02-8", search_type = "casrn", verbose = TRUE, force = TRUE)
+  with_extr_sandbox(
+    temp_dir = temp_dir,
+    # Extract data for a specific CASRN
+    dat <- extr_pprtv(ids = "107-02-8", search_type = "casrn", verbose = TRUE, force = TRUE)
   )
 })

docs/pkgdown.yml

@@ -2,7 +2,7 @@ pandoc: 3.1.3
 pkgdown: 2.1.1
 pkgdown_sha: ~
 articles: {}
-last_built: 2025-02-21T20:19Z
+last_built: 2025-02-27T04:17Z
 urls:
   reference: https://c1au6i0.github.io/extractox/reference
   article: https://c1au6i0.github.io/extractox/articles

docs/reference/extr_casrn_from_cid.html

@@ -60,4 +60,4 @@ withr::local_envvar(
     `R_USER_CACHE_DIR` = tmp_cache_path
   ),
   .local_envir = testthat::teardown_env()
-)
+)

docs/reference/extr_comptox.html

@@ -11,9 +11,11 @@ song <- c("bella", "ciao", "bella", "ciao", "ciao", "ciao")
 test_that("Save to cache works", {
   expect_message(
     {
-      file_path <- save_to_cache(dat = song,
-                                 file_name = "song.txt",
-                                 verbose = TRUE)
+      file_path <- save_to_cache(
+        dat = song,
+        file_name = "song.txt",
+        verbose = TRUE
+      )
     },
     "Saving"
   )

docs/reference/index.html

@@ -24,68 +24,56 @@ test_that("extr_pprtv casrn hit and not hit, verbose,  force = TRUE", {
   expect_equal(out$query, ids_search)
 })
 
-# test_that("Function to warn with  verbose = TRUE", {
-#   skip_on_cran()
-#   skip_if_offline()
-
-#   ids_search <- c("112-27-6", "bella", "ciao")
-#   expect_warning(
-#     {
-#       with_extr_sandbox(
-#         temp_dir = temp_dir,
-#         out <- extr_pprtv(
-#           ids = ids_search,
-#           force = FALSE, verbose = TRUE
-#         )
-#       )
-#     },
-#     "Chemicals .* not found!"
-#   )
+test_that("Function to warn with  verbose = TRUE", {
+  skip_on_cran()
+  skip_if_offline()
 
-#   expect_equal(out$query, ids_search)
-#   expect_equal(nrow(out), length(ids_search))
-#   expect_true(is.na(out$casrn[[3]]))
-# })
+  ids_search <- c("112-27-6", "bella", "ciao")
+  expect_warning(
+    {
+      out <- extr_pprtv(
+        ids = ids_search,
+        force = FALSE, verbose = TRUE
+      )
+    },
+    "Chemicals .* not found!"
+  )
 
-# test_that("Function verbose = FALSE", {
-#   skip_on_cran()
-#   skip_if_offline()
+  expect_equal(out$query, ids_search)
+  expect_equal(nrow(out), length(ids_search))
+  expect_true(is.na(out$casrn[[3]]))
+})
 
-#   ids_search <- c("112-27-6", "98-86-2")
-#   expect_silent({
-#     with_extr_sandbox(
-#       temp_dir = temp_dir,
-#       out <- extr_pprtv(
-#         ids = ids_search,
-#         force = FALSE, verbose = FALSE
-#       )
-#     )
-#   })
-# })
+test_that("Function verbose = FALSE", {
+  skip_on_cran()
+  skip_if_offline()
 
-# test_that("extr_pprtv na,es hit and not hit, verbose,  force = TRUE", {
-#   skip_on_cran()
-#   skip_if_offline()
+  ids_search <- c("112-27-6", "98-86-2")
+  expect_silent({
+    out <- extr_pprtv(
+      ids = ids_search,
+      force = FALSE, verbose = FALSE
+    )
+  })
+})
 
-#   ids_search <- c("Ace", "Acetophenone")
+test_that("extr_pprtv na,es hit and not hit, verbose,  force = TRUE", {
+  skip_on_cran()
+  skip_if_offline()
 
-#   expect_message(
-#     {
-#       with_extr_sandbox(
-#         temp_dir = temp_dir,
-#         out <- extr_pprtv(
-#           ids = ids_search,
-#           search_type = "name",
-#           force = TRUE,
-#           verbose = TRUE
-#         )
-#       )
-#     },
-#     "Extracting EPA PPRTVs."
-#   )
+  ids_search <- c("Ace", "Acetophenone")
 
-#   tmp_out <- file.path(temp_dir, "R", "extractox")
-#   cache_exist <- file.exists(file.path(tmp_out, "epa_pprtvs.rds"))
+  expect_message(
+    {
+      out <- extr_pprtv(
+        ids = ids_search,
+        search_type = "name",
+        force = TRUE,
+        verbose = TRUE
+      )
+    },
+    "Extracting EPA PPRTVs."
+  )
 
-#   expect_equal(nrow(out), 11)
-# })
+  expect_equal(nrow(out), 11)
+})