R/api_xq.R

In ShixiangWang/UCSCXenaTools: Download and Explore Datasets from UCSC Xena Data Hubs

# FUN: Create API functions from .xq files

#' Convert camel case to snake case
#'
#' @param name a character vector
#'
#' @return same length as `name` but with snake case
#' @export
#'
#' @examples
#' to_snake("sparseDataRange")
to_snake <- function(name) {
  s <- sub("(.)([A-Z][a-z]+)", "\\1_\\2", name)
  s <- gsub("([a-z0-9])([A-Z])", "\\1_\\2", s)
  tolower(s)
}

.rm_extension <- function(filepath) {
  sub(
    pattern = "(.*)\\..*$", replacement = "\\1",
    basename(filepath)
  )
}

.marshall_param <- function(p) {
  stopifnot(is.atomic(p) | is.list(p))

  # If input is a list, use .arrayfmt, this fix single gene/sample query
  if (is.list(p)) {
    p <- as.character(p)
    return(.arrayfmt(p))
  } else if (length(p) == 1) {
    return(.quote(p))
  } else if (length(p) > 1) {
    return(.arrayfmt(p))
  } else {
    return("nil")
  }
}

.call <- function(query, params) {
  sprintf(
    "(%s %s)", query,
    paste(sapply(params, .marshall_param),
      collapse = " "
    )
  )
}

.make_fun <- function(fun, body, args) {
  eval(parse(text = paste(fun,
    "<- function(",
    args,
    ") {\n",
    body,
    "\n}",
    sep = ""
  )),
  envir = as.environment("package:UCSCXenaTools")
  )
  # as.call(c(as.name("{"), e)) -> body(ff)
  # parse(text="y=\"1\"; return(y)")
}


.init_api <- function() {
  # .api_generator
  xq_files <- list.files(
    system.file("queries", package = "UCSCXenaTools"),
    pattern = "xq",
    full.names = TRUE
  )

  if (length(xq_files) == 0) {
    stop("No xq file find!")
  }


  for (f in xq_files) {
    fn <- .rm_extension(f)
    fun <- to_snake(fn)
    query <- readr::read_file(f)
    params <- sub(
      "^[^[]+[[]([^]]*)[]].*$",
      "\\1",
      query
    )
    params <- unlist(strsplit(params, split = " "))
    all_params <- c("host", params)

    params <- paste(params, collapse = ", ")
    all_params <- paste(all_params, collapse = ", ")
    # Create hidden variable for storing xquery
    xquery <- paste0(".xq_", fun)
    assign(xquery, query,
      envir = as.environment("package:UCSCXenaTools")
    )
    body <- sprintf(
      "xquery=get(\".xq_%s\", as.environment(\"package:UCSCXenaTools\")) \nUCSCXenaTools:::.xena_post(host, UCSCXenaTools:::.call(xquery, list(%s)), simplifyVector = TRUE)",
      fun,
      params
    )

    # Create hidden functions
    fun <- paste0(".p_", fun)
    .make_fun(fun, body, all_params)
  }
}