Geospatial and YAML support

DESCRIPTION

@@ -1,8 +1,9 @@
 Package: workspace
 Title: Workspace and Data Management Tools
-Version: 0.1.2
+Version: 0.1.3.002
 Authors@R: c(
-    person("David", "Gohel", , "david.gohel@ardata.fr", role = c("aut", "cre")),
+    person("Eli", "Daniels", , "eli.daniels@ardata.fr", role = c("aut", "cre")),
+    person("David", "Gohel", , "david.gohel@ardata.fr", role = c("aut")),
     person("ArData", role = "cph")
   )
 Description: This package provides tools for managing R workspaces and
@@ -22,7 +23,12 @@ Imports:
     tibble,
     tools,
     utils,
-    zip
+    zip,
+    yaml
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
+Suggests: 
+    testthat (>= 3.0.0),
+    sf
+Config/testthat/edition: 3

NAMESPACE

@@ -1,6 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(print,workspace)
+S3method(store_dataset,data.frame)
+S3method(store_dataset,sf)
 export(delete_dataset)
 export(list_object_in_workspace)
 export(new_workspace)
@@ -10,10 +12,12 @@ export(read_dataset_in_workspace)
 export(read_json_str_in_workspace)
 export(read_rds_in_workspace)
 export(read_timestamp)
+export(read_yaml_in_workspace)
 export(rm_object_in_workspace)
 export(store_dataset)
 export(store_json)
 export(store_rds)
+export(store_yaml)
 export(unpack_folder)
 export(unpack_workspace)
 export(workspace_bind)
@@ -32,6 +36,7 @@ importFrom(dplyr,select)
 importFrom(dplyr,semi_join)
 importFrom(rlang,env_has)
 importFrom(rlang,env_names)
+importFrom(rlang,is_list)
 importFrom(rlang,is_string)
 importFrom(rlang,new_environment)
 importFrom(stringi,stri_trans_general)
@@ -40,5 +45,7 @@ importFrom(tools,file_path_sans_ext)
 importFrom(utils,globalVariables)
 importFrom(utils,head)
 importFrom(utils,packageVersion)
+importFrom(yaml,read_yaml)
+importFrom(yaml,write_yaml)
 importFrom(zip,unzip)
 importFrom(zip,zip)

NEWS.md

@@ -1,3 +1,16 @@
+# workspace 0.1.3
+
+## Features 
+
+- Add support for storing and reading yaml files
+- Add support for storing and reading sf datasets (geospatial) using 
+gpkg file format.
+
+
+## Tests
+
+- Greatly increase test coverage.
+
 # workspace 0.1.2
 
 ## Features

R/readers.R

