Merge pull request #35 from pepijn-devries/work-in-progress

Switch to httr2; Switch to native pipe; Some check functions; Some mi…

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: ECOTOXr
 Type: Package
 Title: Download and Extract Data from US EPA's ECOTOX Database
-Version: 1.0.8
-Date: 2024-01-01
+Version: 1.0.9
+Date: 2024-01-07
 Authors@R: c(person("Pepijn", "de Vries", role = c("aut", "cre", "dtc"),
     email = "[email protected]",
     comment = c(ORCID = "0000-0002-7961-6646")))
@@ -16,13 +16,13 @@ Description: The US EPA ECOTOX database is a freely available database
     in R. To this end, all raw tables are downloaded from the EPA website
     and stored in a local SQLite database.
 Depends:
-    R (>= 3.5.0),
+    R (>= 4.1.0),
     RSQLite (>= 2.3.4)
 Imports:
     crayon (>= 1.5.2),
     dbplyr (>= 2.4.0),
     dplyr (>= 1.1.4),
-    httr (>= 1.4.7),
+    httr2 (>= 1.0.0),
     jsonlite (>= 1.8.8),
     lifecycle (>= 1.0.4),
     purrr (>= 1.0.2),

NAMESPACE

@@ -12,11 +12,12 @@ S3method(as.list,cas)
 S3method(c,cas)
 S3method(format,cas)
 S3method(print,cas)
-export("%>%")
 export(as.cas)
 export(build_ecotox_sqlite)
 export(cas)
 export(check_ecotox_availability)
+export(check_ecotox_build)
+export(check_ecotox_version)
 export(cite_ecotox)
 export(dbConnectEcotox)
 export(dbDisconnectEcotox)
@@ -38,12 +39,12 @@ importFrom(RSQLite,dbConnect)
 importFrom(RSQLite,dbDisconnect)
 importFrom(RSQLite,dbExecute)
 importFrom(RSQLite,dbWriteTable)
-importFrom(dplyr,"%>%")
 importFrom(dplyr,collect)
 importFrom(dplyr,inner_join)
 importFrom(dplyr,left_join)
 importFrom(dplyr,select)
 importFrom(dplyr,sql)
 importFrom(dplyr,tbl)
 importFrom(lifecycle,badge)
+importFrom(rlang,"!!!")
 importFrom(rlang,":=")

NEWS.md

@@ -1,6 +1,11 @@
-ECOTOXr v1.0.8 (Release date: 2024-01-01)
+ECOTOXr v1.0.9 (Release date: 2024-01-07)
 -------------
 
+  * switched from the 'magrittr' pipe operator ('%>%')
+    to R's native pipe operator ('|>')
+  * switched from 'httr' to 'httr2' dependency
+  * Added functions to check the local build
+    and its version
   * Fix in database build routine
   * Fix in manual to pass CRAN checks
   * Explicit mentioning of required versions

R/database_access.r

@@ -181,3 +181,129 @@ list_ecotox_fields <- function(which = c("default", "extended", "full", "all"),
                              "dose_response_links", "dose_stat_method_codes"))]
   return(result)
 }
