R/parse.R

In Miachol/configr: An Implementation of Parsing and Writing Configuration File (JSON/INI/YAML/TOML)

#' Parse the configuration {{var}} format, and replace it by extra.list values
#'
#' @param config A list that were generated by read.config/eval.config/eval.config.merge
#' @param extra.list A list that can replace the configuration file '{{debug}}' by list(debug = TRUE), and {{debug}} will be setted to TRUE
#' @param other.config Path of another configuration file that can replace the configuration file '{{key:value}}' 
#' @param rcmd.parse Logical wheather parse '@>@str_replace('abc', 'b', 'c')@<@' in config to 'acc'
#' @param bash.parse Logical wheather parse '#>#echo $HOME#<#' in config to your HOME PATH
#' @param glue.parse Logical wheather parse '!!glue{1:5}' in config to ['1','2','3','4','5']; 
#' ['nochange', '!!glue(1:5)', 'nochange'] => ['nochange', '1', '2', '3', '4', '5', 'nochange']
#' @param glue.flag A character flag indicating wheater run glue() function to parse (Default is !!glue) 
#' @param global.vars.field All vars defined in global.vars.field will as the extra.list params [gloval_var]
#' @return A list
#' @export
#' @examples
#' config.json <- system.file('extdata', 'config.json', package='configr')
#' config.other <- system.file('extdata', 'config.other.yaml', package='configr')
#' config <- read.config(config.json)
#' parse.extra(config, list(debug = 'TRUE'))
#' parse.extra(config, list(debug = 'TRUE'), other.config = config.other)
#' parse.extra(config, list(debug = 'TRUE'), other.config = config.other, 
#' rcmd.parse = TRUE)
#' parse.extra(config, list(debug = 'TRUE'), other.config = config.other, 
#' rcmd.parse = TRUE, bash.parse = TRUE)
#'
#' raw <- c('a', '!!glue{1:5}', 'c')
#' expect.parsed.1 <- c('a', '1', '2', '3', '4', '5', 'c')
#' list.raw <- list(glue = raw, nochange = 1:10)
#' parsed <- parse.extra(list.raw, glue.parse = TRUE)
#' 
#' raw <- c('!!glue_numeric{1:5}')
#' expect.parsed.1 <- c(1, 2, 3, 4, 5)
#' list.raw <- list(glue = raw, nochange = 1:10)
#' parsed <- parse.extra(list.raw, glue.parse = TRUE)
parse.extra <- function(config, extra.list = list(), other.config = "", rcmd.parse = FALSE, 
  bash.parse = FALSE, glue.parse = FALSE, glue.flag = "!!glue", global.vars.field = "global_vars") {
  if (length(config) == 0) {
    return(config)
  }
  if (!is.null(names(extra.list))) {
    config <- parse.extra.list(config, extra.list)
  }
  if (other.config != "") {
    config <- parse.extra.config(config, other.config)
  }
  if (rcmd.parse) {
    config <- parse.extra.rcmd(config)
  }
  if (bash.parse) {
    config <- parse.extra.bash(config)
  }
  if (glue.parse) {
    config <- parse.extra.glue(config, glue.flag = glue.flag)
  }
  if (is.character(global.vars.field)) {
    config <- parse.extra.global.vars(config, global.vars.field = global.vars.field)
  }
  return(config)
}

# Parse the configuration {{var}} format string, and replace it by extra.list
# values
parse.extra.list <- function(config, extra.list) {
  list.names <- 1:length(config)
  args.all <- extra.list
  for (list.item in list.names) {
    list.tmp <- config[[list.item]]
    if (is.list(list.tmp)) {
      config[[list.item]] <- parse.extra.list(config[[list.item]], args.all)
    } else {
      if (all(!str_detect(list.tmp, "\\{\\{"))) {
        next
      }
      text <- str.extract.var(list.tmp)
      for (item in text) {
        if (!item %in% names(args.all)) {
          next
        }
        item.value <- eval(parse(text = sprintf("args.all$`%s`", item)))
        config[[list.item]] <- str_replace_all(config[[list.item]], sprintf("\\{\\{%s\\}\\}", 
          item), item.value)
      }
    }
  }
  return(config)
}

