R/func-range.r

Defines functions satisfies max_satisfying valid_range ltr gtr outside to_comparators

Documented in gtr ltr max_satisfying satisfies valid_range

#' Check if a semantic version number satisfies a range requirement
#'
#' TODO
#'
#' @param version Version string or \code{semver} object.
#' @param range Range requirement string or \code{range} object.
#' @param loose Whether non-strict versions are allowed.
#' 
#' @export

satisfies <- function(version, range, loose = FALSE) {

  range <- try(semver::range$new(range, loose), silent = TRUE)

  if (is(range, "try-error")) { return(FALSE) }

  range$test(version)
}

#' Choose the newest version that satisfies a range requirement
#'
#' TODO
#'
#' @param versions List or vector of version strings or \code{semver}
#'   objects.
#' @param range Range requirement string or \code{range} object.
#' @param loose Whether non-strict versions are allowed.
#' 
#' @export

max_satisfying <- function(versions, range, loose = FALSE) {
  versions <- Filter(function(version) satisfies(version, range, loose),
                     versions)
  if (length(versions) > 0) {
    versions <- semver_sort(versions, loose = loose)
    versions[[length(versions)]]
  } else {
    NULL
  }
}

#' Check if a range requirement specification is valid
#'
#' TODO
#'
#' @param range Range requirement string.
#' @param loose Whether loose ranges are allowed.
#' 
#' @export

valid_range <- function(range, loose = FALSE) {

  range <- try(semver::range$new(range, loose)$range, silent = TRUE)

  if (is(range, "try-error")) {
    NULL
  } else {
    if (range == "") "*" else range
  }
}

#' Check if a version is older than a range requirement
#'
#' TODO
#'
#' @param version Version string or \code{semver} object.
#' @param range Range requirement string or \code{range} object.
#' @param loose Whether loose ranges are allowed.
#' 
#' @export

ltr <- function(version, range, loose = FALSE) {
  outside(version, range, "<", loose)
}

#' Check if a version is newer than a range requirement
#'
#' @param version Version string or \code{semver} object.
#' @param range Range requirement string or \code{range} object.
#' @param loose Whether loose ranges are allowed.
#' 
#' @export

gtr <- function(version, range, loose = FALSE) {
  outside(version, range, ">", loose)
}

outside <- function(version, range, hilo, loose) {

  version <- semver$new(version, loose)
  range <- semver::range$new(range, loose)

  if (hilo == ">") {
    gt_fn <- gt
    lte_fn <- lte
    lt_fn <- lt
    comp <- ">"
    ecomp <- ">="

  } else if (hilo == "<") {
    gt_fn <- lt
    lte_fn <- gte
    lt_fn <- gt
    comp <- "<"
    ecomp <- "<="

  } else {
    stop("Internal error, this should not happen")
  }

  ## If it satisifes the range it is not outside
  if (satisfies(version, range, loose)) {
    return(FALSE)
  }

  ## From now on, variable terms are as if we're in "gtr" mode.
  ## but note that everything is flipped for the "ltr" function.

  for (comparators in range$set) {

    high <- NULL
    low <- NULL

    for (comparator in comparators) {
      high <- high %||% comparator
      low <- low %||% comparator
      if (gt_fn(comparator$semver, high$semver, loose)) {
        high <- comparator
      } else if (lt_fn(comparator$semver, low$semver, loose)) {
        low <- comparator
      }
    }

    ## If the edge version comparator has a operator then our version
    ## isn't outside it
    if ((high$operator %===% comp) %||% (high$operator %===% ecomp)) {
      return(FALSE)
    }

    ## If the lowest version comparator has an operator and our version
    ## is less than it then it isn't higher than the range
    if ((nay(low$operator) %||% (low$operator %===% comp)) &&
        lte_fn(version, low$semver)) {
      return(FALSE)
    } else if ((low$operator %===% ecomp) &&
               (lt_fn(version, low$semver))) {
      return(FALSE)
    }
  }

  TRUE
}

to_comparators <- function(range, loose = FALSE) {
  res <- semver::range$new(range, loose)$set
  lapply(res, function(comp) {
    r <- lapply(comp, function(c) { c$value })
    r <- paste(r, collapse = " ")
    r <- trim(r)
    r <- re_split(r, " ")
    as.list(r)
  })
}
metacran/semver documentation built on May 22, 2019, 7:48 p.m.