Walk over a code base scanning for a particular pattern of usage

scanForDotUsage.R

library(vadr)
library(plyr)

# do "chain" arguments ever feature a dot on the second level (not in
# its own chain?) Answer by walking over expressions to pull out
# examples of usages.

dirs = c("~/analysis", "~/analysis/writing")

globs = c("*.r", "*.R")

allglobs = chain(
  outer(dirs, globs, file.path),
  as.vector,
  Sys.glob)

find.dot.usages <- function() {
  flatmap(allglobs,
          function(file) {
            chain(file,
                  parse,
                  get.dot.usages,
                  lapply(function(x) list(file, x)))
          })
}

all.exprs <- flatmap(allglobs, chain, parse(keep.source=TRUE))

get.dot.usages <- function(exprs) {
  flatmap(exprs, ordinary.expression.usages)
}

chaining.calls = alist("chain", "inject", "mkchain", "put", "alter")

statemachine <- function(label, if.chain, if.dot.call, if.other.call, if.dot,
                         keep.all=FALSE) {
  function(expr) {
    ## cat(".(a)(.(b))\n" %#% list(a=deparse(arg_expr(label)),
    ##                             b=deparse(expr)))
    if (is.call(expr)) {
      if (is.call(expr[[1]])) {
        mapper <- if.other.call
      } else if (as.character(expr[[1]]) %in% chaining.calls) {
        mapper <- if.chain
      } else if (expr[[1]] == quote(.)) {
        mapper <- if.dot.call
      } else {
        mapper <- if.other.call
      }
      usages <- flatmap(expr[-1], mapper)
      if (keep.all) {
        # if (length(usages) > 0) browser()
        usages[] <- list(expr)
        usages
      } else {
        wrap.calls(usages, expr[[1]])
      }
    } else {
      if (identical(expr, quote(.))) {
        if.dot(expr)
      } else {
        list()
      }
    }
  }
}

ordinary.dot <- function(x) list()

ordinary.expression.usages <- statemachine(
  ordinary.expression.usages,
  if.chain = chaining.argument.usages,
  if.dot.call = ordinary.expression.usages,
  if.other.call = ordinary.expression.usages,
  if.dot = ordinary.dot)

chaining.argument.usages <- statemachine(
  chaining.argument.usages,
  if.chain = chaining.argument.usages,
  if.dot.call = child.chain.usages,
  if.other.call = child.chain.usages,
  if.dot = ordinary.dot,
  keep.all=TRUE)

child.chain.usages <- statemachine(
  child.chain.usages,
  if.chain = chaining.argument.usages,
  if.dot.call = grandchild.chained.usages,
  if.other.call = grandchild.chained.usages,
  if.dot = ordinary.dot)

grandchild.chained.usages <- statemachine(
  grandchild.chained.usages,
  if.chain = chaining.argument.usages,
  if.dot.call = log.usage,
  if.other.call = grandchild.chained.usages,
  if.dot = log.usage)

log.usage <- function(expr) list(expr)

wrap.calls <- function(list, wrap) {
  lapply(list, function(item)
    as.call(list(wrap, item)) )
}

flatmap <- function(l, f, ...) {
  splat(c)(lapply(l, f, ...))
}

mapped.flatmap <- function(l, f, ...) {
  output <- lapply(l, f, ...)
  mapped <- Map(
    function(first, second) {
      lapply(second,
             function(s) list(first, s))
    },
    l, output)
  splat(c)(mapped)
}