# Parse the configuration {{key:value}} format string and replace it by
# other.config values
parse.extra.config <- function(config, other.config) {
  list.names <- 1:length(config)
  if (!is.character(other.config)) {
    return(config)
  }
  for (list.item in list.names) {
    list.tmp <- config[[list.item]]
    if (is.list(list.tmp)) {
      config[[list.item]] <- parse.extra.config(config[[list.item]], other.config)
    } else {
      if (all(!str_detect(list.tmp, "\\{\\{"))) {
        next
      }
      text <- str.extract.var(list.tmp)
      if (length(text) == 0) {
        next
      }
      for (i in 1:length(text)) {
        if (is.list(text)) {
          text.nonlist <- text[[i]]
        } else {
          text.nonlist <- text
        }
        config <- parse.extra.config.nonlist(config, list.item, text.nonlist, 
          other.config)
      }
    }
  }
  return(config)
}

# Function read from other config and parse a key:value key2:value vector to real
# value
parse.extra.config.nonlist <- function(config, list.item, text.nonlist, other.config) {
  text <- text.nonlist
  other.config <- read.config(file = other.config)
  text.list <- str_split(text, ":")
  for (i in 1:length(text.list)) {
    pass <- FALSE
    text.list.value <- text.list[[i]]
    for (j in 1:length(text.list.value)) {
      if (j == 1) {
        if (text.list.value[[j]] %in% names(other.config)) {
          other.config.tmp <- other.config[[text.list.value[[j]]]]
        } else {
          other.config.tmp <- list()
          pass <- TRUE
        }
      } else {
        if (text.list.value[[j]] %in% names(other.config.tmp)) {
          other.config.tmp <- other.config.tmp[[text.list.value[[j]]]]
        } else {
          pass <- TRUE
        }
      }
    }
    if (!pass) {
      other.config.tmp <- as.character(other.config.tmp)
      config[[list.item]] <- str_replace_all(config[[list.item]], sprintf("\\{\\{%s\\}\\}", 
        text[i]), other.config.tmp)
    }
  }
  return(config)
}

# Parse the configuration @>@ Rcmd @<@ format string and replace it by its return
# values
parse.extra.rcmd <- function(config) {
  config <- parse.config.recursion(config, parse.nonlist.fun = parse.extra.rcmd.nonlist, 
    "@>@", "@<@")
  return(config)
}

parse.extra.rcmd.nonlist <- function(config, list.item, text.nonlist) {
  for (text.raw in text.nonlist) {
    text.cmd <- format.cmd(text.raw, "@>@", "@<@")
    cmd.value <- eval(parse(text = text.cmd))
    cmd.value <- paste0(cmd.value, collapse = " ")
    config[[list.item]] <- str_replace_all(config[[list.item]], fixed(text.raw), 
      cmd.value)
  }
  return(config)
}

# Parse the configuration #># bash cmd #<# format string and replace it by its
# return (muliple will be paste by space) values
parse.extra.bash <- function(config) {
  config <- parse.config.recursion(config, parse.extra.bash.nonlist, "#>#", "#<#")
  return(config)
}

parse.extra.bash.nonlist <- function(config, list.item, text.nonlist) {
  for (text.raw in text.nonlist) {
    text.cmd <- format.cmd(text.raw, "#>#", "#<#")
    if (length(text.cmd) == 0) {
      next
    }
    cmd.value <- system(text.cmd, intern = TRUE)
    cmd.value <- paste0(cmd.value, collapse = " ")
    config[[list.item]] <- str_replace_all(config[[list.item]], fixed(text.raw), 
      cmd.value)
  }
  return(config)
}

