Merge pull request #161 from atorus-research/gh_issue_154

Gh issue 154

NAMESPACE

@@ -32,6 +32,7 @@ S3method(set_denoms_by,count_layer)
 S3method(set_denoms_by,shift_layer)
 S3method(set_format_strings,count_layer)
 S3method(set_format_strings,desc_layer)
+S3method(set_format_strings,shift_layer)
 S3method(set_where,tplyr_layer)
 S3method(set_where,tplyr_table)
 S3method(str,f_str)

R/layering.R

@@ -74,10 +74,10 @@ add_layer <- function(parent, layer, name=NULL) {
 
  # Insert the `parent` argument into the topmost call of the layer code
  # (i.e. if any pipes %>% then pull out the left most call and modify it)
- l <- modify_nested_call(layer, parent=parent)
+ l <- quo_get_expr(modify_nested_call(layer, parent=parent))
 
  # Evaluate the layer and grab `tplyr_layer` or `tplyr_subgroup_layer` object
- executed_layer <- list(eval(quo_get_expr(l)))
+ executed_layer <- list(eval(l, envir=caller_env()))
 
  # Attach the name
  names(executed_layer) <- name

R/set_format_strings.R

@@ -185,6 +185,7 @@ set_format_strings.count_layer <- function(e, ...) {
  e
 }
 
+#' @export
 set_format_strings.shift_layer <- function(e, ...) {
 
  dots <- list2(...)

tests/testthat/test-layering.R

@@ -123,4 +123,22 @@ test_that("Layers accept names when specified", {
 
 })
 
+test_that("add_layer can see calling environment objects", {
+ tfunc <- function(){
+
+ prec <- tibble::tribble(
+ ~vs, ~max_int, ~max_dec,
+ 0, 1, 1,
+ 1, 2, 2
+ )
+
+ tplyr_table(mtcars, gear) %>%
+ add_layer(
+ group_desc(wt, by = vs) %>%
+ set_precision_data(prec)
+ )
+ }
+
+ expect_silent(tfunc())
+})