separate collect object func to global and namespace

NAMESPACE

@@ -5,7 +5,7 @@ S3method(transcribe,data.frame)
 S3method(transcribe,factor)
 S3method(transcribe,numeric)
 export("%>%")
-export(filter_context)
+export(ls_objects)
 export(seal)
 export(transcribe)
 importFrom(magrittr,"%>%")

R/collect.R

@@ -2,55 +2,145 @@
 #'
 #' @details
 #'
-#' * filter_context
+#' * ls_objects
 #'
-#' @param context Types of \R{} object (`character`)
+#' @param class Class of \R{} object (`character`)
 #' @param environment which environment (work space) to search the available objects
+#' @param pkgs The name of a package such as `package:<PACKAGE_NAME>`
+#' @param nms attached packages names
+#' @param eval which include evaluate value
 #' @param ... Further arguments
 #'
 #' @name collect
 #' @examples
 #' \dontrun{
+#' Return objects in .GlobaEnv
 #' my_iris <- iris
-#' filter_context("data.frame") %>%
-#'   purrr::pmap(~ dim(..2))
+#' ls_objects()
+#' # Filter by object class
+#' ls_objects("data.frame")
+#' # Storage a evaluate value
+#' ls_objects("data.frame", eval = TRUE)
 #'
-#' my_mtcars <- mtcars
-#' filter_context("data.frame") %>%
-#' purrr::pmap(~ names(..2))
+#' # Filter object class and environment
+#' ls_objects("data.frame",
+#'            nms = TRUE,
+#'            pkgs = "package:datasets")
+#'
+#' library(dplyr)
+#' ls_objects(c("function", "tbl"),
+#'            nms = TRUE,
+#'            pkgs = "package:dplyr")
+#'
+#' e <- rlang::env(my_data1 = iris, my_data2 = mtcars)
+#' ls_objects(environment = "e", nms = FALSE)
 #' }
 NULL
 
+. <- name <- NULL
+
 #' @rdname collect
