R/lockfile-diff.R

renv_lockfile_diff <- function(old, new, compare = NULL) {

  compare <- compare %||% function(lhs, rhs) {
    list(before = lhs, after = rhs)
  }

  # ensure both lists have the same names, inserting missing
  # entries for those without any value
  nms <- union(names(old), names(new)) %||% character()
  if (length(nms)) {

    nms <- sort(nms)
    old[setdiff(nms, names(old))] <- list(NULL)
    new[setdiff(nms, names(new))] <- list(NULL)

    old <- old[nms]
    new <- new[nms]

  }

  # check for differences
  diffs <- mapply(
    renv_lockfile_diff_impl, old, new,
    MoreArgs = list(compare = compare),
    SIMPLIFY = FALSE
  )

  # drop NULL entries
  diffs[!map_lgl(diffs, empty)]

}

renv_lockfile_diff_impl <- function(lhs, rhs, compare) {
  case(
    is.list(lhs) && empty(rhs)   ~ renv_lockfile_diff(lhs, list(), compare),
    empty(lhs) && is.list(rhs)   ~ renv_lockfile_diff(list(), rhs, compare),
    is.list(lhs) && is.list(rhs) ~ renv_lockfile_diff(lhs, rhs, compare),
    !identical(c(lhs), c(rhs))   ~ compare(lhs, rhs),
    NULL
  )
}

renv_lockfile_diff_packages <- function(old, new) {

  old <- renv_records(old)
  new <- renv_records(new)

  packages <- named(union(names(old), names(new)))
  actions <- lapply(packages, function(package) {

    before <- old[[package]]; after <- new[[package]]

    case(
      is.null(before) ~ "install",
      is.null(after)  ~ "remove",

      before$Version < after$Version ~ "upgrade",
      before$Version > after$Version ~ "downgrade",
      before$Source != after$Source  ~ "crossgrade"
    )

  })

  Filter(Negate(is.null), actions)

}
slopp/renv documentation built on July 6, 2019, 12:08 a.m.