Execute jq() on last pipe

[sckott]

@smbache Curious if you know how we can sort this out.

This package wraps jq https://stedolan.github.io/jq/

We have a low level interface to execute jq commands just as you would on the cli, but also a higher level DSL, that supports piping https://github.com/ropensci/jqr#high-level

Right now, you can build up a set of jq commands with the DSL, but then at the end you execute with jq()

Know any way that we can have jq() execute on any DSL command, given that it's the last one in the chain? This seems to work in dplyr, but I can't work out how that is done

[smbache]

It's possible, although it is a little tricky (maybe there's a better way).
BTW, what is dplyr calling on after a last pipe?

Anyway, here's a small boiled down example, maybe it can be prettier.

# Check whether inside a pipeline.
is_piped <- function()
{
  parents <- lapply(sys.frames(), parent.env)

  is_magrittr_env <-
    vapply(parents, identical, logical(1), y = environment(`%>%`))

  answer <- any(is_magrittr_env)

  list(answer = answer, 
       env    = if (answer) sys.frames()[[min(which(is_magrittr_env))]])  
}


# This is just a jq placeholder.
# Here just squares the number
jq <- function(x) 
{
  print("jq Called!")

  x^2
}

# Utility for hacking the effect into the pipeline
activate_jq_for_result <- function(env)
{
  res <- NULL

  jq_result <- function(v) 
  { 
    if (missing(v)) {
      res
    }
    else {
      res <<- v
      res$value <<- jq(res$value) 
    }
  }

  makeActiveBinding("result", jq_result, env)
}

# If this function is used in a pipeline it will end up calling jq!
# other than activating jq, it is just an identity function.
f <- function(x)
{

  piped <- is_piped()
  if (isTRUE(piped$answer) && 
      !exists('.jq_activated', envir = piped$env, inherits = FALSE)) {

    piped$env$.jq_activated <- TRUE
    activate_jq_for_result(piped$env)
  }

  x
}



10 %>% f %>% f %>% f
#> "jq Called!"
#> 100

f(f(f(10)))
#> 10

[smbache]

PS: This is activated if f is anywhere in the pipeline, and only if it has not already been done.
It will be called on the final result, before returning from the pipe.

[sckott]

@smbache thanks very much, this looks like exactly what I need!

BTW, what is dplyr calling on after a last pipe?

I don't know. @hadley how do you know to execute commands in dplyr after the last pipe?

[smbache]

no worries! BTW seems like a cool pkg, this!

[hadley]

It's in the print method in dplyr, but it doesn't run the whole query - it just runs enough to retrieve n rows. You have to use an explicit collect() to get everything

[smbache]

@sckott let me know if the above is useful then, and if you need me to elaborate on what's going on. The names should help a bit, but they can do only so much...

[sckott]

Thanks @hadley !

@smbache will do, will try implementing soon

[sckott]

@smbache works great - implemented on dsl-pipe-fix, devtools::install_github("ropensci/jqr", ref="dsl-pipe-fix")

e.g.,

'[0, false, [], {}, null, "hello"]' %>% types
#> ["number","boolean","array","object","null","string"]

'{"foo": 5, "bar": 7}' %>% keys
#> ["bar","foo"]

'{"foo": 5, "bar": 7}' %>% select(a = .foo)
#> {"a":5}

no need for the jq() call at the end now :)

[karthik]

This is super cool! 💯

[sckott]

thx - almost to a CRAN 1st version

[smbache]

Great!! :)

[richfitz]

Thanks so much @smbache and @hadley

[smbache]

Wondering if you need some of the functions to switch off the mechanism? Say peek...

[sckott]

@smbache Yes, for peek, combine, and possibly others, Any ideas?

[smbache]

Sure. I have modified my original example to go both ways. I included example documentation, which you can use if you feel like it. I could have made a PR, but I'll let you do the dirty work ;-) Let me know if this is successful:

#' 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))]])  
}


# This is just a jq placeholder.
# Here just squares the number
jq <- function(x) 
{
  print("jq Called!")

  x^2
}

#' Toggle Auto Execution On or Off for Pipelines
#'
#' A call to \code{pipe_autoexec} allows a function to toggle auto execution of
#' \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.
#'
#' @details Once auto execution is turned on the \code{result} identifier inside
#' the pipeline is bound to an "Active Binding". This will not be changed on 
#' toggling auto execution off, but rather the function to be executed is 
#' changed to \code{identity}.
#'
#' @noRd  
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"]])) {
    pipeline_on_exit(info$env)
    info$env$.jq_exitfun <- if (toggle) jq else identity
  }

  invisible()
}

#' 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}.
#' Subsequent calls to \code{pipeline_on_exit} has no effect.
#'  
#' @param env A reference to the \code{\%>\%} environment, in which 
#'   \code{result} is to be bound.
#'   
#' @noRd
pipeline_on_exit <- function(env)
{
  # Only activate the first time; after this the binding is already active.
  if (exists(".jq_exitfun", envir = env, inherits = FALSE, mode = "function")) {
    return(invisible())
  }
  env$.jq_exitfun <- identity

  res <- NULL

  jq_result <- function(v) 
  { 
    if (missing(v)) {
      res
    }
    else {
      res <<- `$<-`(v, value, env$.jq_exitfun(v$value))
    }
  }

  makeActiveBinding("result", jq_result, env)
}


# Example of function toggling auto execution on
f <- function(x)
{
  pipe_autoexec(toggle = TRUE)
  x
}

# Example of function toggling auto execution off
g <- function(x)
{
  pipe_autoexec(toggle = FALSE)
  x
}


10 %>% f %>% f %>% f
#> "jq Called"
#> 100

10 %>% f %>% f %>% g
#> 10

10 %>% f %>% g %>% f
#> "jq Called"
#> 100

f(f(f(10)))
#> 10

[sckott]

@smbache Awesome, thanks, will try this soon...