An example of R code to generate a update query string

update_query_example.R

library(dplyr)
library(purrr)

#' generate a string for updating qc status table
#' 
#' a qc status table is expect (at minimum) to have fields:
#' - sample -- the accession number (unique identitfier of sample by vendor)
#' - panel -- the test panel run on the sample
#' - qc_failed -- a qc status integer corresponding to 0-5 statuses (found on a lookup table)
#' 
#' ... are keyrword arguments  of fields that also are updated like comment, notable, etc...
#' 
#' arguments:
#' @param  acc acession number [character]
#' @param panel test panel [character]
#' @param conn connection [DBI::DBIConnection]
#' @param qc_failed status value [integer]
#' @param table_name table name [character]
#' 
#' Return:
#' @return query string [character]
updateStatusByAccession <- function(acc, panel, conn, qc_failed, 
																		table_name=in_schema("public", "table_name"), ...){

	query_values <- help_parseKwArgs(list("qc_failed" = qc_failed), list(...))

	where_clause <- list(sample = acc, panel = panel)
  
  query <- c(paste("update", as.character(table_name)), 
             "\tset",
             paste("\t\t",help_concNameVal(query_values), collapse=",\n"),
             "\twhere",
             paste("\t\t", help_concNameVal(where_clause), collapse=",\n"))

  paste(query, collapse="\n")
}

#' takes query values (values that are update in the update query) from a
#' arbitarily limited list of variable/fields
#' 
#' arguments:
#' @param qv query value list [list]
#' @param kwards keyword arguments [list]
#' 
#' returns:
#' @returns key-value pair as strings ("<key>-<value>") as appears in the
#'   constrained set of field names [list]
help_parseKwArgs <- function(qv, kwargs){
  # a set of possible variables
  # vectors are values that must be added together
  std_kw <- list("comment", "notable", c("verified", "verified_by", "verified_date"))
  
  # add_Val adds a value to the qv if exists kwargs
  add_val <- function(k){
    if(k %in% names(kwargs)){
        qv[k] <<- kwargs[k]
    }
  }
  
  # checks to see if value(s) exists in  and then applies add_Val, this works on
  # linked fields to not run if one or more is missing
  linked_add <- function(vs){
    if(reduce(vs, (function(x,y){x & (y %in% names(kwargs))}), .init = vs[[1]] %in% names(kwargs))){ 
      sapply(vs, add_val)
    }
  }
  
  sapply(std_kw, linked_add)
  
  qv
}


#' transform singleton values to appropriate postgresql type string
#' 
#' currently supports the conversion of character string to be single-quoted
#' ('') for sql
#' 
#' @param l list item
#' @returns the value as a sql-ready string
help_typeSingleton <- function(l){
  v <- l %>% unlist(use.names = F)

  if(typeof(v) == "character"){
    paste0("'", v, "'")
  } else {
    v
  }
}

#' tranforms a list object of name and values into a vector of <name> = <val> strings
#'
#' @param lst list object of key-values
#' @param sep seperator between key-value when turned into strings
#' 
#' @returns key-value pairs in "<key> = <value>"
help_concNameVal <- function(lst, sep = "="){
  concnv <- function(n){
   paste(n, sep, help_typeSingleton(lst[n][1]))
  }

  sapply(names(lst), concnv) %>% unlist %>% unname
}