remake: Make-like build management

## Will change name soon, but the basic idea is to sort out what it is
## that we have to run:
##
## TODO: Need some tests here, throughout
process_target_command <- function(name, dat, file_extensions) {
  core <- c("command", "rule", "args", "depends", "is_target")

  ## Quick check that may disappear later:
  invalid <- c("rule", "target_argument", "quoted")
  if (any(invalid %in% names(dat))) {
    stop("Invalid keys: ",
         paste(intersect(invalid, names(dat)), collapse=", "))
  }

  if (length(dat$depends) > 0) {
    ## TODO: this might come through as a proper yaml map list
    ##   depends:
    ##    - data: processed
    ## or improperly as
    ##   depends:
    ##     data: processed
    ## The contortions below do a reasonable job of dealing with this,
    ## but it's not enough.
    dat$depends <- unlist(from_yaml_map_list(dat$depends))
  } else {
    dat$depends <- character(0)
  }

  if (!is.null(dat$command)) {
    cmd <- parse_target_command(name, dat$command)

    if (length(dat$depends > 0)) {
      cmd$depends <- c(cmd$depends, dat$depends)
    }

    rewrite <- intersect(names(cmd), core)
    dat[rewrite] <- cmd[rewrite]
  }

  type <- target_infer_type(name, dat, file_extensions)

  is_command <- names(dat) %in% core
  list(command=dat[is_command], opts=dat[!is_command], type=type)
}

## There will be *two* possible way of getting
## target_argument in:
##  - use the target name, *in quotes*
##  - use the special name target_name, *no quotes*.  This then
##    becomes a restricted name in target_reserved_names.
parse_target_command <- function(target_name, command, file_extensions) {
  if (is.character(command) && length(command) > 1L) {
    ## TODO: this might be better off being assert_scalar_character?
    stop("commands must be scalar")
  }

  dat <- parse_command(command)
  if (length(dat$depends) > 0L) {
    ## This whole section tries to work out the target_argument field.
    depends <- dat$depends

    ## Deal with dots first (move into parse_command?)
    is_dot <- depends == "."
    if (sum(is_dot) > 1L) {
      stop("Only a single dot argument allowed")
    } else if (sum(is_dot) == 1L) {
      i <- which(is_dot)
      if (is.character(dat$args[[i]])) {
        stop("Dot argument must not be quoted (it's like a variable)")
      }
    }

    ## Then with target_name
    pos <- c(target_name, "target_name")
    ## Need to determine that there is only a single possible target:
    i <- sapply(pos, function(x) depends == x)
    if (length(depends) == 1) {
      i <- rbind(i, deparse.level=0)
    }

    if (sum(i) == 1L) {
      j <- unname(which(rowSums(i) == 1L))
      ## Check quotedness:
      v <- dat$args[[j]]
      if (is.character(v) && v == "target_name") {
        stop("target_name must not be quoted (it's like a variable)")
      } else if (is.name(v) && v != quote(target_name)) {
        stop("target name must be quoted (it must be a file name)")
      }

      ## Then remove target_name from the dependencies.
      dat$args[[j]] <- target_name
      dat$depends <- dat$depends[-j]
      dat$command[[j + 1L]] <- target_name
      dat$is_target[[j]] <- FALSE
    } else if (sum(i) > 1L) {
      n <- colSums(i)
      n <- n[n > 0]
      stop(sprintf("target name matched multiple times in command for '%s': %s",
                   dat$rule,
                   paste(sprintf("%s (%d)", names(n), n), collapse=", ")))
    }
  }
  dat
}

## I think this is where I need to intervene -- rebuild this from the
## ground up.
##
## I think that numbers and logical values could autmatically be
## passed through as as-is once we're done here, so make sure not to
## jepordise that.
parse_command <- function(str) {
  command <- check_command(str)

  rule <- check_command_rule(command[[1]])

  ## First, test for target-like-ness.  That will be things that are
  ## names or character only.  Numbers, etc will drop through here:
  is_target <- unname(vlapply(command[-1], is_target_like))

  ## ...and we check them and I() arguments here:
  if (any(!is_target)) {
    i <- c(FALSE, !is_target)
    command[i] <- lapply(command[i], check_literal_arg)
  }

  ## TODO: DEPENDS: Who actually uses args, given it's defined so simply?
  args <- as.list(command[-1])
  depends <- vcapply(args[is_target], as.character)

  list(rule=rule, args=args, depends=depends, is_target=is_target,
       command=command)
}

check_command <- function(str) {
  if (is.language(str)) {
    command <- str
  } else {
    assert_scalar_character(str)
    command <- parse(text=as.character(str), keep.source=FALSE)
    if (length(command) != 1L) {
      stop("Expected single expression")
    }
    command <- command[[1]]
  }
  if (length(command) == 0) {
    stop("I don't think this is possible")
  }
  if (!is.call(command)) {
    stop("Expected a function call (even with no arguments)")
  }
  command
}

check_command_rule <- function(x) {
  if (is.name(x)) {
    x <- as.character(x)
  } else if (!is.character(x)) {
    stop("Rule must be a character or name")
  }
  x
}

## The trick here is going to be working out which of these need later
## looking up, if we allow this.
check_literal_arg <- function(x) {
  if (is.atomic(x)) { # logical, integer, complex types
    x
  } else if (is.call(x)) {
    if (identical(x[[1]], quote(I))) {
      x[[2]]
    } else {
      ## This error message is not going to be useful:
      stop("Unknown special function ", as.character(x[[1]]))
    }
  } else {
    stop("Unknown type in argument list")
  }
}

is_target_like <- function(x) {
  is.character(x) || is.name(x)
}


target_infer_type <- function(name, dat, file_extensions) {
  type <- dat$type
  if (is.null(type)) {
    type <- if (target_is_file(name, file_extensions)) "file" else  "object"
    if ("knitr" %in% names(dat)) {
      type <- "knitr"
    } else if ("download" %in% names(dat)) {
      type <- "download"
    } else if ("plot" %in% names(dat)) {
      type <- "plot"
    } else if (type == "object" && is.null(dat$command)) {
      type <- "fake"
    }
  } else {
    assert_scalar_character(type)
  }
  type
}

target_is_file <- function(x, file_extensions) {
  is_file <- grepl("/", x, fixed=TRUE)
  check <- !is_file
  if (any(check)) {
    if (is.null(file_extensions)) {
      file_extensions <- file_extensions()
    }
    is_file[check] <- tolower(file_extension(x[check])) %in% file_extensions
  }
  is_file
}