Fine tuning

.gitignore

@@ -6,4 +6,3 @@
 .quarto
 /docs/*
 /pkgdown/*
-*.png

NAMESPACE

@@ -1,16 +1,17 @@
 # Generated by roxygen2: do not edit by hand
 
-export(add_entry_tbl)
+export(bulk_insert_entry)
 export(check_fields_exist)
 export(check_fields_notnulls)
 export(check_fields_pkeys)
-export(delete_entry_tbl)
+export(delete_entry)
 export(detect_cens)
 export(get_tbl_info)
 export(get_tbl_notnulls)
 export(get_tbl_pkeys)
 export(init_con)
-export(modify_entry_tbl)
+export(insert_entry)
+export(modify_entry)
 export(remove_cens)
 export(search_tbl)
 export(uncensored)

R/data.R

@@ -9,3 +9,9 @@
 #' A simple data.frame which contains example of table returned by get_tbl_info for testing purpose
 #'
 "tbl_info_test"
+
+#' Table for bulk insert test
+#'
+#' A simple data.frame for bulk insert entry
+#'
+"bulk_insert_test"

R/db_check_misc.R

@@ -12,9 +12,9 @@
 #' 
 check_fields_exist <- function(con, tbl, fields){
     columns <- get_tbl_info(con, tbl = tbl) |> dplyr::pull(name)
-    if(!all(names(fields) %in% columns)){
-        unknown_fields <- names(fields)[which(!names(fields) %in% columns)] |>
-            glue::glue_collapse(", ", last = "and")
+    if(!all(fields %in% columns)){
+        unknown_fields <- fields[which(!fields %in% columns)] |>
+            glue::glue_collapse(", ", last = " and ")
         cli::cli_abort("Fields { unknown_fields } is/are not present in table { tbl }")       
     }
 }
@@ -34,7 +34,7 @@ check_fields_exist <- function(con, tbl, fields){
 check_fields_pkeys <- function(con, tbl, fields){
     pkeys <- get_tbl_pkeys(con, tbl = tbl)
 
-    if(!all(pkeys %in% names(fields))){
+    if(!all(pkeys %in% fields)){
         missing_pkeys <- pkeys[which(!pkeys %in% fields)] |>
             glue::glue_collapse(", ", last = "and")
         cli::cli_abort("Primary key(s) { missing_pkeys } is/are missing")
@@ -56,7 +56,7 @@ check_fields_pkeys <- function(con, tbl, fields){
 check_fields_notnulls <- function(con, tbl, fields){
     notnulls <- get_tbl_notnulls(con, tbl = tbl)
 
-    if(!all(notnulls %in% names(fields))){
+    if(!all(notnulls %in% fields)){
         missing_fields <- notnulls[which(!notnulls %in% fields)] |>
             glue::glue_collapse(", ", last = "and")
         cli::cli_abort("{ missing_fields } cannot be null(s)")

R/db_search.R

@@ -3,6 +3,7 @@
 #' @param con connexion object returned by DBI::dbConnect()
 #' @param tbl a character name of the table
 #' @param ... table fields with search value
+#' @param nfetch data fetch size (default = 100)
 #' 
 #' @return
 #' A data.frame with query results
@@ -13,14 +14,10 @@
 #' }
 #' @export
 #' 
-search_tbl <- function(con = NULL, tbl = NULL,...){
+search_tbl <- function(con = NULL, tbl = NULL, ..., nfetch = 100){
 
     fields <- list(...)
-    tbl_fields <- DBI::dbListFields(con, tbl)
-
-    # Safety assertions
-    stopifnot(!any(names(fields) |> is.null()))
-    stopifnot(all(names(fields) %in% tbl_fields))
+    check_fields_exist(con, tbl, names(fields))
 
     search_criterias <- purrr::map2(names(fields), fields, \(n, p){
         if(length(p) > 1L){
@@ -31,12 +28,11 @@ search_tbl <- function(con = NULL, tbl = NULL,...){
     }) |> glue::glue_sql_collapse(" OR ")
 
     query <- glue::glue_sql("SELECT * FROM { tbl } WHERE { search_criterias };", .con = con)
-
     res <- DBI::dbSendQuery(con, query)
 
     entries <- list()
     while (!DBI::dbHasCompleted(res)) {
-        entries[[length(entries)+1]] <- DBI::dbFetch(res, 100)
+        entries[[length(entries)+1]] <- DBI::dbFetch(res, nfetch)
     }
     entries <- dplyr::bind_rows(entries)
 

R/db_tbl.R

@@ -6,33 +6,54 @@
 #'
 #' @export
 #' 
-add_entry_tbl <- function(con = NULL, tbl = NULL, ...){
+insert_entry <- function(con = NULL, tbl = NULL, ...){
     fields <- list(...)
 
-    check_fields_exist(con, tbl, fields)
-    check_fields_pkeys(con, tbl, fields)
-    check_fields_notnulls(con, tbl, fields)
+    check_fields_exist(con, tbl, names(fields))
+    check_fields_pkeys(con, tbl, names(fields))
+    check_fields_notnulls(con, tbl, names(fields))
 
     ddl <- glue::glue_sql("INSERT INTO { tbl } ({ names(fields)* }) VALUES ({ fields* });", .con = con)
-    res <- DBI::dbSendStatement(con, ddl)
+    res <- DBI::dbSendStatement(con, ddl) 
 
     on.exit(DBI::dbClearResult(res))
 }
 
-#' @describeIn add_entry_tbl Modify entry within specified table.
+#' Add entry within specified table
+#'
+#' @param con connexion object returned by DBI::dbConnect()
+#' @param tbl a character name of the table
+#' @param data a data.frame
+#'
+#' @export
+#' 
+bulk_insert_entry <- function(con = NULL, tbl = NULL, data = NULL){
+    tryCatch({
+        RSQLite::dbBegin(con, name = "bulk_insert")
+        purrr::pmap(data, ~with(list(...),{
+            insert_entry(con = con, tbl = tbl,...)
+        }))
+        RSQLite::dbCommit(con, name = "bulk_insert")
+    }, error = \(e){
+        RSQLite::dbRollback(con, name = "bulk_insert")
+        cli::cli_abort(e)
+    })
+}
+
+#' @describeIn insert_entry Modify entry within specified table.
 #' @export
 #' 
-modify_entry_tbl <- function(con = NULL, tbl = NULL, ...){
+modify_entry <- function(con = NULL, tbl = NULL, ...){
     fields <- list(...)
 
-    check_fields_exist(con, tbl, fields)
-    check_fields_pkeys(con, tbl, fields)
+    check_fields_exist(con, tbl, names(fields))
+    check_fields_pkeys(con, tbl, names(fields))
 
     pkeys_tbl <- get_tbl_pkeys(con, tbl)
     target_row <- do.call("search_tbl", list(con = con, tbl = tbl) |> append(fields[pkeys_tbl]))
 
     if(nrow(target_row) > 1L){
-        cli::cli_abort("Error: More than one row found with { fields[pkeys_tbl] }")
+        cli::cli_abort("More than one row found with { fields[pkeys_tbl] }")
     } else {
 
         pkeys_values <- fields[which(names(fields) %in% pkeys_tbl)]
@@ -59,20 +80,20 @@ modify_entry_tbl <- function(con = NULL, tbl = NULL, ...){
     }
 }
 
-#' @describeIn add_entry_tbl Delete entry within specified table.
+#' @describeIn insert_entry Delete entry within specified table.
 #' @export
 #' 
-delete_entry_tbl <- function(con = NULL, tbl = NULL, ...){
+delete_entry <- function(con = NULL, tbl = NULL, ...){
     fields <- list(...)
 
-    check_fields_exist(con, tbl, fields)
-    check_fields_pkeys(con, tbl, fields)
+    check_fields_exist(con, tbl, names(fields))
+    check_fields_pkeys(con, tbl, names(fields))
 
     pkeys_tbl <- get_tbl_pkeys(con, tbl)
     target_row <- do.call("search_tbl", list(con =  con, tbl = tbl) |> append(fields[pkeys_tbl]))
 
     if(nrow(target_row) > 1L){
-        cli::cli_abort("Error: More than one row found with { fields[pkeys_tbl] }")
+        cli::cli_abort("More than one row found with { fields[pkeys_tbl] }")
     } else {
         criterias <- purrr::map(names(fields[pkeys_tbl]), \(n){
             glue::glue("{n} = ${n}")

README.md

@@ -13,12 +13,7 @@ You can install the development version of toxbox from [GitHub](https://github.c
 devtools::install_github("ECCC-lavoie-ecotox/toxbox")
 ```
 
-## Example
+## Read the documentation
 
-This is a basic example which shows you how to solve a common problem:
-
-``` r
-library(toxbox)
-## basic example code
-```
+All functions are documented at this address: https://eccc-lavoie-ecotox.github.io/toxbox
 

tests/testthat/test-info_misc.R → tests/testthat/test-check_misc.R

@@ -23,6 +23,16 @@ test_that("get_tbl_notnulls() success", {
     withr::deferred_run()     
 })
 
+test_that("check_fields_exist() error", {
+    con <- test_db()
+    mockery::stub(check_fields_exist, "get_tbl_info", tbl_info_test)
+    testthat::expect_error(
+        check_fields_exist(con, "species", "test"), 
+        "Fields test is/are not present in table species", fixed = TRUE
+    )
+    withr::deferred_run()     
+})
+
 test_that("check_fields_notnulls() error", {
     con <- test_db()
     mockery::stub(check_fields_notnulls, "get_tbl_notnulls", "species")  

tests/testthat/test-db_tbl.R

@@ -1,9 +1,10 @@
 context("Add, delete, update entries in table")
 
-test_that("add_entry_tbl() success", {
+test_that("insert_entry() success", {
 
     con <- test_db()
-    add_entry_tbl(
+
+    insert_entry(
         con = con, 
         tbl = "species", 
         species_id = "TSN", 
@@ -20,40 +21,10 @@ test_that("add_entry_tbl() success", {
     withr::deferred_run()
 })
 
-
-test_that("add_entry_tbl() with missing pkeys", {
-    con <- test_db()
-
-    testthat::expect_error(
-        add_entry_tbl(
-            con = con, 
-            tbl = "species", 
-            genus = "Lupus",
-            species = "Lupus lupus"
-    ), "Primary key(s) species_id is/are missing", fixed = TRUE)
-
-    withr::deferred_run()
-})
-
-test_that("add_entry_tbl() with not null contraint ", {
-    con <- test_db()
-
-    testthat::expect_error(
-        add_entry_tbl(
-            con = con, 
-            tbl = "species", 
-            species_id = "TSN", 
-            genus = "Lupus"
-    ), "species cannot be null(s)", fixed = TRUE)
-
-    withr::deferred_run()
-})
-
-
-test_that("delete_entry_tbl() success", {
+test_that("delete_entry() success", {
     con <- test_db(mockData = TRUE)
 
-    delete_entry_tbl(
+    delete_entry(
         con = con, 
         tbl = "species",
         species_id = "TSN"
@@ -65,10 +36,10 @@ test_that("delete_entry_tbl() success", {
     withr::deferred_run()
 })
 
-test_that("modify_entry_tbl() success", {
+test_that("modify_entry() success", {
     con <- test_db(mockData = TRUE)
 
-    modify_entry_tbl(
+    modify_entry(
         con = con, 
         tbl = "species",
         species_id = "TSN",