Save and read R object in RDS saveRDS

[Rafnuss]

#' Save GeoPressure object
#'
#' This function save a GeoPressureR object or data.frame from different type (`tag`, `graph`,
#' `pressure_path`, `path`) as a RDS file using the default file location for intermediate data
#' (i.e., `"data/interim/"`)
#
#' @param x A GeoPressureR object or data.frame
#' @param file The file to be saved
#' @param type One of `"tag"`, `"graph"`, `"pressure_path"`, `"path"`
#' @param overwrite logical. If `TRUE`, file is overwritten.
#' @param ... Additional parameters for `saveRDS()`
#'
#' @return `x` is returned invisibly and unchanged
#' @noRd
saveRDS_geopressurer <- function(x, file, type, overwrite = FALSE, ...) {
  # Check file size
  file_size <- format(utils::object.size(x), units = "MB")
  if (file_size > 100 * 1024 * 1024) {
    cli::cli_inform(c("!" = "The estimated size for this file will be {.val {file_size}} MB.\f"))
    res <- utils::askYesNo("Do you still want to create it?")
    if (!res) {
      return(FALSE)
    }
  }

  # Check directory
  dir_file <- dirname(file)
  if (!dir.exists(dir_file)) {
    cli::cli_inform(c("!" = "The directory {.file {file.path(getwd(), dir_file)}} does not exist.\f"))
    res <- utils::askYesNo("Do you want to create it?")
    if (res) {
      dir.create(dir_file)
    } else {
      return(FALSE)
    }
  }

  # Check if file exist
  if (file.exists(file) & !overwrite) {
    cli::cli_inform(c("!" = "The file {.file {file}} already exist. (use {.code overwrite = TRUE} \\
                           to avoid this message)\f"))
    res <- utils::askYesNo("Do you want to overwrite it?")
    if (!res) {
      return(FALSE)
    }
  }

  # Save
  saveRDS(x, file = file, ...)

  cli::cli_inform(c("v" = "{.var {type}} saved successfully as {.file {file}} \\
                         ({round(file.info(file)$size/1024/1024,1)} MB).\f"))

  return(invisible(x))
}

#' Save a GeoPressureR `tag` object.
#'
#' This function save a GeoPressureR `tag` object as a RDS file using the default file location for
#' intermediate data (i.e., `"data/interim/"`)
#
#' @param tag A GeoPressureR `tag` object
#' @param file The file to be saved
#' @param overwrite logical. If `TRUE`, file is overwritten.
#' @param ... Additional parameters for `saveRDS()`
#'
#' @return `tag` is returned invisibly and unchanged
#'
#' #' @examples
#' setwd(system.file("extdata/", package = "GeoPressureR"))
#' tag <- tag_create("18LX", quiet = T) |>
#'         tag_label(quiet = T) |>
#'         tag_setmap(c(-16, 23, 0, 50), scale = 1) |>
#'         geopressure_map()
#'
#' save_tag(tag, overwrite = TRUE)
#'
#' @export
saveRDS.tag <- function(tag,
                        file = glue::glue("data/interim/tag-{tag$param$id}.rds"),
                        overwrite = FALSE, ...) {
  save_geopressurer(tag, file = file, type = "tag", overwrite = overwrite, ...)
  return(invisible(tag))
}

#' Save a GeoPressureR `graph` object.
#'
#' This function save a GeoPressureR `graph` object as a RDS file using the default file location
#' for intermediate data (i.e., `"data/interim/"`)
#
#' @param graph A GeoPressureR `graph` object
#' @param file The file to be saved
#' @param overwrite logical. If `TRUE`, file is overwritten.
#' @param ... Additional parameters for `saveRDS()`
#'
#' @return `graph` is returned invisibly and unchanged
#' @export
saveRDS.graph <- function(graph,
                          file = glue::glue("data/interim/graph-{graph$param$id}.rds"),
                          overwrite = FALSE, ...) {
  saveRDS.geopressurer(graph, file = file, type = "graph", overwrite = overwrite, ...)
  return(invisible(graph))
}

#' Save a GeoPressureR `pressurepath` object.
#'
#' This function save a GeoPressureR `pressurepath` object as a RDS file using the default file
#' location for intermediate data (i.e., `"data/interim/"`)
#
#' @param pressurepath A GeoPressureR `pressurepath` object
#' @param file The file to be saved
#' @param overwrite logical. If `TRUE`, file is overwritten.
#' @param ... Additional parameters for `saveRDS()`
#'
#' @return `pressurepath` is returned invisibly and unchanged
#' @export
saveRDS.pressurepath <- function(
    pressurepath,
    file = glue::glue("data/interim/pressurepath-{attr(pressurepath, 'id')}.rds"),
    overwrite = FALSE, ...) {
  saveRDS.geopressurer(pressurepath, file = file, type = "pressurepath", overwrite = overwrite, ...)
  return(invisible(pressurepath))
}

#' Read GeoPressureR object
#'
#' This function read a GeoPressureR object from a file
#
#' @param file File to be read
#' @param type One of `"tag"`, `"graph"`, `"pressure_path"`, `"path"`
#' @param ... Additional parameters for `readRDS()`
#'
#' @return `x` is returned
#' @noRd
readRDS.geopressurer <- function(file, type, ...) {
  if (!file.exists(file)) {
    cli::cli_abort("The file {.file {file}} does not exists.")
  }
  x <- readRDS(file = file, ...)
  cli::cli_inform(c("v" = "{.var {type}} was read successfully from {.file {file}}.\f"))
  return(x)
}

#' Read a GeoPressureR `tag` object
#'
#' This function read a GeoPressureR `tag` object from a file
#
#' @param id Unique identifier of a tag.
#' @param file File to be read
#' @param ... Additional parameters for `readRDS()`
#'
#' @return GeoPressureR `tag` is returned
#' @export
readRDS.tag <- function(id, file = glue::glue("data/interim/tag-{id}.rds"), ...) {
  tag <- readRDS.geopressurer(file, type = "tag", ...)
  tag_assert(tag)
  return(tag)
}

#' Read a GeoPressureR `graph` object
#'
#' This function read a GeoPressureR `graph` object from a file
#
#' @param id Unique identifier of a tag
#' @param file File to be read
#' @param ... Additional parameters for `readRDS()`
#'
#' @return GeoPressureR `graph` is returned
#' @export
readRDS.graph <- function(id, file = glue::glue("data/interim/graph-{id}.rds"), ...) {
  graph <- readRDS.geopressurer(file, type = "graph", ...)
  graph_assert(graph)
  return(graph)
}

#' Read a GeoPressureR `pressurepath` object
#'
#' This function read a GeoPressureR `pressurepath` object from a file
#
#' @param id Unique identifier of a tag
#' @param file File to be read
#' @param ... Additional parameters for `readRDS()`
#'
#' @return GeoPressureR `pressurepath` is returned
#' @export
readRDS.pressurepath <- function(id, file = glue::glue("data/interim/pressurepath-{id}.rds"), ...) {
  pressurepath <- readRDS.geopressurer(file, type = "pressurepath", ...)
  return(pressurepath)
}