Include params in partial evaluation environment (#43)

* include params in environment for partial evaluation of expressions in filter() and mutate()

* include params in environment for partial evaluation of expressions in filter() and mutate()

* update docstring for tbl_kusto_abstract to reflect removal of simulate_kusto()

* replace 'setosa' with p again in filter param test

* add comment explaining vars_select usage and extract add_params_to_quosure function

* add parameterised query integration test

* require bit64 quietly

NAMESPACE

@@ -130,7 +130,6 @@ export(partial_eval)
 export(run_query)
 export(setdiff)
 export(setequal)
-export(simulate_kusto)
 export(tbl_kusto)
 export(tbl_kusto_abstract)
 export(translate_kql)

R/kql-build.R

@@ -38,7 +38,10 @@ kql_build.op_filter <- function(op, ...)
 {
     dots <- mapply(get_expr, op$dots)
     dot_names <- mapply(all_names, dots)
-    cols <- tidyselect::vars_select(op$vars, !!! dot_names)
+
+    # throw an exception if any filter expression references
+    # a var that isn't a column in the table
+    tidyselect::vars_select(op$vars, !!! dot_names)
 
     translated_dots <- lapply(dots, translate_kql)
     built_dots <- lapply(translated_dots, build_kql)

R/partial_eval.R

@@ -41,7 +41,6 @@
 #' f <- function(x) x + 1
 #' partial_eval(quote(year > f(1980)), vars = vars)
 #' partial_eval(quote(year > local(f(1980))), vars = vars)
-
 partial_eval <- function(call, vars = character(), env = caller_env())
 {
     switch_type(call,

R/tbl.R

@@ -8,11 +8,19 @@
 #' library(dplyr)
 #' df <- data.frame(x = 1, y = 2)
 #'
-#' df <- tbl_kusto_abstract(df, "table1", src = simulate_kusto())
+#' df <- tbl_kusto_abstract(df, "table1")
 #' df %>% summarise(x = sd(x)) %>% show_query()
-tbl_kusto_abstract <- function(df, table_name, src = simulate_kusto()) {
-  src$table <- escape(ident(table_name))
-  make_tbl("kusto_abstract", ops = op_base_local(df), src = src)
+tbl_kusto_abstract <- function(df, table_name, ...) {
+  params <- list(...)
+  src <- structure(
+      list(
+          database = "local_df",
+          server = "local_df",
+          table = escape(ident(table_name))
+      ),
+      class = "kusto_database_endpoint"
+  )
+  make_tbl("kusto_abstract", ops = op_base_local(df), src = src, params = params)
 }
 
 setOldClass(c("tbl_kusto_abstract", "tbl"))
@@ -43,6 +51,8 @@ rename.tbl_kusto_abstract <- function(.data, ...)
 filter.tbl_kusto_abstract <- function(.data, ...)
 {
     dots <- quos(...)
+    # add the tbl params into the environment of the expression's quosure
+    dots <- lapply(dots, add_params_to_quosure, params=.data$params)
     dots <- partial_eval(dots, vars = op_vars(.data))
     add_op_single("filter", .data, dots = dots)
 }
@@ -51,6 +61,7 @@ filter.tbl_kusto_abstract <- function(.data, ...)
 mutate.tbl_kusto_abstract <- function(.data, ...)
 {
     dots <- quos(..., .named=TRUE)
+    dots <- lapply(dots, add_params_to_quosure, params=.data$params)
     dots <- partial_eval(dots, vars = op_vars(.data))
     add_op_single("mutate", .data, dots = dots)
 }
@@ -257,19 +268,6 @@ tbl_vars.tbl_kusto_abstract <- function(x)
     op_vars(x$ops)
 }
 
-#' Simulate a kusto database endpoint as the source for a tbl_kusto_abstract.
-#' @export
-simulate_kusto <- function()
-{
-    structure(
-        list(
-            database = "local_df",
-            server = "local_df"
-        ),
-        class = "kusto_database_endpoint"
-    )
-}
-
 #' Translate a sequence of dplyr operations on a tbl into a Kusto query string.
 #' @export
 #' @param tbl A tbl_kusto or tbl_kusto_abstract instance
@@ -343,3 +341,9 @@ print.tbl_kusto_abstract <- function(x, ...)
 
     invisible(x)
 }
+
+add_params_to_quosure <- function(quosure, params)
+{
+  new_env <- list2env(params, envir = get_env(quosure))
+  quo_set_env(quosure, new_env)
+}    

man/simulate_kusto.Rd

@@ -1,11 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/tbl.R
-\name{simulate_kusto}
-\alias{simulate_kusto}
-\title{Simulate a kusto database endpoint as the source for a tbl_kusto_abstract.}
-\usage{
-simulate_kusto()
-}
-\description{
-Simulate a kusto database endpoint as the source for a tbl_kusto_abstract.
-}

man/tbl_kusto_abstract.Rd

@@ -4,7 +4,7 @@
 \alias{tbl_kusto_abstract}
 \title{Create a local lazy tbl}
 \usage{
-tbl_kusto_abstract(df, table_name, src = simulate_kusto())
+tbl_kusto_abstract(df, table_name, ...)
 }
 \description{
 Useful for testing KQL generation without a remote connection.
@@ -13,7 +13,7 @@ Useful for testing KQL generation without a remote connection.
 library(dplyr)
 df <- data.frame(x = 1, y = 2)
 
-df <- tbl_kusto_abstract(df, "table1", src = simulate_kusto())
+df <- tbl_kusto_abstract(df, "table1")
 df \%>\% summarise(x = sd(x)) \%>\% show_query()
 }
 \keyword{internal}

tests/testthat/test05_dbi.R

@@ -17,7 +17,7 @@ if(srvname == "" || srvloc == "" || dbname == "")
 
 server <- sprintf("https://%s.%s.kusto.windows.net", srvname, srvloc)
 
-if(!requireNamespace("bit64"))
+if(!requireNamespace("bit64", quietly=TRUE))
     skip("DBI tests skipped: bit64 package not installed")
 
 

tests/testthat/test06_dplyr.R

@@ -137,3 +137,14 @@ test_that("join hinting works",
     out <- dplyr::left_join(ir, spec, by="species", .strategy="shuffle", .num_partitions=2)
     expect_is(dplyr::collect(out), "tbl_df")
 })
+
+test_that("parameterised queries work",
+{
+    ir_parm <- tbl_kusto(db, "iris", parm="setosa")
+
+    out <- dplyr::collect(dplyr::filter(ir_parm, species == parm))
+    expect_true(inherits(out, "tbl_df") && all(out$species == "setosa") && nrow(out) == 50)
+
+    out <- dplyr::collect(dplyr::mutate(ir_parm, species2=parm))
+    expect_true(inherits(out, "tbl_df") && all(out$species2 == "setosa") && nrow(out) == 150)
+})

tests/testthat/test_translate.r

@@ -5,6 +5,35 @@ tbl_iris <- tibble::as.tibble(iris)
 names(tbl_iris) <- c("SepalLength", "SepalWidth", "PetalLength", "PetalWidth", "Species")
 tbl_iris <- tbl_kusto_abstract(tbl_iris, "iris")
 
+
+test_that("params to a function can be used inside a mutate expressions",
+{
+    tbl_iris_p <- tibble::as.tibble(iris)
+    names(tbl_iris_p) <- c("SepalLength", "SepalWidth", "PetalLength", "PetalWidth", "Species")
+    tbl_iris_p <- tbl_kusto_abstract(tbl_iris, "iris", p="setosa")
+    
+    q <- tbl_iris_p %>%
+        mutate(Species = p)
+    
+    q_str <- show_query(q)
+
+    expect_equal(q_str, kql("database('local_df').['iris']\n| extend ['Species'] = 'setosa'"))
+})
+
+test_that("params to a function can be used inside a filter expressions",
+{
+    
+    tbl_iris_p <- tibble::as.tibble(iris)
+    names(tbl_iris_p) <- c("SepalLength", "SepalWidth", "PetalLength", "PetalWidth", "Species")
+    tbl_iris_p <- tbl_kusto_abstract(tbl_iris_p, "iris", p="setosa")
+    
+    q <- filter(tbl_iris_p, Species == p)
+    q_str <- show_query(q)
+
+    expect_equal(q_str, kql("database('local_df').['iris']\n| where ['Species'] == 'setosa'"))
+})
+
+
 test_that("select is translated to project",
 {
     q <- tbl_iris %>%
@@ -260,11 +289,11 @@ right2 <- iris %>%
 
 right3 <- right2 %>% dplyr::rename(Species2 = Species, SepalWidth2 = SepalWidth)
 
-right <- tbl_kusto_abstract(right, "iris2", src = simulate_kusto())
+right <- tbl_kusto_abstract(right, "iris2")
 
-right2 <- tbl_kusto_abstract(right2, "iris2", src = simulate_kusto())
+right2 <- tbl_kusto_abstract(right2, "iris2")
 
-right3 <- tbl_kusto_abstract(right3, "iris3", src = simulate_kusto())
+right3 <- tbl_kusto_abstract(right3, "iris3")
 
 test_that("inner_join() on a single column translates correctly",
 {
@@ -364,7 +393,7 @@ test_that("anti_join() on a single column translates correctly",
 
 test_that("union_all translates correctly",
 {
-    tbl_iris_2 <- tbl_kusto_abstract(iris, "iris", src=simulate_kusto())
+    tbl_iris_2 <- tbl_kusto_abstract(iris, "iris")
 
     q <- tbl_iris %>%
         dplyr::union_all(tbl_iris_2)
@@ -383,7 +412,7 @@ test_that("as.Date() produces a Kusto datetime",
     words <- c("Tuesday", "Wednesday", "Thursday")
     df <- data.frame(dates, words)
 
-    tbl_dates <- tbl_kusto_abstract(df, "df", src=simulate_kusto())
+    tbl_dates <- tbl_kusto_abstract(df, "df")
 
     q <- tbl_dates %>%
         filter(dates == as.Date("2019-01-01"))
@@ -402,7 +431,7 @@ test_that("as.POSIXct() produces a Kusto datetime",
     words <- c("Tuesday", "Wednesday", "Thursday")
     df <- data.frame(dates, words)
 
-    tbl_dates <- tbl_kusto_abstract(df, "df", src=simulate_kusto())
+    tbl_dates <- tbl_kusto_abstract(df, "df")
 
     q <- tbl_dates %>%
         filter(dates == as.POSIXct(strptime("2019-01-01T23:59:59", "%Y-%m-%dT%H:%M:%S", tz="UTC")))
@@ -421,7 +450,7 @@ test_that("as.POSIXlt() produces a Kusto datetime",
     words <- c("Tuesday", "Wednesday", "Thursday")
     df <- data.frame(dates, words)
 
-    tbl_dates <- tbl_kusto_abstract(df, "df", src=simulate_kusto())
+    tbl_dates <- tbl_kusto_abstract(df, "df")
 
     q <- tbl_dates %>%
         filter(dates == as.POSIXlt("2019-01-01"))
@@ -493,4 +522,3 @@ test_that("summarize hinting translates correctly",
     q_str <- q %>% show_query()
     expect_equal(q_str, kql("database('local_df').['iris']\n| summarize hint.shufflekey = ['SepalLength'] hint.shufflekey = ['SepalWidth'] hint.num_partitions = 2 ['MaxSepalLength'] = max(['SepalLength']) by ['Species']"))
 })
-