Prototype of an aggs parser handle.

.Rbuildignore

@@ -7,3 +7,5 @@ appveyor.yml
 ^Makefile$
 man-roxygen
 ^CONDUCT\.md$
+\.deb$
+

.travis.yml

@@ -1,6 +1,57 @@
 language: r
 
-sudo: required
+env:
+  matrix:
+  - ES_VERSION=1.0.0
+  - ES_VERSION=1.4.0
+  - ES_VERSION=1.7.2
+  - ES_VERSION=2.0.0
+  - ES_VERSION=2.1.0
+  - ES_VERSION=2.2.0
+
+before_install:
+  - case "$ES_VERSION" in
+    "") ;;
+
+    "1.0.0")
+      export ES_VERSION=1.0.0 ;
+      curl -O https://download.elasticsearch.org/elasticsearch/elasticsearch/elasticsearch-$ES_VERSION.deb && sudo dpkg -i --force-confnew elasticsearch-$ES_VERSION.deb && sudo service elasticsearch start
+      ;;
+
+    "1.4.0")
+      export ES_VERSION=1.4.0 ;
+      curl -O https://download.elasticsearch.org/elasticsearch/elasticsearch/elasticsearch-$ES_VERSION.deb && sudo dpkg -i --force-confnew elasticsearch-$ES_VERSION.deb && sudo service elasticsearch start
+      ;;
+
+    "1.7.2")
+      export ES_VERSION=1.7.2 ;
+      curl -O https://download.elasticsearch.org/elasticsearch/elasticsearch/elasticsearch-$ES_VERSION.deb && sudo dpkg -i --force-confnew elasticsearch-$ES_VERSION.deb && sudo service elasticsearch start
+      ;;
+
+    "2.0.0")
+      export ES_VERSION=2.0.0 ;
+      curl -O https://download.elasticsearch.org/elasticsearch/release/org/elasticsearch/distribution/deb/elasticsearch/$ES_VERSION/elasticsearch-$ES_VERSION.deb && sudo dpkg -i --force-confnew elasticsearch-$ES_VERSION.deb && sudo service elasticsearch start
+      ;;
+
+    "2.1.0")
+      export ES_VERSION=2.1.0 ;
+      curl -O https://download.elasticsearch.org/elasticsearch/release/org/elasticsearch/distribution/deb/elasticsearch/$ES_VERSION/elasticsearch-$ES_VERSION.deb && sudo dpkg -i --force-confnew elasticsearch-$ES_VERSION.deb && sudo service elasticsearch start
+      ;;
+
+    "2.2.0")
+      export ES_VERSION=2.2.0 ;
+      curl -O https://download.elasticsearch.org/elasticsearch/release/org/elasticsearch/distribution/deb/elasticsearch/$ES_VERSION/elasticsearch-$ES_VERSION.deb && sudo dpkg -i --force-confnew elasticsearch-$ES_VERSION.deb && sudo service elasticsearch start
+      ;;
+   esac
+
+  - sleep 3
+  - sudo service elasticsearch status
+
+r_packages:
+- covr
+
+after_success:
+- Rscript -e 'covr::codecov()'
 
 notifications:
   email:

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: elasticdsl
 Title: Elasticsearch DSL
 Description: Elasticsearch DSL.
-Version: 0.0.3.9550
-Date: 2016-01-03
+Version: 0.0.3.9800
+Date: 2016-03-01
 License: MIT + file LICENSE
 Authors@R: person("Scott", "Chamberlain", role = c("aut", "cre"),
     email = "myrmecocystus@gmail.com")
@@ -16,5 +16,7 @@ Imports:
     lazyeval,
     dplyr
 Suggests:
-    roxygen2,
-    knitr
+    roxygen2 (>= 5.0.1),
+    knitr,
+    testthat
+RoxygenNote: 5.0.1

NAMESPACE

@@ -1,20 +1,23 @@
-# Generated by roxygen2 (4.1.1): do not edit by hand
+# Generated by roxygen2: do not edit by hand
 
 S3method(as.query,bool)
 S3method(as.query,ids)
 S3method(as.query,params)
 S3method(as.query,prefix)
 S3method(as.query,range)
+S3method(print,elasticdsl_query)
 S3method(print,index)
 export("%>%")
 export(Search_)
+export(aggs)
 export(and)
 export(bool)
 export(bool_)
 export(boosting)
 export(boosting_)
 export(common)
 export(common_)
+export(describe)
 export(exec)
 export(fbool)
 export(fbool_)