# Format cmd avoid error
format.cmd <- function(cmd, left.flag, right.flag) {
  text.cmd <- str_replace_all(cmd, sprintf("%s|%s", fixed(left.flag), fixed(right.flag)), 
    "")
  text.cmd <- str_replace_all(text.cmd, "%'%", "\"")
  text.cmd <- str_split(text.cmd, fixed("\\n"))[[1]]
  text.cmd <- text.cmd[!str_detect(text.cmd, "^[ ]*$")]
  text.cmd <- str_replace_all(text.cmd, fixed("\\n"), "")
}

# Extract cmd from @>@.*@<@ or #>#.*#<# format text
extract.cmd.items <- function(list.tmp, left.flag, right.flag) {
  text <- str_extract_all(list.tmp, sprintf("%s.*%s", left.flag, right.flag))
  text <- lapply(text, function(x) str_split(x, fixed(left.flag)))
  text <- unlist(text)
  text <- text[text != ""]
  text <- paste0(left.flag, text)
  text <- str_replace_all(text, sprintf(".*%s", left.flag), left.flag)
  text <- str_replace_all(text, sprintf("%s.*", right.flag), right.flag)
  text <- unique(text)
}

parse.config.recursion <- function(config, parse.nonlist.fun, left.flag, right.flag) {
  list.names <- 1:length(config)
  for (list.item in list.names) {
    list.tmp <- config[[list.item]]
    if (is.list(list.tmp)) {
      config[[list.item]] <- parse.config.recursion(config[[list.item]], parse.nonlist.fun, 
        left.flag, right.flag)
    } else {
      if (all(!str_detect(list.tmp, left.flag) | !str_detect(list.tmp, right.flag))) {
        next
      }
      text <- extract.cmd.items(list.tmp, left.flag, right.flag)
      if (length(text) == 0) {
        next
      }
      for (i in 1:length(text)) {
        if (is.list(text)) {
          text.nonlist <- text[[i]]
        } else {
          text.nonlist <- text
        }
        config <- parse.nonlist.fun(config, list.item, text.nonlist)
      }
    }
  }
  return(config)
}

# Parse like {1:5} and get final value (input a list)
str2multiple <- function(input = "", glue.flag = "!!glue") {
  index <- str_detect(input, fixed(glue.flag))
  if (any(index)) {
    glue.cus <- function(x) {
      if (str_detect(x, fixed(glue.flag))) {
        glue.numeric.flag <- sprintf("%s_numeric", glue.flag)
        is.numeric.flag <- str_detect(x, fixed(glue.numeric.flag))
        if (is.numeric.flag) {
          x <- str_replace_all(x, fixed(glue.numeric.flag), "")
        } else {
          x <- str_replace_all(x, fixed(glue.flag), "")
        }
        x <- str_replace_all(x, "^ *", "")
        if (is.numeric.flag) {
          x <- as.numeric(glue(x))
        } else {
          x <- as.character(glue(x))
        }
      }
      return(x)
    }
    if (length(input) == 1) {
      parsed <- glue.cus(input)
    } else {
      parsed <- sapply(input, glue.cus)
      parsed <- unname(unlist(parsed))
    }
    return(parsed)
  } else {
    return(input)
  }
}

parse.extra.global.vars <- function(config, global.vars.field = "global_vars") {
  if (is.character(global.vars.field) && global.vars.field %in% names(config) && 
      length(config[[global.vars.field]]) > 0) {
    global.vars <- config[[global.vars.field]] 
    extra.list <- paste0(global.vars, '="', unname(sapply(config[global.vars],
                     function(x){return(x)[1]})), '"', collapse = ", ")
    extra.list <- eval(parse(text = sprintf("list(%s)", extra.list)))
    config <- parse.extra(config, extra.list = extra.list, global.vars.field = NULL)
    return(config) 
  } else {
    return(config)
  }
}

# Use glue to parse character
parse.extra.glue <- function(config, glue.flag = "!!glue") {
  list.names <- 1:length(config)
  for (list.item in list.names) {
    list.tmp <- config[[list.item]]
    if (is.list(list.tmp)) {
      config[[list.item]] <- parse.extra.glue(config[[list.item]])
    } else {
      config[[list.item]] <- str2multiple(config[[list.item]], glue.flag = glue.flag)
    }
  }
  return(config)
}