@@ -35,7 +35,7 @@ list_object_in_workspace <- function(x) {
 #' @family functions to read in a workspace
 read_dataset_in_workspace <- function(x, name) {
   objs <- list_object_in_workspace(x)
-  objs <- objs[objs$type %in% "dataset", ]
+  objs <- objs[objs$type %in% c("dataset", "geospatial"), ]
   objs <- objs[objs$name %in% name, ]
 
   if (nrow(objs) < 1) {
@@ -45,7 +45,35 @@ read_dataset_in_workspace <- function(x, name) {
     cli_abort("Value of {.code name} is not unique in workspace.")
   }
   file <- file.path(x$dir, objs$file)
-  read_parquet(file, mmap = FALSE)
+
+  if (objs$type %in% "dataset"){
+    read_parquet(file, mmap = FALSE)
+
+  } else if (objs$type %in% "geospatial") {
+
+    if (!requireNamespace("sf", quietly = TRUE)) {
+      cli_abort("{.val sf} package must be installed to store dataset of type {.cls sf}.")
+    }
+
+    geo_sf <- sf::st_read(file, geometry_column = "geom", quiet = TRUE)
+
+    # Using gpkg means geometry col is written as geom (not ideal)
+    # https://github.com/r-spatial/sf/issues/719
+    yaml_relative <- file.path(.assets_directory, "sf_metadata", paste0(name, '.yaml'))
+    yaml_abs <- file.path(x$dir, yaml_relative)
+    if (file.exists(yaml_abs)) {
+      metadata <- yaml::read_yaml(yaml_abs)
+      sf::st_geometry(geo_sf) <- metadata$sf_column
+      sf::st_crs(geo_sf) <- metadata$crs
+      geo_sf
+    } else {
+      cli_warn(paste(
+        "No {.arg sf_metadata} file found for name: {.val name}.",
+        "Geometry column and project may have changed since data was stored."
+      ))
+      geo_sf
+    }
+  }
 }
 
 #' @export
@@ -121,6 +149,10 @@ read_rds_in_workspace <- function(x, name, subdir = NULL) {
 read_json_str_in_workspace <- function(x, name, subdir = NULL) {
   objs <- list_object_in_workspace(x)
   objs <- objs[objs$type %in% "json", ]
+
+  if (nrow(objs) < 1) {
+    cli_abort("workspace {.arg x} has no json files.")
+  }
   objs <- objs[objs$name %in% name, ]
 
   if (!is.null(subdir)) {
@@ -138,6 +170,66 @@ read_json_str_in_workspace <- function(x, name, subdir = NULL) {
   paste0(str, collapse = "")
 }
 
+#' @importFrom yaml read_yaml
+#' @export
+#' @title Read YAML Object from a Workspace.
+#' @description
+#' Read a YAML file stored as a list object in a workspace.
+#' Returns the YAML content as an R list object.
+#' @param x the workspace
+#' @param name name associated with the YAML file stored in the workspace
+#' @param subdir Optional subdirectory used for the asset to retrieve
+#' @examples
+#' library(workspace)
+#' dir_tmp <- tempfile(pattern = "ws")
+#' z <- new_workspace(dir = dir_tmp)
+#'
+#' config_list <- list(
+#'   database = list(
+#'     host = "localhost",
+#'     port = 5432
+#'   ),
+#'   settings = list(
+#'     debug = TRUE,
+#'     max_connections = 100
+#'   )
+#' )
+#' z <- store_yaml(
+#'   x = z,
+#'   list = config_list,
+#'   filename = "config.yaml",
+#'   name = "app_config",
+#'   timestamp = "2023-11-12 11:37:41",
+#'   subdir = "configs"
+#' )
+#' read_yaml_in_workspace(z, "app_config", subdir = "configs")
+#' @family functions to read in a workspace
+read_yaml_in_workspace <- function(x, name, subdir = NULL) {
+
+  objs <- list_object_in_workspace(x)
+  objs <- objs[objs$type %in% "yaml", ]
+
+  if (nrow(objs) < 1) {
+    cli_abort("workspace {.arg x} has no yaml files.")
+  }
+  objs <- objs[objs$name %in% name, ]
+
+  if (!is.null(subdir)) {
+    objs <- objs[objs$subdir %in% subdir, ]
+  }
+
+  if (nrow(objs) < 1) {
+    cli_abort("Value of {.code name} cannot be found in workspace.")
+  }
+  if (nrow(objs) > 1) {
+    cli_abort("Value of {.code name} is not unique in workspace.")
+  }
+  file <- file.path(x$dir, objs$file)
+  yaml_list <- yaml::read_yaml(file)
+  yaml_list
+}
+
+
 #' @export
 #' @title Read Timestamp associated with a content of a Workspace.
 #' @description
@@ -163,6 +255,9 @@ read_json_str_in_workspace <- function(x, name, subdir = NULL) {
 read_timestamp <- function(x, name, type, subdir = NULL) {
   objs <- list_object_in_workspace(x)
   objs <- objs[objs$type %in% type, ]
+  if (nrow(objs) < 1) {
+    cli_abort("Value of {.code type} cannot be found in workspace.")
+  }
   objs <- objs[objs$name %in% name, ]
 
   if (!is.null(subdir)) {

R/rm.R

@@ -79,3 +79,42 @@ rm_object_in_workspace <- function(x, name, type, subdir = NULL) {
 
   x
 }
+
+
+#' @export
+#' @importFrom dplyr filter
+#' @title Delete a dataset from a workspace
+#' @description
+#' Delete a dataset stored in a workspace.
+#' This function removes the dataset file and updates the workspace's object descriptions.
+#' @param x The workspace object.
+#' @param data_name The name of the dataset to delete from the workspace.
+#' @return return the workspace object
+#' @examples
+#' library(workspace)
+#' dir_tmp <- tempfile(pattern = "ws")
+#' z <- new_workspace(dir = dir_tmp)
+#' z <- store_dataset(x = z, dataset = iris, name = "iris_dataset")
+#' z <- store_dataset(x = z, dataset = mtcars, name = "mtcars")
+#' z <- delete_dataset(x = z, data_name = "iris_dataset")
+#' z
+#' @family functions to write in a workspace
+delete_dataset <- function(x, data_name) {
+
+  base_file <- stri_trans_general(data_name, id = "latin-ascii")
+
+  contains_parquet_ext <- grepl(pattern = "\\.parquet", x = base_file, ignore.case = TRUE)
+  if (!contains_parquet_ext) {
+    base_file <- paste0(base_file, ".parquet")
+  }
+  filepath <- file.path(x$dir, .datasets_directory, base_file)
+  if (file.exists(filepath)) {
+    unlink(filepath, force = TRUE)
+  }
+
+  objects_descriptions <- read_objects_description(x)
+  objects_descriptions <- filter(.data = objects_descriptions, !.data$name %in% data_name)
+  save_objects_description(x, objs_desc = objects_descriptions)
+
+  x
+}