+
+#' Check the locally build database for validity
+#'
+#' `r lifecycle::badge('stable')` Performs some simple tests to check whether the
+#' locally built database is not corrupted.
+#'
+#' For now this function tests if all expected tables are present in the locally built
+#' database. Note that in later release of the database some tables were added. Therefore
+#' for older builds this function might return `FALSE` whereas it is actually just fine
+#' (just out-dated).
+#'
+#' Furthermore, this function tests if all tables contain one or more records. Obviously,
+#' this is no guarantee that the database is valid, but it is a start.
+#' 
+#' More tests may be added in future releases.
+#' @inheritParams dbConnectEcotox
+#' @returns Returns an indicative logical value whether the database is not corrupted.
+#' `TRUE` indicates the database is most likely OK. `FALSE` indicates that something might
+#' be wrong. Additional messages (when `FALSE`) are included as attributes containing hints
+#' on the outcoming of the tests. See also the 'details' section.
+#' @rdname check_ecotox_build
+#' @name check_ecotox_build
+#' @examples
+#' \dontrun{
+#' check_ecotox_build()
+#' }
+#' @author Pepijn de Vries
+#' @export
+check_ecotox_build <- function(path = get_ecotox_path(), version, ...) {
+  validity <- TRUE
+  con <- tryCatch({
+    dbConnectEcotox(path, version, ...)
+  }, error = function(e) NULL)
+  if (is.null(con)) {
+    validity <- FALSE
+    attr(validity, "reasons") <-
+      c(attr(validity, "reasons"), "Cannot connect with 'target' and 'version'.")
+  } else {
+    tables <- RSQLite::dbListTables(con)
+    missing_tables <- .db_specs$table[!.db_specs$table %in% tables]
+    if (length(missing_tables) > 0) {
+      validity <- FALSE
+      attr(validity, "reasons") <-
+        c(attr(validity, "reasons"),
+          sprintf("The following tables were missing: %s",
+                  paste0(missing_tables, collapse = "; ")))
+    } else {
+      for (tab in tables) {
+        n <- dplyr::tbl(con, tab) |> dplyr::summarise(n = dplyr::n()) |> dplyr::pull("n")
+        if (n == 0) {
+          validity <- FALSE
+          attr(validity, "reasons") <-
+            c(attr(validity, "reasons"),
+              "One or more tables have no records")
+          break
+        }
+      }
+    }
+    dbDisconnect(con)
+  }
+  return (validity)
+}
+
+#' Check if the locally build database is up to date
+#'
+#' `r lifecycle::badge('stable')` Checks the version of the database available on-line
+#' from the EPA against the specified version (latest by default) of the database build
+#' locally. Returns `TRUE` when they are the same.
+#'
+#' @inheritParams get_ecotox_sqlite_file
+#' @param verbose A `logical` value. If true messages are shown on the console reporting
+#' on the check.
+#' @returns Returns a `logical` value invisibly indicating whether the locally build
+#' is up to date with the latest release by the EPA.
+#' @rdname check_ecotox_version
+#' @name check_ecotox_version
+#' @examples
+#' \dontrun{
+#' check_ecotox_version()
+#' }
+#' @author Pepijn de Vries
+#' @export
+check_ecotox_version <- function(path = get_ecotox_path(), version, verbose = TRUE) {
+  u <-
+    get_ecotox_url() |>
+    basename() |>
+    stringr::str_extract("(?<=^ecotox_ascii_)(.*?)(?=\\.zip$)") |>
+    as.Date(format = "%m_%d_%Y")
+
+  available <- check_ecotox_availability(path)
+  if (!available) {
+    if (verbose) {
+      message(crayon::red(
+        "No databased present at the specified path"
+      ))
+    }
+    return(invisible(FALSE))
+  }
+  f <-
+    get_ecotox_sqlite_file(path, version)  |>
+    basename() |>
+    stringr::str_extract("(?<=^ecotox_ascii_)(.*?)(?=\\.sqlite$)") |>
+    as.Date(format = "%m_%d_%Y")
+  result <- f == u
+  if (verbose) {
+    if (result) {
+      message(crayon::green(
+        paste("The locally build database represents",
+              "the latest available EPA release",
+              format(f, format = "(%Y-%m-%d). You are up to date."),
+              sep = "\n")))
+    } else if (f < u) {
+      message(crayon::red(
+        paste(format(f, "The locally build database (%Y-%m-%d) represents"),
+              format(u, "an older EPA release (%Y-%m-%d). Please download"),
+              "and build the latest relase if you.",
+              "wish to be up to date.", sep = "\n")))
+    } else if (f > u) {
+      message(crayon::red(
+        paste(format(f, "You have installed a future release (%Y-%m-%d)"),
+              format(u, "of the EPA database (%Y-%m-%d). Are you a time"),
+              "traveller?", sep = "\n")))
+    }
+  }
+  return(invisible(result))
+}