R/aggs.R

@@ -0,0 +1,31 @@
+#' elastic DSL aggs
+#'
+#' @name aggs
+#'
+#' @param .obj An index object. If nothing passed defaults to all indices, equivalent to
+#' doing e.g., \code{localhost:9200/_search}
+#' @param ... Further args passed on
+NULL
+
+#' Aggregations
+#'
+#' @export
+#' @rdname aggs
+#'
+aggs <- function(.obj = list(), ...) {
+  aggs_(.obj, .dots = lazyeval::lazy_dots(...))
+}
+
+aggs_ <- function(.obj=list(), ..., .dots) {
+  dots <- lazyeval::all_dots(.dots, ...)
+
+  as.json.aggs <- function(x, ...) {
+    jsonlite::toJSON(list(aggs = x), ..., auto_unbox = TRUE)
+  }
+
+  query <- as.json.aggs(structure(lazy_eval(dots$x), class=c("aggs", "lazy_dots", "list")))
+  execute <- function(.obj, query){
+    Search_(.obj, body = query)
+  }
+  execute(.obj, query)
+}

R/as.fjson.R

@@ -42,6 +42,11 @@ as.fjson.query <- function(x, ...){
   jsonlite::toJSON(x, ..., auto_unbox = TRUE)
 }
 
