read/write dm as csv/zip(csv)/xlsx

DESCRIPTION

@@ -69,17 +69,21 @@ Suggests:
     fansi,
     keyring,
     knitr,
+    lubridate,
     mockr,
     nycflights13,
     odbc,
     progress,
+    readr,
+    readxl,
     RMariaDB (>= 1.0.10),
     rmarkdown,
     RPostgres,
     RSQLite (>= 2.2.8),
     testthat (>= 3.0.2),
     tidyverse,
-    withr
+    withr,
+    writexl
 VignetteBuilder: 
     knitr
 Encoding: UTF-8

NAMESPACE

@@ -253,6 +253,9 @@ export(dm_nrow)
 export(dm_nycflights13)
 export(dm_paste)
 export(dm_ptype)
+export(dm_read_csv)
+export(dm_read_xlsx)
+export(dm_read_zip)
 export(dm_rename)
 export(dm_rename_tbl)
 export(dm_rm_fk)
@@ -269,6 +272,9 @@ export(dm_select_tbl)
 export(dm_set_colors)
 export(dm_squash_to_tbl)
 export(dm_update_zoomed)
+export(dm_write_csv)
+export(dm_write_xlsx)
+export(dm_write_zip)
 export(dm_zoom_to)
 export(enum_fk_candidates)
 export(enum_pk_candidates)

R/error-helpers.R

@@ -450,8 +450,10 @@ error_txt_pk_not_tracked <- function(orig_table, orig_pk) {
 }
 
 
-# only for local src ------------------------------------------------------
+# only for local src or con------------------------------------------------------
 
+# FIXME: since we don't work with sources, this error needs to be revisited
+# also: `nest_join.zoomed_dm()` currently not implemented anyway ;)
 abort_only_for_local_src <- function(src_dm) {
   abort(error_txt_only_for_local_src(format_classes(class(src_dm))), .subclass = dm_error_full("only_for_local_src"))
 }
@@ -460,6 +462,15 @@ error_txt_only_for_local_src <- function(src_class) {
   glue("`nest_join.zoomed_dm()` works only for a local `src`, not on a database with `src`-class: {src_class}.")
 }
 
+abort_only_for_local_con <- function(con_dm) {
+  abort(error_txt_only_for_local_con(format_classes(class(con_dm))), .subclass = dm_error_full("only_for_local_con"))
+}
+
+error_txt_only_for_local_con <- function(con_class) {
+  glue("This operation works only locally, not on a database with `con`-class: {con_class}.")
+}
+
+
 # Errors for `pull_tbl.dm()` -----------------------------
 
 abort_no_table_provided <- function() {
@@ -646,3 +657,76 @@ abort_one_of_schema_table_names <- function() {
     .subclass = dm_error_full("one_of_schema_table_names")
   )
 }
+
+
+# write or read dm to/from files ------------------------------------------
+
+abort_dir_not_empty <- function() {
+  abort(
+    "Please choose a non-existent or empty directory for the csv files.",
+    .subclass = dm_error_full("dir_not_empty")
+  )
+}
+
+abort_file_exists <- function(zip_file_path) {
+  abort(
+    glue::glue("File {tick(zip_file_path)} exists and `overwrite = FALSE`."),
+    .subclass = dm_error_full("file_exists")
+  )
+}
+
+abort_no_list <- function(table_names, column_names) {
+  abort(
+    error_txt_no_list(table_names, column_names),
+    .subclass = dm_error_full("no_list")
+  )
+}
+
+error_txt_no_list <- function(table_names, column_names) {
+  glue::glue(
+    "Class `list` is not supported, problematic column(s):\n",
+    "{paste0(table_names, '$', column_names, collapse = '\n')}"
+  )
+}
+
+abort_empty_dm <- function() {
+  abort(
+    "There needs to be at least one table in the `dm`, aborting the operation.",
+    .subclass = dm_error_full("empty_dm")
+  )
+}
+
+abort_files_or_sheets_missing <- function(missing, path, csv = TRUE) {
+  abort(
+    error_txt_files_or_sheets_missing(missing, path, csv),
+    .subclass = dm_error_full("files_or_sheets_missing")
+  )
+}
+
+error_txt_files_or_sheets_missing <- function(missing, path, csv) {
+  if (csv) {
+    glue::glue(
+      "Cannot recreate `dm`: At least the files {commas(tick(missing))} are missing in directory {tick(path)}."
+    )
+  } else {
+    glue::glue(
+      "Cannot recreate `dm`: At least the worksheets {commas(tick(missing))} are missing in file {tick(path)}."
+    )
+  }
+}
+
+abort_class_not_supported <- function(unsupported_class) {
+  abort(
+    error_txt_class_not_supported(unsupported_class),
+    .subclass = dm_error_full("class_not_supported")
+  )
+}
+
+error_txt_class_not_supported <- function(unsupported_class) {
+  c(glue::glue(
+    "R-class(es) {commas(tick(unsupported_class))} not supported. Please consider one of:"
+    ),
+    "converting the respective columns to a supported class (see `?dm_read_csv()`)",
+    "filing an issue and/or PR at https://github.com/krlmlr/dm"
+  )
+}

R/filter-dm.R

@@ -255,14 +255,14 @@ new_filtered_edges <- function(node, parent = node, distance = 0) {
   tibble(node, parent, distance)
 }
 
-check_no_filter <- function(dm) {
+check_no_filter <- function(dm, levels_up = -1) {
   def <-
     dm_get_def(dm)
 
   if (detect_index(def$filters, ~ vec_size(.) > 0) == 0) {
     return()
   }
 
-  fun_name <- as_string(sys.call(-1)[[1]])
+  fun_name <- as_string(sys.call(levels_up)[[1]])
   abort_only_possible_wo_filters(fun_name)
 }

R/global.R

@@ -80,6 +80,7 @@ utils::globalVariables(c(
   "unique_indexes",
   "value",
   "values",
+  "where",
   "why",
   "zoom",
   "zoomed",
@@ -96,5 +97,12 @@ utils::globalVariables(c(
   "districts",
   "loans",
   "orders",
-  "trans"
+  "trans",
+  #
+  # read/write
+  "readr_class",
+  "zip",
+  "key_nr",
+  "fk_col",
+  "segment"
 ))