From 15dd6a42bea594e94fc7599e8fee790a24fabc8c Mon Sep 17 00:00:00 2001
From: Gregor Sturm <gregor.sturm@boehringer-ingelheim.com>
Date: Mon, 13 Jan 2025 14:31:28 +0100
Subject: [PATCH] Remove safe_get (#25)

* Remove safe_get

* pre-commit autofixes

* Remove corresponding tests

* roxygenize

* Fix pre-commit

---------

Co-authored-by: grst <grst@users.noreply.github.com>
---
 CHANGELOG.md                                  |   6 +
 NAMESPACE                                     |   5 -
 R/safe_get.R                                  | 153 ------------------
 README.md                                     |   1 -
 man/dot-convert_list_call_to_dollar_format.Rd |  28 ----
 man/safe_get.Rd                               |  30 ----
 tests/testthat/test-safe_get.R                |  62 -------
 7 files changed, 6 insertions(+), 279 deletions(-)
 delete mode 100644 R/safe_get.R
 delete mode 100644 man/dot-convert_list_call_to_dollar_format.Rd
 delete mode 100644 man/safe_get.Rd
 delete mode 100644 tests/testthat/test-safe_get.R

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 990f503..cf210bb 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,6 +4,12 @@ All notable changes to this project will be documented in this file.
 
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
+## v0.7
+
+### Backwards-incompatible changes
+
+-   Remove `safe_get`, because the `dsoParams` class already checks for existance of keys
+
 ## v0.6
 
 ### New Features
diff --git a/NAMESPACE b/NAMESPACE
index 3b06293..68fd7aa 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -12,7 +12,6 @@ export(init)
 export(read_params)
 export(reload)
 export(repro)
-export(safe_get)
 export(set_stage)
 export(stage_here)
 exportClasses(dsoParams)
@@ -22,9 +21,5 @@ importFrom(glue,glue)
 importFrom(here,here)
 importFrom(here,i_am)
 importFrom(methods,show)
-importFrom(rlang,caller_env)
 importFrom(rstudioapi,viewer)
-importFrom(stringr,coll)
-importFrom(stringr,str_match_all)
-importFrom(stringr,str_replace)
 importFrom(yaml,read_yaml)
diff --git a/R/safe_get.R b/R/safe_get.R
deleted file mode 100644
index c0dd8ab..0000000
--- a/R/safe_get.R
+++ /dev/null
@@ -1,153 +0,0 @@
-#' @title safe_get
-#' @description
-#' converts a nested list call to dollar format
-#' @details
-#' Converts a nested list call to dollar format while resolving variables
-#' in the environment specified in `env` (by default the caller_env())
-#'
-#' input_string <- 'CONFIG[[a]][[\"foo\"]]$bar[[\'no\']][[b]]$level'
-#' a <- "test"
-#' b <- "bla"
-#' print(.convert_list_call_to_dollar_format('CONFIG[[a]][[\"foo\"]]$bar[["no"]][["further"]]$level'))
-#'
-#' @param input_string input string from deparsed function call
-#'
-#' @param env environment which is used to resolve variables in the list call
-#'
-#' @importFrom stringr str_match_all
-#' @importFrom stringr str_replace
-#' @importFrom stringr coll
-#' @importFrom rlang caller_env
-#'
-#' @return converted nested list call in $ format
-.convert_list_call_to_dollar_format <- function(input_string, env = caller_env()) {
-  if (!is.null(input_string) && !is.na(input_string) && !is.character(input_string)) {
-    stop("input_string is not a non-NULL non-NA character string")
-  }
-
-  # Remove any whitespace
-  x <- gsub("\\s", "", input_string)
-
-  # Replace all $[[\"...\"]
-  x <- gsub('\\[\\[\\"(.+?)\\"\\]\\]', "\\$\\1", x)
-
-  # Replace all $[["..."]
-  x <- gsub('\\[\\["(.+?)"\\]\\]', "\\$\\1", x)
-
-  # Replace all $[[\'...\']
-  x <- gsub("\\[\\[\\'(.+?)\\'\\]\\]", "\\$\\1", x)
-
-  # Replace all $[['...']
-  x <- gsub("\\[\\['(.+?)'\\]\\]", "\\$\\1", x)
-
-
-  matches <- str_match_all(x, "\\[\\[(.*?)\\]\\]")
-
-  # evaluates all variables in [[]] in environment specified
-  # and returns function call as $ separated call
-  if (!is.null(matches) && length(matches) > 0 && nrow(matches[[1]]) > 0) {
-    for (i in 1:nrow(matches[[1]])) {
-      tryCatch(
-        {
-          .match <- matches[[1]][i, 1]
-          .variable <- matches[[1]][i, 2]
-
-          x <- str_replace(
-            pattern = coll(.match),
-            replacement = paste0("$", eval(parse(text = .variable),
-              envir = env
-            )),
-            x
-          )
-        },
-        error = function(e) {
-          stop(paste0(
-            "Error when trying to evaluate variable ",
-            .variable, " in '", x, "'.: ", e
-          ))
-        }
-      )
-    }
-  }
-
-  return(x)
-}
-
-
-
-#' @title safe_get
-#' @description
-#' safe checks a nested list call and returns requested value
-#' @details
-#' When accessing parameters stored in a list of list like `params$a$b$c`,
-#' R will return `NULL` if an empty slot is accessed intentionally or
-#' by accident: e.g. `params$a$d$c` (where `d` does not exist) will return
-#' in `NULL`. This can lead to unwanted behavior.
-#'
-#' safe_get() will produce an error and point to the slot accessed incorrectly.
-#' It can utilize other forms of access like params[["a"]]$b$c or
-#' var <- "a"; params[[a]]. Variables will be resolved from the caller_env()
-#' by default, but can be changed passing through the `env` parameter.
-#'
-#' @param config_call nested list call
-#' @param env environment which is used to resolve variables in the list call
-#' @importFrom rlang caller_env
-#'
-#' @export
-#' @return content of nested variable call
-safe_get <- function(config_call, env = caller_env()) {
-  if (!is.environment(env)) {
-    stop("env is not an environment or derived from an environment")
-  }
-
-  # input can be a mixture of $, [[ ]], variable, etc. This
-  # function converts everything into a uniform $ format while
-  # evaluating the variables in the specified environment
-  config_parts <- .convert_list_call_to_dollar_format(
-    deparse(substitute(config_call)),
-    env = env
-  )
-
-  # input checks
-  error_prefix <- "config_call argument cannot be "
-  error_postfix <- ". Input could be configuration stored in list of lists, e.g. params$test$a, params[['test']][['a']], params$test[['a']] or params[[ var]]$a."
-  if (config_parts == "NA") {
-    stop(paste0(error_prefix, "NA", error_postfix))
-  }
-
-  if (config_parts == "NULL") {
-    stop(paste0(error_prefix, "NULL", error_postfix))
-  }
-
-  if (config_parts == "") {
-    stop(paste0(error_prefix, "empty", error_postfix))
-  }
-
-  # split the $ separated input string
-  config_parts <- strsplit(config_parts, "\\$")[[1]]
-
-  # remove backticks `` to get the variable names
-  config_parts <- gsub(pattern = "^`|`$", replacement = "", config_parts)
-
-  # the first variable is the base variable
-  current_list <- get(config_parts[1], envir = env, inherits = FALSE)
-
-  if (is.null(current_list)) {
-    stop(paste0(config_parts[0], " does not exist."))
-  }
-
-  # while iterating through the calls, check if the elements exist in the parent
-  for (i in 2:length(config_parts)) {
-    if (!exists(config_parts[[i]], envir = as.environment(current_list))) {
-      stop(paste0("The element '", config_parts[[i]], "' does not exist in '", paste0(config_parts[1:(i - 1)], collapse = "$"), "'."))
-    }
-    current_list <- current_list[[config_parts[[i]]]]
-  }
-
-  # return cannot be NULL
-  if (is.null(current_list)) {
-    stop(paste0("The call '", paste0(config_parts, collapse = "$"), "' is NULL."))
-  }
-
-  return(current_list)
-}
diff --git a/README.md b/README.md
index 8812b9e..21ad7af 100644
--- a/README.md
+++ b/README.md
@@ -5,7 +5,6 @@ The purpose of this package is to provide access to files and configuration orga
 -   `read_params(stage_path)` loads the configuration for the specified stage into an `dsoParams` R object which can be accessed like a list. The stage name must be relative to the project root. This function works independent of the current working directory, as long as you are in any subdirectory of the project.
 -   `reload(object)` reloads the config loaded by read_params. Usage: `reload(params)`
 -   `stage_here(rel_path)` is inspired by [here()](https://here.r-lib.org/). While `here()` resolves paths that are relative to the project root `stage_here()` resolves paths that are relative to the stage specified in `read_params`.
--   `safe_get()` is a helper function assuring that a nested list call does not return NULL if accessed incorrectly. ' safe_get() will produce an error and point to the incorrectly accessed slot.
 
 Additionally, `dso-r` provides an R interface to some of the most important CLI commands of `dso`.
 
diff --git a/man/dot-convert_list_call_to_dollar_format.Rd b/man/dot-convert_list_call_to_dollar_format.Rd
deleted file mode 100644
index d367d66..0000000
--- a/man/dot-convert_list_call_to_dollar_format.Rd
+++ /dev/null
@@ -1,28 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/safe_get.R
-\name{.convert_list_call_to_dollar_format}
-\alias{.convert_list_call_to_dollar_format}
-\title{safe_get}
-\usage{
-.convert_list_call_to_dollar_format(input_string, env = caller_env())
-}
-\arguments{
-\item{input_string}{input string from deparsed function call}
-
-\item{env}{environment which is used to resolve variables in the list call}
-}
-\value{
-converted nested list call in $ format
-}
-\description{
-converts a nested list call to dollar format
-}
-\details{
-Converts a nested list call to dollar format while resolving variables
-in the environment specified in `env` (by default the caller_env())
-
-input_string <- 'CONFIG[[a]][[\"foo\"]]$bar[[\'no\']][[b]]$level'
-a <- "test"
-b <- "bla"
-print(.convert_list_call_to_dollar_format('CONFIG[[a]][[\"foo\"]]$bar[["no"]][["further"]]$level'))
-}
diff --git a/man/safe_get.Rd b/man/safe_get.Rd
deleted file mode 100644
index 4c4c144..0000000
--- a/man/safe_get.Rd
+++ /dev/null
@@ -1,30 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/safe_get.R
-\name{safe_get}
-\alias{safe_get}
-\title{safe_get}
-\usage{
-safe_get(config_call, env = caller_env())
-}
-\arguments{
-\item{config_call}{nested list call}
-
-\item{env}{environment which is used to resolve variables in the list call}
-}
-\value{
-content of nested variable call
-}
-\description{
-safe checks a nested list call and returns requested value
-}
-\details{
-When accessing parameters stored in a list of list like `params$a$b$c`,
-R will return `NULL` if an empty slot is accessed intentionally or
-by accident: e.g. `params$a$d$c` (where `d` does not exist) will return
-in `NULL`. This can lead to unwanted behavior.
-
-safe_get() will produce an error and point to the slot accessed incorrectly.
-It can utilize other forms of access like params[["a"]]$b$c or
-var <- "a"; params[[a]]. Variables will be resolved from the caller_env()
-by default, but can be changed passing through the `env` parameter.
-}
diff --git a/tests/testthat/test-safe_get.R b/tests/testthat/test-safe_get.R
deleted file mode 100644
index 49a63a0..0000000
--- a/tests/testthat/test-safe_get.R
+++ /dev/null
@@ -1,62 +0,0 @@
-test_that("safe_get() should fail when there is no input", {
-  expect_error(safe_get(), "*empty*")
-  expect_error(safe_get(NULL), "*NULL*")
-  expect_error(safe_get(NA), "*NA*")
-})
-
-test_that("safe_get() should retrieve value expected", {
-  params <- list()
-  params$a <- "bla"
-  params$b <- list()
-  params$b$c <- "blub"
-  var_a <- "a"
-  var_b <- "b"
-  var_c <- "c"
-
-  # styler: off
-  expect_equal(safe_get(params$a), "bla")
-  expect_equal(safe_get(params[[var_a]]), "bla")
-  expect_equal(safe_get(params$b$c), "blub")
-  expect_equal(safe_get(params[["b"]]$c), "blub")
-  expect_equal(safe_get(params[['b']]$c), "blub")
-  expect_equal(safe_get(params[["b"]][['c']]), "blub")
-  expect_equal(safe_get(params[['b']][["c"]]), "blub")
-  expect_equal(safe_get(params[[var_b]][["c"]]), "blub")
-  expect_equal(safe_get(params[["b"]][[var_c]]), "blub")
-  expect_equal(safe_get(params[[var_b]][[var_c]]), "blub")
-  # styler: on
-})
-
-
-test_that("safe_get() should raise error when call does not exist", {
-  params <- list()
-  params$a <- "bla"
-  params$b <- list()
-  params$b$c <- "blub"
-  var_a <- "a"
-  var_b <- "b"
-  var_c <- "c"
-  var_z <- "z"
-
-  # styler: off
-  expect_error(safe_get(params$z), "does not exist")
-  expect_error(safe_get(params[[var_z]]), "does not exist")
-  expect_error(safe_get(params$z$c), "does not exist")
-  expect_error(safe_get(params[["z"]]), "does not exist")
-  expect_error(safe_get(params[['z']]), "does not exist")
-  expect_error(safe_get(params[["z"]]$c), "does not exist")
-  expect_error(safe_get(params[['z']]$c), "does not exist")
-  expect_error(safe_get(params[['b']]$z), "does not exist")
-  expect_error(safe_get(params[['z']]$c), "does not exist")
-  expect_error(safe_get(params[["b"]][['z']]), "does not exist")
-  expect_error(safe_get(params[["z"]][['c']]), "does not exist")
-  expect_error(safe_get(params[['b']][["z"]]), "does not exist")
-  expect_error(safe_get(params[['z']][["c"]]), "does not exist")
-  expect_error(safe_get(params[[var_b]][["z"]]), "does not exist")
-  expect_error(safe_get(params[[var_z]][["c"]]), "does not exist")
-  expect_error(safe_get(params[["z"]][[var_c]]), "does not exist")
-  expect_error(safe_get(params[["b"]][[var_z]]), "does not exist")
-  expect_error(safe_get(params[[var_b]][[var_z]]), "does not exist")
-  expect_error(safe_get(params[[var_z]][[var_c]]), "does not exist")
-  # styler: on
-})