-collect_objects <- function(environment = NULL, ...) {
+global_objects <- function() {
 
-  . <- NULL
+  df <- tibble::tibble(
+    name = rlang::env_names(rlang::global_env()),
+    class = rlang::env_get_list(.GlobalEnv, name) %>%
+      purrr::map(class)
+  ) %>%
+    dplyr::mutate(environment = ".GlobalEnv")
 
-  if (is.null(environment)) {
-    env <- .GlobalEnv
-  } else {
-    env <- environment
+  env_env <- function(envs) {
+    envs %>%
+      purrr::map_dfr(
+        ~ tibble::tibble(
+          name = rlang::env_names(rlang::env_get(.GlobalEnv, .x)),
+          class = rlang::env_get_list(rlang::env_get(.GlobalEnv, .x), name) %>%
+            purrr::map(class)
+        ) %>%
+          dplyr::mutate(environment = .x)
+      )
   }
-    target <- ls(name = env)
-
-  df <- tibble::data_frame(
-    name = target,
-    eval = target %>%
-      purrr::map(~ get(..1, envir = env)),
-    class = eval %>%
-      purrr::map(class)) %>%
-    dplyr::mutate(
-      class = purrr::pmap_chr(., ~ paste(..3, collapse = ", "))) %>%
-    tidyr::separate_rows(col = class, into = class)
 
-  return(df)
+  df_envs <- df %>%
+    dplyr::filter(class == "environment") %>%
+    magrittr::use_series(name) %>%
+    env_env()
+
+  dplyr::bind_rows(df, df_envs) %>%
+    dplyr::select(environment, name, class)
+
+}
+
+#' @rdname collect
+nms_objects <- function(pkgs = NULL, ...) {
+
+  nms <- rlang::scoped_names()
+
+  nms <- grep("^(package|tools)", nms, value = TRUE)
 
+  if (!is.null(pkgs)) {
+    nms <- nms[nms %in% pkgs]
+  }
+
+  tibble::data_frame(
+    environment = nms %>%
+      purrr::map(~ rep(.x[1], times = length(ls(
+        .x[1]
+      )))) %>%
+      purrr::flatten_chr(),
+    name = nms %>%
+      purrr::map(~ ls(.x)) %>%
+      purrr::flatten_chr(),
+    class = name %>%
+      purrr::map(~ get(..1, pos  = environment)) %>%
+      purrr::map(class)
+  )
 }
 
 #' @rdname collect
 #' @export
-filter_context <- function(context = "function", ...) {
+ls_objects <- function(class = NULL,
+                       environment = ".GlobalEnv",
+                       eval = FALSE,
+                       nms = FALSE, ...) {
+
+  environment <- rlang::quo_expr(environment)
+  class <- rlang::quo_expr(class)
+
+  df_objects <- global_objects()
+
+  if (!is.null(environment)) {
+    df_objects <-
+      df_objects %>%
+      dplyr::filter(environment %in% !!c(environment))
+  }
+
+  if (isTRUE(nms)) {
+    df_objects <-
+      df_objects %>%
+      dplyr::bind_rows(nms_objects(...))
+  }
+
+  df_objects <-
+    df_objects %>%
+    dplyr::mutate(class = purrr::pmap_chr(., ~ paste(..3, collapse = ", "))) %>%
+    tidyr::separate_rows(col = class, into = class)
+
+  if (!is.null(class)) {
+    df_objects <-
+      df_objects %>%
+      dplyr::filter(class %in% !!c(class))
+  }
+
+  if (isTRUE(eval)) {
+    df_objects <-
+      df_objects %>%
+      obj_eval()
+  }
+
+  if (nrow(df_objects) == 0) {
+    return(rlang::inform("The given environment is not stored any objects."))
+  }
 
-  collect_objects(...) %>%
-    dplyr::filter(class == context)
+  return(df_objects)
 }

R/utils.R

@@ -9,6 +9,15 @@ sealr_timestamp <- function() {
                     ")"))
 }
 
+obj_eval <- function(df) {
+  df %>%
+    dplyr::mutate(
+      eval = purrr::pmap(.,
+                         ~ get(..2)
+      )
+    )
+}
+
 compound <- function(x) {
   e <- new.env()
 

tests/testthat/test-object-context.R

@@ -1,37 +1,50 @@
 context("test-object-context.R")
 
 test_that("collect object", {
-  expect_equal(
-    nrow(collect_objects(environment = NULL)),
-    0L
-  )
+  expect_gte(nrow(global_objects()),
+             1L)
+  expect_is(nms_objects(),
+            "data.frame")
+  expect_equal(nrow(nms_objects(pkgs = "package:datasets")),
+               104L)
+  expect_equal(dim(nms_objects(
+    pkgs = c("package:datasets", "package:utils")
+  )),
+  c(315, 3))
 })
 
 test_that("filter", {
+  expect_equal(ncol(
+    ls_objects(
+      class = "data.frame",
+      pkgs = "package:datasets",
+      nms = TRUE,
+      eval = TRUE
+    )
+  ),
+  4L)
 
-  e <- new.env()
-  assign("my_data1", iris, e)
-  assign("my_data2", mtcars, e)
-
-  withr::with_environment(
-    e, {
-      res <- filter_context(context = "data.frame",
-                            environment = e) %>%
-        purrr::pmap(~ dim(..2))
-
-      expect_is(
-        res,
-        "list")
-      expect_length(
-        res,
-        2L)
-      expect_equal(
-        res[[1]],
-        dim(iris))
-      expect_equal(
-        res[[2]],
-        dim(mtcars))
-    }
+  expect_message(
+    ls_objects(
+      class = "function",
+      pkgs = "package:ggplot2",
+      nms = TRUE,
+      eval = FALSE
+    ),
+    "The given environment is not stored any objects."
   )
 
+  e <- rlang::env()
+  withr::with_environment(e, {
+    suppressMessages(library(dplyr))
+    expect_is(
+      ls_objects(
+        class = "function",
+        pkgs = "package:dplyr",
+        nms = TRUE,
+        eval = FALSE
+      ),
+      "tbl"
+    )
+  })
 })