Re-jigged the class implementation to get better support from roxygen2 and CRAN check(). Majority of public functions are documented (remaining are the CRUD functions)

DESCRIPTION

@@ -14,6 +14,9 @@ Imports:
     dbplyr,
     dplyr,
     R6,
+    rlang,
     tibble
 Suggests:
+    RMariaDB,
+    RPostgres,
     sf

NAMESPACE

@@ -2,3 +2,7 @@
 
 export(DBClient)
 export(DBConnection)
+import(R6)
+importFrom(R6,R6Class)
+importFrom(rlang,":=")
+importFrom(rlang,.data)

R/DBClient-CRUDKeys.R

@@ -1,18 +1,14 @@
 keyExists <- function(table_name, key_name, id) {
   key <- dbplyr::ident(key_name)
-  res <- self$table(table_name) %>%
+  tbl <- self$table(table_name)
-    dplyr::filter(key == !!id) %>%
+  res <- dplyr::pull(dplyr::count(dplyr::filter(tbl, key == !!id)), .data$n)
-    dplyr::count() %>%
+  res[[1]] > 0
-    dplyr::pull(n)
-  return(res[[1]] > 0)
 }
 
 selectByKey <- function(table_name, key_name, id) {
   key <- dbplyr::ident(key_name)
-  res <- self$table(table_name) %>%
+  tbl <- self$table(table_name)
-    dplyr::filter(key %in% !!id) %>%
+  dplyr::collect(dplyr::filter(tbl, key %in% !!id))
-    dplyr::collect()
-  return(res)
 }
 
 insertByKey <- function(table_name, key_name, id, ...) {

R/DBClient-CRUDRows.R

@@ -75,13 +75,10 @@ upsertRows <- function(table_name, rows, key_name = NULL) {
 
   # NOTE: Temporary fix for issue: tidyverse/dbplyr#1279
   if ("MariaDBConnection" %in% class(private$client$getConnection())) {
-    keys <- rows %>%
+    keys <- dplyr::pull(rows, !!key_name)
-      dplyr::pull(!!key_name)
+    tbl_keys <- dplyr::select(tbl, !!key_name)
-    n_rows <- tbl %>%
+    filt_rows <- dplyr::filter(tbl_keys, !!as.symbol(key_name) %in% !!keys)
-      dplyr::select(!!key_name) %>%
+    n_rows <- dplyr::pull(dplyr::count(filt_rows), .data$n)
-      dplyr::filter(!!as.symbol(key_name) %in% !!keys) %>%
-      dplyr::count() %>%
-      dplyr::pull(n)
     if (n_rows == 0) {
       return(insertRows(table_name, rows, key_name))
     } else {

R/DBClient-Initialize.R

@@ -0,0 +1,29 @@
+conn <- NULL
+
+#' @name DBClient$initialize
+#' @title DBClient$initialize
+#' @description
+#' Initalises the DBClient instance with a DBConnection
+#' @param conn <DBConnection> An instance of DBConnection
+NULL
+initialize <- function(conn) {
+  if (is.null(conn) || !R6::is.R6(conn) || !inherits(conn, "DBConnection")) {
+  	stop("DBConnection instance required!")
+  }
+  private$conn <- conn
+}
+
+
+#' @name DBClient$getConnection
+#' @title DBClient$getConnection
+#' @description
+#' Returns the DBConnection instance for this client
+NULL
+getConnection <- function() {
+  private$conn
+}
+
+
+.getDBConn <- function() {
+  private$conn$getConnection()
+}

R/DBClient-dbAction.R

@@ -0,0 +1,14 @@
+
+#' @name DBClient$dbAction
+#' @title DBClient$dbAction
+#' @description
+#' Executes a query/statement on a database which has no result
+#' @param statement <character> Statement to run
+#' @returns <logical> TRUE if the execution was successful, FALSE if not
+NULL
+dbAction <- function(statement) {
+  if (getOption("db.debug", FALSE)) {
+    cat("dbQuery:", statement, "\n")
+  }
+  DBI::dbExecute(private$getConn(), statement)
+}

R/DBClient-dbCollect.R

@@ -0,0 +1,84 @@
+
+#' @name DBClient$collectOrReturn
+#' @title DBClient$collectOrReturn
+#' @description
+#' Utility method which returns the query and optionally runs dplyr::collect on
+#' it first.
+#' @param qry <character> A dplyr query
+#' @param collect <logical> Collect the query. Defaults to checking parent frame
+#'    for the parameter value
+#' @returns <complex> The query, optionally collect'd
+NULL
+collectOrReturn <- function(
+  qry, collect = get("collect", pos = parent.frame())
+) {
+  res <- qry
+  if (length(collect) == 1 && collect[[1]] == TRUE) {
+    res <- dplyr::collect(res)
+  }
+  res
+}
+
+
+#' @name DBClient$collectGeometries
+#' @title DBClient$collectGeometries
+#' @description
+#' Requires sf package.
+#'
+#' Runs dplyr::collect on a query, If there are gemoetry columns (specified by
+#' gemoetry_cols or named geom or named proj) then they are translated into sf
+#' geometry columns using sf::st_as_sfc with a CRS.
+#'
+#' The default CRS for a column named `geom` is 4326.
+#' The default CRS for a column named `proj` is 3035.
+#' The default CRS for other geometry columns is specified by `geometry_crs`
+#'
+#' @param qry <complex> The query to collect
+#' @param geometry_cols <character> Any geometry columns to translate to sf
+#' @param geometry_crs <complex> The CRS to assign to the columns. Either
+#'     specified by the CRS number or an sf::st_crs() object.
+#' @param check_ring_dir <logical> Check the direction of rings during the
+#'     translation. See `sf::st_as_sfc` for further details.
+#' @returns <complex> The collected query with translated geometry columns
+NULL
+collectGeometries <- function(
+  qry, geometry_cols = c("geometry"), geometry_crs = 4326, check_ring_dir = TRUE
+) {
+  requireNamespace("sf")
+
+  res <- dplyr::collect(qry)
+
+  if (sum(geometry_cols %in% colnames(res)) > 0) {
+    res <- dplyr::mutate(
+        res,
+        dplyr::across(dplyr::any_of(geometry_cols), function(.col) {
+          sf::st_as_sfc(
+            .col,
+            EWKB = TRUE,
+            crs = geometry_crs,
+            check_ring_dir = check_ring_dir
+          )
+        })
+      )
+  }
+
+  if ("geom" %in% colnames(res) && sum("geom" %in% geometry_cols) == 0) {
+    res <- dplyr::mutate(
+        res,
+        geom = sf::st_as_sfc(
+          .data$geom, EWKB = TRUE, crs = 4326, check_ring_dir = check_ring_dir
+        )
+      )
+  }
+
+  if ("proj" %in% colnames(res) && sum("proj" %in% geometry_cols) == 0) {
+    res <- dplyr::mutate(
+        res,
+        proj = sf::st_as_sfc(
+          .data$proj, EWKB = TRUE, crs = 3035, check_ring_dir = check_ring_dir
+        )
+      )
+  }
+
+  res
+}

R/DBClient-dbQuery.R

@@ -0,0 +1,17 @@
+
+#' @name DBClient$dbQuery
+#' @title DBClient$dbQuery
+#' @description
+#' Runs a query (statement) on a database and returns the results
+#' @param statement <character> Query to run on the database
+#' @returns <complex> A lazy data table with the results from the query
+NULL
+dbQuery <- function(statement) {
+  if (getOption("db.debug", FALSE)) {
+    cat("dbQuery:", statement, "\n")
+  }
+  query <- DBI::dbSendQuery(private$getConn(), statement)
+  res <- DBI::dbFetch(query)
+  DBI::dbClearResult(query)
+  res
+}

R/DBClient-dbSchema.R

@@ -0,0 +1,39 @@
+
+#' @name DBClient$withSchema
+#' @title DBClient$withSchema
+#' @description
+#' Prefixes schema to the table name, if set in the configuration.
+#' @param table_name <character> Table name to prefix schema to
+#' @returns <character> Table name with prefixed schema
+NULL
+withSchema <- function(table_name) {
+  config <- private$conn$getConfiguration()
+  if (exists("schema", config)) {
+    return(DBI::dbQuoteIdentifier(
+      private$getConn(), DBI::Id(schema = config$schema, table = table_name)
+    ))
+  } else {
+    return(DBI::dbQuoteIdentifier(
+      private$getConn(), DBI::Id(table = table_name)
+    ))
+  }
+}
+
+
+#' @name DBClient$dplyrWithSchema
+#' @title DBClient$dplyrWithSchema
+#' @description
+#' Prefixes schema to the table name, if set in the configuration. Specifically
+#' uses the dbplyr::in_schema method rather than the direct
+#' DBI::dbQuoteIdentifier method.
+#' @param table_name <character> Table name to prefix schema to
+#' @returns <character> Table name with prefixed schema
+NULL
+dplyrWithSchema <- function(table_name) {
+  config <- private$conn$getConfiguration()
+  if (exists("schema", config) && !is.null(config$schema)) {
+    return(dbplyr::in_schema(config$schema, table_name))
+  } else {
+    return(table_name)
+  }
+}

R/DBClient-dbTable.R

@@ -0,0 +1,14 @@
+
+#' @name DBClient$table
+#' @title DBClient$table
+#' @description
+#' Creates a `dplyr::tbl` instantiation with the current database connection.
+#' @param table_name <character> The database table name
+#' @returns <complex> A dplyr::tbl instance
+NULL
+table <- function(table_name) {
+  if (getOption("db.debug", FALSE)) {
+    cat("dbTable:", table_name, "\n")
+  }
+  dplyr::tbl(private$getConn(), self$dplyrWithSchema(table_name))
+}

R/DBClient-dbTransaction.R

@@ -0,0 +1,15 @@
+
+#' @name DBClient$withTransaction
+#' @title DBClient$withTransaction
+#' @description
+#' Runs a given expression within a database transaction.
+#' @param expr <expression> Expression to run in a transaction
+#' @returns <logical> TRUE if transaction was successful
+NULL
+withTransaction <- function(expr) {
+  private$conn$beginTransaction()
+  on.exit(private$conn$rollbackTransaction())
+  expr
+  on.exit()
+  private$conn$commitTransaction()
+}

R/DBClient.R

@@ -1,13 +1,12 @@
 
 class_env <- new.env(parent = baseenv())
 
-res <- lapply(list.files("R/DBClientClass", pattern = ".R"), function(fn) {
+res <- lapply(
-  eval(
+  list.files("R", pattern = "DBClient-.*\\.R"),
-    parse(paste0("R/DBClientClass/", fn)),
+  function(fn) {
-    envir = class_env,
+    eval(parse(paste0("R/", fn)), envir = class_env, enclos = emptyenv())
-    enclos = emptyenv()
+  }
-  )
+)
-})
 
 fn_names <- names(which(vapply(class_env, is.function, logical(1))))
 fn_list <- lapply(fn_names, function(fn_name) {

R/DBClientClass/Initialize.R

@@ -1,8 +0,0 @@
-client <- NULL
-
-Initialize <- function(client) {
-  if (is.null(client) || !is.R6(client) || inherits(client, "DBClient")) {
-  	stop("DBClient instance required!")
-  }
-  private$client <- client
-}

R/DBClientClass/dbAction.R

@@ -1,6 +0,0 @@
-dbAction <- function(statement) {
-  if (getOption("db.debug", FALSE)) {
-    cat("dbQuery:", statement, "\n")
-  }
-  DBI::dbExecute(private$client$getConnection(), statement)
-}

R/DBClientClass/dbCollect.R

@@ -1,52 +0,0 @@
-collectOrReturn <- function(
-  qry, collect = get("collect", pos = parent.frame())
-) {
-  if (length(collect) == 1 && collect[[1]] == TRUE) {
-    return(dplyr::collect(qry))
-  } else {
-    return(qry)
-  }
-}
-
-collectGeometries <- function(
-  qry, geometry_cols = c("geometry"), geometry_crs = 4326, check_ring_dir = TRUE
-) {
-  requireNamespace("sf")
-
-  qry <- qry %>%
-    dplyr::collect()
-
-  if (sum(geometry_cols %in% colnames(qry)) > 0) {
-    qry <- qry %>%
-      dplyr::mutate(
-        dplyr::across(dplyr::any_of(geometry_cols), function(.col) {
-          sf::st_as_sfc(
-            .col,
-            EWKB = TRUE,
-            crs = geometry_crs,
-            check_ring_dir = check_ring_dir
-          )
-        })
-      )
-  }
-
-  if ("geom" %in% colnames(qry) && sum("geom" %in% geometry_cols) == 0) {
-    qry <- qry %>%
-      dplyr::mutate(
-        geom = sf::st_as_sfc(
-          geom, EWKB = TRUE, crs = 4326, check_ring_dir = check_ring_dir
-        )
-      )
-  }
-
-  if ("proj" %in% colnames(qry) && sum("proj" %in% geometry_cols) == 0) {
-    qry <- qry %>%
-      dplyr::mutate(
-        proj = sf::st_as_sfc(
-          proj, EWKB = TRUE, crs = 3035, check_ring_dir = check_ring_dir
-        )
-      )
-  }
-
-  return(qry)
-}

R/DBClientClass/dbQuery.R

@@ -1,9 +0,0 @@
-dbQuery <- function(statement) {
-  if (getOption("db.debug", FALSE)) {
-    cat("dbQuery:", statement, "\n")
-  }
-  query <- DBI::dbSendQuery(private$client$getConnection(), statement)
-  res <- DBI::dbFetch(query)
-  DBI::dbClearResult(query)
-  res
-}

R/DBClientClass/dbSchema.R

@@ -1,21 +0,0 @@
-withSchema <- function(table_name) {
-  config <- private$client$getConfiguration()
-  if (exists("schema", config)) {
-    return(DBI::dbQuoteIdentifier(
-      getConnection(), DBI::Id(schema = config$schema, table = table_name)
-    ))
-  } else {
-    return(DBI::dbQuoteIdentifier(
-      getConnection(), DBI::Id(table = table_name)
-    ))
-  }
-}
-
-dplyrWithSchema <- function(table_name) {
-  config <- private$client$getConfiguration()
-  if (exists("schema", config) && !is.null(config$schema)) {
-    return(dbplyr::in_schema(config$schema, table_name))
-  } else {
-    return(table_name)
-  }
-}

R/DBClientClass/dbTable.R

@@ -1,7 +0,0 @@
-
-table <- function(table_name) {
-  if (getOption("db.debug", FALSE)) {
-    cat("dbTable:", table_name, "\n")
-  }
-  dplyr::tbl(private$client$getConnection(), self$dplyrWithSchema(table_name))
-}

R/DBClientClass/dbTransaction.R

@@ -1,8 +0,0 @@
-
-withTransaction <- function(expr) {
-  private$client$beginTransaction()
-  on.exit(private$client$rollbackTransaction())
-  expr
-  on.exit()
-  private$client$commitTransaction()
-}

R/DBConnection-Configure.R

@@ -0,0 +1,141 @@
+config <- NULL
+
+.configureList <- function(db) {
+  was_connected <- FALSE
+  if (!is.null(private$conn)) {
+    was_connected <- TRUE
+    self$disconnect()
+  }
+
+  private$config <- db
+
+  if (was_connected) {
+    self$connect()
+  }
+
+  invisible(private$config)
+}
+
+#' Configures the DBClient instance.
+#'
+#' There are 2 options for configuration, either: pass in a named list; or use
+#' named parameters.
+#'
+#' @param engine The database engine (mysql, postgres) as supported by DBI
+#' @param host The database host
+#' @param port The database port
+#' @param user The database user to connect with
+#' @param password The database password to connect with
+#' @param dbname The database to use
+#' @param schema The database schema to use (postgres)
+#' @param autoconnect Autoconnect to the database if not already connected
+#' @param name The database to use (alternative to dbname)
+#'
+#' @returns The configuration accepted
+.configureDefault <- function(
+  host, port, user, password, dbname,
+  engine = NULL, name = NULL, schema = NULL, autoconnect = NULL
+) {
+  if (is.null(autoconnect)) {
+    autoconnect <- getOption("db.autoconnect", FALSE)
+  }
+  private$configureList(list(
+    engine = engine,
+    host = host,
+    port = port,
+    user = user,
+    password = password,
+    name = ifelse(is.null(name), dbname, name),
+    schema = schema,
+    autoconnect = autoconnect
+  ))
+}
+
+#' @name DBConnection$configure
+#' @title DBConnection$configure
+#' @description
+#' Configures the DBClient instance.
+#'
+#' There are 2 options for configuration, either: pass in a named list; or use
+#' named parameters.
+#'
+#' @param ... Named parameters for configuring the connection or a name list of
+#'    parameters
+#'
+#' @returns <list> The configuration that has loaded
+NULL
+configure <- function(...) {
+  args <- list(...)
+  if (sum("list" %in% class(args[[1]])) > 0) {
+    private$configureList(args[[1]])
+  } else {
+    do.call(private$configureDefault, args)
+  }
+}
+
+
+#' @name DBConnection$getConfiguration
+#' @title DBConnection$getConfiguration
+#' @description
+#' Get the current configuration of the DBClient instance.
+#' @returns <list> Current configuration. If not configured, NULL is returned
+NULL
+getConfiguration <- function() {
+  private$config
+}
+
+
+.loadConfigurationGlobalR <- function() {
+  if (!file.exists("global.R")) {
+    return(FALSE)
+  }
+  e <- new.env(parent = baseenv())
+  eval(parse("global.R"), envir = e)
+  if ("db" %in% ls(e)) {
+    self$configure(e$db)
+  } else if ("global" %in% ls(e)) {
+    self$configure(e$global$db)
+  } else {
+    return(FALSE)
+  }
+  TRUE
+}
+
+.loadConfigurationEnvR <- function() {
+  if (!file.exists(".env.R")) {
+    return(FALSE)
+  }
+  e <- new.env(parent = baseenv())
+  eval(parse(".env.R"), envir = e)
+  if ("db" %in% ls(e)) {
+    self$configure(e$db)
+  } else if ("global" %in% ls(e)) {
+    self$configure(e$global$db)
+  } else {
+    return(FALSE)
+  }
+  TRUE
+}
+
+#' @name DBConnection$loadConfiguration
+#' @title DBConnection$loadConfiguration
+#' @description
+#' Attempts to load the configuration either from global.R or .env.R.
+#' @param warn Emit a warning with which file it attempting to be loaded
+#' @returns <logical> TRUE if configuration was successful, FALSE otherwise
+NULL
+loadConfiguration <- function(warn = FALSE) {
+  if (file.exists("global.R")) {
+    if (warn != FALSE) {
+      warning("Attempting to load default configuration from global.R")
+    }
+    private$loadConfigurationGlobalR()
+  } else if (file.exists(".env.R")) {
+    if (warn != FALSE) {
+      warning("Attempting to load default configuration from .env.R")
+    }
+    private$loadConfigurationEnvR()
+  } else {
+    FALSE
+  }
+}

R/DBConnection-Connect.R

@@ -1,18 +1,16 @@
 conn <- NULL
 
+
+#' @name DBConnection$connect
+#' @title DBConnection$connect
+#' @description
+#' Attempts to connect to the database. If not already configured, will first
+#' attempt to load the configuration.
+#' @returns <logical> TRUE if connection was success, FALSE if it failed
+NULL
 connect <- function() {
   if (is.null(private$config)) {
-    if (!file.exists("global.R")) {
+    if (!self$loadConfiguration(warn = TRUE)) {
-      return(FALSE)
-    }
-    warning("Attempting to load default configuration from global.R")
-    e <- new.env(parent = baseenv())
-    eval(parse("global.R"), envir = e)
-    if ("db" %in% ls(e)) {
-      self$configure(e$db)
-    } else if ("global" %in% ls(e)) {
-      self$configure(e$global$db)
-    } else {
       return(FALSE)
     }
   }
@@ -54,9 +52,17 @@ connect <- function() {
     }
   )
 
-  return(res)
+  invisible(res)
 }
 
+
+#' @name DBConnection$getConnection
+#' @title DBConnection$getConnection
+#' @param do_connect <logical> Forcibly connect if not already connected
+#' @description
+#' Returns the DBConnection instance for this client.
+#' @returns <DBConnection> DBConnection instance
+NULL
 getConnection <- function(do_connect = NULL) {
   if (!self$isConnected()) {
     if ((!is.null(do_connect) && do_connect)
@@ -66,20 +72,43 @@ getConnection <- function(do_connect = NULL) {
       warning("Database is not connected. Caller of getConnection() may error.")
     }
   }
-  return(private$conn)
+  private$conn
 }
 
+
+#' @name DBConnection$isConnected
+#' @title DBConnection$isConnected
+#' @description
+#' Indicates if the instance has an active database connection.
+#' @returns <logical> TRUE if connected to the database, FALSE otherwise
+NULL
 isConnected <- function() {
-  return(!is.null(private$conn))
+  !is.null(private$conn)
 }
 
+
+#' @name DBConnection$disconnect
+#' @title DBConnection$disconnect
+#' @description
+#' Disconnects the current database connection, if connected.
+NULL
 disconnect <- function() {
   if (!is.null(private$conn)) {
     DBI::dbDisconnect(private$conn)
     private$conn <- NULL
   }
+  invisible(NULL)
 }
 
+
+#' @name DBConnection$disconnectOnSessionEnd
+#' @title DBConnection$disconnectOnSessionEnd
+#' @param session <complex> The R Shiny session to register the callback with
+#' @description
+#' Registers a callback with an R Shiny session so that the connection is
+#' disconnected once the session ends.
+#' @returns <function> A function to cancel the onSessionEnded callback
+NULL
 disconnectOnSessionEnd <- function(session) {
   session$onSessionEnded(self$disconnect)
 }

R/DBConnection-Initialize.R

@@ -0,0 +1,22 @@
+token <- NULL
+
+
+#' @name DBConnection$initialize
+#' @title DBConnection$initialize
+#' @aliases DBConnection$initialize
+#' @description
+#' Initalises the DBConnection instance with an identity token.
+NULL
+initialize <- function() {
+  private$token <- paste0(collapse = "", sample(c(LETTERS, 0:9), 16, TRUE))
+}
+
+
+#' @name DBConnection$getToken
+#' @title DBConnection$getToken
+#' @description
+#' Returns the identity token for this DBConnection instance.
+NULL
+getToken <- function() {
+  private$token
+}

R/DBConnection-Transaction.R

@@ -0,0 +1,69 @@
+transactionLevel <- 0
+
+
+#' @name DBConnection$beginTransaction
+#' @title DBConnection$beginTransaction
+#' @param session <complex> The R Shiny session to register the callback with
+#' @description
+#' Registers a callback with an R Shiny session so that the connection is
+#' disconnected once the session ends.
+#' @returns <function> A function to cancel the onSessionEnded callback
+NULL
+beginTransaction <- function(allowRecursive = FALSE, quietly = FALSE) {
+  if (private$transactionLevel > 0) {
+  	if (allowRecursive == FALSE) {
+  	  if (quietly != FALSE) {
+  	  	stop("Transaction already started. Aborting.")
+  	  }
+  	  return(FALSE)
+  	}
+  }
+  private$transactionLevel <- private$transactionLevel + 1
+  DBI::dbBegin(self$getConnection())
+}
+
+
+#' @name DBConnection$rollbackTransaction
+#' @title DBConnection$rollbackTransaction
+#' @param session <complex> The R Shiny session to register the callback with
+#' @description
+#' Registers a callback with an R Shiny session so that the connection is
+#' disconnected once the session ends.
+#' @returns <function> A function to cancel the onSessionEnded callback
+NULL
+rollbackTransaction <- function(quietly = FALSE) {
+  if (private$transactionLevel == 0) {
+    if (quietly != FALSE) {
+      stop("No transaction to rollback. Aborting.")
+    }
+    return(FALSE)
+  }
+  DBI::dbRollback(self$getConnection())
+}
+
+
+#' @name DBConnection$commitTransaction
+#' @title DBConnection$commitTransaction
+#' @param quietly <logical> If there is no transaction, will cause a `stop()`
+#'    if TRUE
+#' @description
+#' Commits the current database transaction. If nested, will not actually commit
+#' until the last level is committed.
+#'
+#' If `rollbackTransaction()`
+#'
+#' @returns <function> A function to cancel the onSessionEnded callback
+NULL
+commitTransaction <- function(quietly = FALSE) {
+  if (private$transactionLevel == 0) {
+    if (quietly != FALSE) {
+      stop("No transaction to commit. Aborting.")
+    }
+    return(FALSE)
+  }
+  private$transactionLevel <- private$transactionLevel - 1
+  if (transactionLevel > 0) {
+  	return(TRUE)
+  }
+  DBI::dbRollback(self$getConnection())
+}

R/DBConnection.R

@@ -1,13 +1,12 @@
 
 class_env <- new.env(parent = baseenv())
 
-res <- lapply(list.files("R/DBConnectionClass", pattern = ".R"), function(fn) {
+res <- lapply(
-  eval(
+  list.files("R", pattern = "DBConnection-.*\\.R"),
-    parse(paste0("R/DBConnectionClass/", fn)),
+  function(fn) {
-    envir = class_env,
+    eval(parse(paste0("R/", fn)), envir = class_env, enclos = emptyenv())
-    enclos = emptyenv()
+  }
-  )
+)
-})
 
 fn_names <- names(which(vapply(class_env, is.function, logical(1))))
 fn_list <- lapply(fn_names, function(fn_name) {
@@ -30,7 +29,8 @@ names(member_list) <- member_names
 
 #' @name DBConnection
 #' @title DBConnection
-#' @description Database Connection class
+#' @description
+#' Database Connection class.
 NULL
 
 #' @export

R/DBConnectionClass/Configure.R

@@ -1,68 +0,0 @@
-config <- NULL
-
-.configureList <- function(db) {
-  was_connected <- FALSE
-  if (!is.null(private$conn)) {
-    was_connected <- TRUE
-    disconnect()
-  }
-
-  private$config <- db
-
-  if (was_connected) {
-    connect()
-  }
-
-  return(invisible(private$config))
-}
-
-.configureDefault <- function(
-  host, port, user, password, dbname,
-  engine = NULL, name = NULL, schema = NULL, autoconnect = NULL
-) {
-  if (is.null(autoconnect)) {
-    autoconnect <- getOption("db.autoconnect", FALSE)
-  }
-  private$configureList(list(
-    engine = engine,
-    host = host,
-    port = port,
-    user = user,
-    password = password,
-    name = ifelse(is.null(name), dbname, name),
-    schema = schema,
-    autoconnect = autoconnect
-  ))
-}
-
-
-#' Configures the DBClient instance.
-#'
-#' There are 2 options for configuration, either: pass in a named list; or use
-#' named parameters. The required elements are:
-#'
-#' @param ... Named parameters for configuring the connection or a name list of
-#'    parameters
-#' @param engine The database engine (mysql, postgres) as supported by DBI
-#' @param host The database host
-#' @param port The database port
-#' @param user The database user to connect with
-#' @param password The database password to connect with
-#' @param dbname The database to use
-#' @param schema The database schema to use (postgres)
-#' @param autoconnect Autoconnect to the database if not already connected
-#'
-#' @return The configuration accepted
-configure <- function(...) {
-  args <- list(...)
-  if (sum("list" %in% class(args[[1]])) > 0) {
-    private$configureList(args[[1]])
-  } else {
-    do.call(private$configureDefault, args)
-  }
-}
-
-#' Get the current configuration of the DBClient instance.
-getConfiguration <- function() {
-  private$config
-}

R/DBConnectionClass/Transaction.R

@@ -1,39 +0,0 @@
-
-transactionLevel <- 0
-
-beginTransaction <- function(allowRecursive = FALSE, quietly = FALSE) {
-  if (private$transactionLevel > 0) {
-  	if (allowRecursive == FALSE) {
-  	  if (quietly != FALSE) {
-  	  	stop("Transaction already started. Aborting.")
-  	  }
-  	  return(FALSE)
-  	}
-  }
-  private$transactionLevel <- private$transactionLevel + 1
-  DBI::dbBegin(self$getConnection())
-}
-
-rollbackTransaction <- function(quietly = FALSE) {
-  if (private$transactionLevel == 0) {
-    if (quietly != FALSE) {
-      stop("No transaction to rollback. Aborting.")
-    }
-    return(FALSE)
-  }
-  DB::dbRollback(self$getConnection())
-}
-
-commitTransaction <- function(quietly = FALSE) {
-  if (private$transactionLevel == 0) {
-    if (quietly != FALSE) {
-      stop("No transaction to commit. Aborting.")
-    }
-    return(FALSE)
-  }
-  private$transactionLevel <- private$transactionLevel - 1
-  if (transactionLevel > 0) {
-  	return(TRUE)
-  }
-  DB::dbRollback(self$getConnection())
-}

R/PrintDebug.R

@@ -79,19 +79,14 @@ printDebug <- function(fn_name, table, key, tbl, rows, query_only = FALSE) {
   }
 
   return_keys <- NULL
-  if (key %in% colnames(rows)) {
+  if (!(key %in% colnames(rows))) {
-    return_keys <- rows %>%
+    rows <- dplyr::mutate(
-      dplyr::select(key)
+      dplyr::bind_rows(rows, tibble::tibble(!!key := character(0))),
-  } else {
-    return_keys <- rows %>%
-      dplyr::bind_rows(tibble::tibble(!!key := character(0))) %>%
-      dplyr::mutate(
       !!key := dplyr::coalesce(
         !!!dplyr::sym(key),
         paste0("<<NEW_ID::", round(stats::runif(1, 1, 100000)), ">>")
       )
-      ) %>%
+    )
-      dplyr::select(key)
   }
-  return(invisible(return_keys))
+  invisible(dplyr::select(rows, key))
 }

R/aaa.R

@@ -0,0 +1,8 @@
+if(getRversion() >= "2.15.1") utils::globalVariables(c("self"))
+if(getRversion() >= "2.15.1") utils::globalVariables(c("private"))
+
+#' @importFrom rlang :=
+#' @importFrom rlang .data
+#' @importFrom R6 R6Class
+#' @import R6
+NULL

man/DBClient-cash-collectGeometries.Rd

@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBClient-dbCollect.R
+\name{DBClient$collectGeometries}
+\alias{DBClient$collectGeometries}
+\title{DBClient$collectGeometries}
+\arguments{
+\item{qry}{\if{html}{\out{<complex>}} The query to collect}
+
+\item{geometry_cols}{\if{html}{\out{<character>}} Any geometry columns to translate to sf}
+
+\item{geometry_crs}{\if{html}{\out{<complex>}} The CRS to assign to the columns. Either
+specified by the CRS number or an sf::st_crs() object.}
+
+\item{check_ring_dir}{\if{html}{\out{<logical>}} Check the direction of rings during the
+translation. See \code{sf::st_as_sfc} for further details.}
+}
+\value{
+\if{html}{\out{<complex>}} The collected query with translated geometry columns
+}
+\description{
+Requires sf package.
+
+Runs dplyr::collect on a query, If there are gemoetry columns (specified by
+gemoetry_cols or named geom or named proj) then they are translated into sf
+geometry columns using sf::st_as_sfc with a CRS.
+
+The default CRS for a column named \code{geom} is 4326.
+The default CRS for a column named \code{proj} is 3035.
+The default CRS for other geometry columns is specified by \code{geometry_crs}
+}

man/DBClient-cash-collectOrReturn.Rd

@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBClient-dbCollect.R
+\name{DBClient$collectOrReturn}
+\alias{DBClient$collectOrReturn}
+\title{DBClient$collectOrReturn}
+\arguments{
+\item{qry}{\if{html}{\out{<character>}} A dplyr query}
+
+\item{collect}{\if{html}{\out{<logical>}} Collect the query. Defaults to checking parent frame
+for the parameter value}
+}
+\value{
+\if{html}{\out{<complex>}} The query, optionally collect'd
+}
+\description{
+Utility method which returns the query and optionally runs dplyr::collect on
+it first.
+}

man/DBClient-cash-dbAction.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBClient-dbAction.R
+\name{DBClient$dbAction}
+\alias{DBClient$dbAction}
+\title{DBClient$dbAction}
+\arguments{
+\item{statement}{\if{html}{\out{<character>}} Statement to run}
+}
+\value{
+\if{html}{\out{<logical>}} TRUE if the execution was successful, FALSE if not
+}
+\description{
+Executes a query/statement on a database which has no result
+}

man/DBClient-cash-dbQuery.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBClient-dbQuery.R
+\name{DBClient$dbQuery}
+\alias{DBClient$dbQuery}
+\title{DBClient$dbQuery}
+\arguments{
+\item{statement}{\if{html}{\out{<character>}} Query to run on the database}
+}
+\value{
+\if{html}{\out{<complex>}} A lazy data table with the results from the query
+}
+\description{
+Runs a query (statement) on a database and returns the results
+}

man/DBClient-cash-dplyrWithSchema.Rd

@@ -0,0 +1,16 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBClient-dbSchema.R
+\name{DBClient$dplyrWithSchema}
+\alias{DBClient$dplyrWithSchema}
+\title{DBClient$dplyrWithSchema}
+\arguments{
+\item{table_name}{\if{html}{\out{<character>}} Table name to prefix schema to}
+}
+\value{
+\if{html}{\out{<character>}} Table name with prefixed schema
+}
+\description{
+Prefixes schema to the table name, if set in the configuration. Specifically
+uses the dbplyr::in_schema method rather than the direct
+DBI::dbQuoteIdentifier method.
+}

man/DBClient-cash-getConnection.Rd

@@ -0,0 +1,8 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBClient-Initialize.R
+\name{DBClient$getConnection}
+\alias{DBClient$getConnection}
+\title{DBClient$getConnection}
+\description{
+Returns the DBConnection instance for this client
+}

man/DBClient-cash-initialize.Rd

@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBClient-Initialize.R
+\name{DBClient$initialize}
+\alias{DBClient$initialize}
+\title{DBClient$initialize}
+\arguments{
+\item{conn}{\if{html}{\out{<DBConnection>}} An instance of DBConnection}
+}
+\description{
+Initalises the DBClient instance with a DBConnection
+}

man/DBClient-cash-table.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBClient-dbTable.R
+\name{DBClient$table}
+\alias{DBClient$table}
+\title{DBClient$table}
+\arguments{
+\item{table_name}{\if{html}{\out{<character>}} The database table name}
+}
+\value{
+\if{html}{\out{<complex>}} A dplyr::tbl instance
+}
+\description{
+Creates a \code{dplyr::tbl} instantiation with the current database connection.
+}

man/DBClient-cash-withSchema.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBClient-dbSchema.R
+\name{DBClient$withSchema}
+\alias{DBClient$withSchema}
+\title{DBClient$withSchema}
+\arguments{
+\item{table_name}{\if{html}{\out{<character>}} Table name to prefix schema to}
+}
+\value{
+\if{html}{\out{<character>}} Table name with prefixed schema
+}
+\description{
+Prefixes schema to the table name, if set in the configuration.
+}

man/DBClient-cash-withTransaction.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBClient-dbTransaction.R
+\name{DBClient$withTransaction}
+\alias{DBClient$withTransaction}
+\title{DBClient$withTransaction}
+\arguments{
+\item{expr}{\if{html}{\out{<expression>}} Expression to run in a transaction}
+}
+\value{
+\if{html}{\out{<logical>}} TRUE if transaction was successful
+}
+\description{
+Runs a given expression within a database transaction.
+}

man/DBConnection-cash-beginTransaction.Rd

@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Transaction.R
+\name{DBConnection$beginTransaction}
+\alias{DBConnection$beginTransaction}
+\title{DBConnection$beginTransaction}
+\arguments{
+\item{session}{\if{html}{\out{<complex>}} The R Shiny session to register the callback with}
+}
+\value{
+\if{html}{\out{<function>}} A function to cancel the onSessionEnded callback
+}
+\description{
+Registers a callback with an R Shiny session so that the connection is
+disconnected once the session ends.
+}

man/DBConnection-cash-commitTransaction.Rd

@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Transaction.R
+\name{DBConnection$commitTransaction}
+\alias{DBConnection$commitTransaction}
+\title{DBConnection$commitTransaction}
+\arguments{
+\item{quietly}{\if{html}{\out{<logical>}} If there is no transaction, will cause a \code{stop()}
+if TRUE}
+}
+\value{
+\if{html}{\out{<function>}} A function to cancel the onSessionEnded callback
+}
+\description{
+Commits the current database transaction. If nested, will not actually commit
+until the last level is committed.
+
+If \code{rollbackTransaction()}
+}

man/DBConnection-cash-configure.Rd

@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Configure.R
+\name{DBConnection$configure}
+\alias{DBConnection$configure}
+\title{DBConnection$configure}
+\arguments{
+\item{...}{Named parameters for configuring the connection or a name list of
+parameters}
+}
+\value{
+\if{html}{\out{<list>}} The configuration that has loaded
+}
+\description{
+Configures the DBClient instance.
+
+There are 2 options for configuration, either: pass in a named list; or use
+named parameters.
+}

man/DBConnection-cash-connect.Rd

@@ -0,0 +1,12 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Connect.R
+\name{DBConnection$connect}
+\alias{DBConnection$connect}
+\title{DBConnection$connect}
+\value{
+\if{html}{\out{<logical>}} TRUE if connection was success, FALSE if it failed
+}
+\description{
+Attempts to connect to the database. If not already configured, will first
+attempt to load the configuration.
+}

man/DBConnection-cash-disconnect.Rd

@@ -0,0 +1,8 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Connect.R
+\name{DBConnection$disconnect}
+\alias{DBConnection$disconnect}
+\title{DBConnection$disconnect}
+\description{
+Disconnects the current database connection, if connected.
+}

man/DBConnection-cash-disconnectOnSessionEnd.Rd

@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Connect.R
+\name{DBConnection$disconnectOnSessionEnd}
+\alias{DBConnection$disconnectOnSessionEnd}
+\title{DBConnection$disconnectOnSessionEnd}
+\arguments{
+\item{session}{\if{html}{\out{<complex>}} The R Shiny session to register the callback with}
+}
+\value{
+\if{html}{\out{<function>}} A function to cancel the onSessionEnded callback
+}
+\description{
+Registers a callback with an R Shiny session so that the connection is
+disconnected once the session ends.
+}

man/DBConnection-cash-getConfiguration.Rd

@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Configure.R
+\name{DBConnection$getConfiguration}
+\alias{DBConnection$getConfiguration}
+\title{DBConnection$getConfiguration}
+\value{
+\if{html}{\out{<list>}} Current configuration. If not configured, NULL is returned
+}
+\description{
+Get the current configuration of the DBClient instance.
+}

man/DBConnection-cash-getConnection.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Connect.R
+\name{DBConnection$getConnection}
+\alias{DBConnection$getConnection}
+\title{DBConnection$getConnection}
+\arguments{
+\item{do_connect}{\if{html}{\out{<logical>}} Forcibly connect if not already connected}
+}
+\value{
+\if{html}{\out{<DBConnection>}} DBConnection instance
+}
+\description{
+Returns the DBConnection instance for this client.
+}

man/DBConnection-cash-getToken.Rd

@@ -0,0 +1,8 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Initialize.R
+\name{DBConnection$getToken}
+\alias{DBConnection$getToken}
+\title{DBConnection$getToken}
+\description{
+Returns the identity token for this DBConnection instance.
+}

man/DBConnection-cash-initialize.Rd

@@ -0,0 +1,8 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Initialize.R
+\name{DBConnection$initialize}
+\alias{DBConnection$initialize}
+\title{DBConnection$initialize}
+\description{
+Initalises the DBConnection instance with an identity token.
+}

man/DBConnection-cash-isConnected.Rd

@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Connect.R
+\name{DBConnection$isConnected}
+\alias{DBConnection$isConnected}
+\title{DBConnection$isConnected}
+\value{
+\if{html}{\out{<logical>}} TRUE if connected to the database, FALSE otherwise
+}
+\description{
+Indicates if the instance has an active database connection.
+}

man/DBConnection-cash-loadConfiguration.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Configure.R
+\name{DBConnection$loadConfiguration}
+\alias{DBConnection$loadConfiguration}
+\title{DBConnection$loadConfiguration}
+\arguments{
+\item{warn}{Emit a warning with which file it attempting to be loaded}
+}
+\value{
+\if{html}{\out{<logical>}} TRUE if configuration was successful, FALSE otherwise
+}
+\description{
+Attempts to load the configuration either from global.R or .env.R.
+}

man/DBConnection-cash-rollbackTransaction.Rd

@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Transaction.R
+\name{DBConnection$rollbackTransaction}
+\alias{DBConnection$rollbackTransaction}
+\title{DBConnection$rollbackTransaction}
+\arguments{
+\item{session}{\if{html}{\out{<complex>}} The R Shiny session to register the callback with}
+}
+\value{
+\if{html}{\out{<function>}} A function to cancel the onSessionEnded callback
+}
+\description{
+Registers a callback with an R Shiny session so that the connection is
+disconnected once the session ends.
+}

man/DBConnection.Rd

@@ -4,5 +4,5 @@
 \alias{DBConnection}
 \title{DBConnection}
 \description{
-Database Connection class
+Database Connection class.
 }

man/dot-configureDefault.Rd

@@ -0,0 +1,44 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DBConnection-Configure.R
+\name{.configureDefault}
+\alias{.configureDefault}
+\title{Configures the DBClient instance.}
+\usage{
+.configureDefault(
+  host,
+  port,
+  user,
+  password,
+  dbname,
+  engine = NULL,
+  name = NULL,
+  schema = NULL,
+  autoconnect = NULL
+)
+}
+\arguments{
+\item{host}{The database host}
+
+\item{port}{The database port}
+
+\item{user}{The database user to connect with}
+
+\item{password}{The database password to connect with}
+
+\item{dbname}{The database to use}
+
+\item{engine}{The database engine (mysql, postgres) as supported by DBI}
+
+\item{name}{The database to use (alternative to dbname)}
+
+\item{schema}{The database schema to use (postgres)}
+
+\item{autoconnect}{Autoconnect to the database if not already connected}
+}
+\value{
+The configuration accepted
+}
+\description{
+There are 2 options for configuration, either: pass in a named list; or use
+named parameters.
+}