+as.fjson.esdsl <- function(x, ...){
+  x <- list(query = list(range = parse_range(get_eq(x[[1]]))))
+  jsonlite::toJSON(x, ..., auto_unbox = TRUE)
+}
+
 as.fjson.range <- function(x, ...){
   x <- list(query = list(range = parse_range(get_eq(x[[1]]))))
   jsonlite::toJSON(x, ..., auto_unbox = TRUE)

R/describe.R

@@ -0,0 +1,52 @@
+#' Explain a query
+#'
+#' @export
+#' @param .data (list) input, using higher level interface
+#' @examples
+#' elastic::connect()
+#'
+#' shakespeare <- system.file("examples", "shakespeare_data.json", package = "elastic")
+#' invisible(elastic::docs_bulk(shakespeare))
+#' # index("shakespeare") %>% range( speech_number <= 5 ) %>% describe
+#'
+#' index("shakespeare") %>%
+#'    bool(must_not = list(term=list(speaker="KING HENRY IV"))) %>%
+#'    describe
+#'
+#' geoshape <- system.file("examples", "gbif_geoshape.json", package = "elastic")
+#' invisible(elastic::docs_bulk(geoshape))
+#' index("geoshape") %>%
+#'    geoshape(field = "location", type = "envelope",
+#'             coordinates = list(c(-30, 50), c(30, 0))) %>%
+#'    describe()
+#'
+describe <- function(.data) {
+  pipe_autoexec(toggle = FALSE)
+  if (!inherits(.data, "esdsl")) stop("must be of class esdsl", call. = FALSE)
+  structure(make_query(.data), class = "elasticdsl_query")
+}
+
+#' @export
+print.elasticdsl_query <- function(x, ...) {
+  cat("<elasticdsl query>", sep = "\n")
+  cat(paste0("  base: ", x$url), sep = "\n")
+  cat(paste0("  index: ", x$index), sep = "\n")
+  cat(paste0("  query: \n", x$query), sep = "\n")
+}
+
+make_query <- function(x) {
+  list(
+    url = es_make_url(elastic::connection()),
+    index = attr(x$index, "index"),
+    query = jsonlite::prettify(x$query)
+  )
+}
+
+es_make_url <- function(x) {
+  if (is.null(x$port) || nchar(x$port) == 0) {
+    x$base
+  }
+  else {
+    paste(x$base, ":", x$port, sep = "")
+  }
+}

R/exec.R

@@ -8,6 +8,11 @@ exec <- function(.obj, query, ...) {
   Search_(attr(.obj, "index"), body = tmp$body, params = tmp$params, ...)
 }
 
+exec2 <- function(.obj, query, ...) {
+  pipe_autoexec(toggle = FALSE)
+  Search_(.obj$index, body = .obj$query, ...)
+}
+
 # execute on Search
 execute <- function(.obj, query){
   Search_(.obj, body = query)

R/pipers.R

@@ -1,9 +1,34 @@
 # from @smbache Stefan Milton Bache
 
+#' Information on Potential Pipeline
+#'
+#' This function figures out whether it is called from within a pipeline.
+#' It does so by examining the parent evironment of the active system frames,
+#' and whether any of these are the same as the enclosing environment of
+#' \code{\%>\%}.
+#'
+#' @return A list with the values \code{is_piped} (logical) and \code{env}
+#'   (an environment reference). The former is \code{TRUE} if a pipeline is
+#'   identified as \code{FALSE} otherwise. The latter holds a reference to
+#'   the \code{\%>\%} frame where the pipeline is created and evaluated.
+#'
+#' @noRd
+pipeline_info <- function() {
+  parents <- lapply(sys.frames(), parent.env)
+
+  is_magrittr_env <-
+    vapply(parents, identical, logical(1), y = environment(`%>%`))
+
+  is_piped <- any(is_magrittr_env)
+
+  list(is_piped = is_piped,
+       env      = if (is_piped) sys.frames()[[max(which(is_magrittr_env))]])
+}
+
 #' Toggle Auto Execution On or Off for Pipelines
 #'
 #' A call to \code{pipe_autoexec} allows a function to toggle auto execution of
-#' \code{http} on or off at the end of a pipeline.
+#' \code{jq} on or off at the end of a pipeline.
 #'
 #' @param toggle logical: \code{TRUE} toggles auto execution on, \code{FALSE}
 #'   toggles auto execution off.
@@ -14,52 +39,28 @@
 #' changed to \code{identity}.
 #'
 #' @noRd
-pipe_autoexec <- function(toggle, method = "GET") {
+pipe_autoexec <- function(toggle) {
   if (!identical(toggle, TRUE) && !identical(toggle, FALSE)) {
     stop("Argument 'toggle' must be logical.")
   }
 
   info <- pipeline_info()
 
   if (isTRUE(info[["is_piped"]])) {
+    es_exit <- function(j) if (inherits(j, "esdsl")) exec2(j) else j
     pipeline_on_exit(info$env)
-    info$env$.exec_exitfun <- if (toggle) exec else identity
+    info$env$.es_exitfun <- if (toggle) es_exit else identity
   }
 
   invisible()
 }
 
-#' Information on Potential Pipeline
-#'
-#' This function figures out whether it is called from within a pipeline.
-#' It does so by examining the parent evironment of the active system frames,
-#' and whether any of these are the same as the enclosing environment of
-#' \code{\%>\%}.
-#'
-#' @return A list with the values \code{is_piped} (logical) and \code{env}
-#'   (an environment reference). The former is \code{TRUE} if a pipeline is
-#'   identified as \code{FALSE} otherwise. The latter holds a reference to
-#'   the \code{\%>\%} frame where the pipeline is created and evaluated.
-#'
-#' @noRd
-pipeline_info <- function() {
-  parents <- lapply(sys.frames(), parent.env)
-
-  is_magrittr_env <-
-    vapply(parents, identical, logical(1), y = environment(`%>%`))
-
-  is_piped <- any(is_magrittr_env)
-
-  list(is_piped = is_piped,
-       env      = if (is_piped) sys.frames()[[min(which(is_magrittr_env))]])
-}
-
 #' Setup On-Exit Action for a Pipeline
 #'
 #' A call to \code{pipeline_on_exit} will setup the pipeline for auto execution by
 #' making \code{result} inside \code{\%>\%} an active binding. The initial
 #' call will register the \code{identity} function as the exit action,
-#' but this can be changed to \code{jq} with a call to \code{pipe_autoexec}.
+#' but this can be changed to \code{exec} with a call to \code{pipe_autoexec}.
 #' Subsequent calls to \code{pipeline_on_exit} has no effect.
 #'
 #' @param env A reference to the \code{\%>\%} environment, in which
@@ -68,21 +69,20 @@ pipeline_info <- function() {
 #' @noRd
 pipeline_on_exit <- function(env) {
   # Only activate the first time; after this the binding is already active.
-  if (exists(".exec_exitfun", envir = env, inherits = FALSE, mode = "function")) {
+  if (exists(".es_exitfun", envir = env, inherits = FALSE, mode = "function")) {
     return(invisible())
   }
-  env$.exec_exitfun <- identity
+  env$.es_exitfun <- identity
 
   res <- NULL
 
-  exec_result <- function(v) {
+  es_result <- function(v) {
     if (missing(v)) {
       res
-    }
-    else {
-      res <<- `$<-`(v, value, env$.exec_exitfun(v$value))
+    } else {
+      res <<- `$<-`(v, value, env$.es_exitfun(v$value))
     }
   }
 
-  makeActiveBinding("result", exec_result, env)
+  makeActiveBinding("result", es_result, env)
 }