1#' Tools for Bioconductor versions and repositories
2#'
3#' \section{API:}
4#'
5#' ```
6#' get_yaml_config(forget = FALSE)
7#' set_yaml_config(text)
8#'
9#' get_release_version(forget = FALSE)
10#' get_devel_version(forget = FALSE)
11#'
12#' get_version_map(forget = FALSE)
13#' get_matching_bioc_version(r_version = getRversion(), forget = FALSE)
14#' get_bioc_version(r_version = getRversion(), forget = FALSE)
15#'
16#' get_repos(bioc_version = "auto", forget = FALSE)
17#' ```
18#'
19#' * `forget`: Whether to forget the cached version of the Bioconductor
20#'   config YAML file and download it again.
21#' * `text`: character vector (linewise) or scalar, the contents of the
22#'   `config.yaml` file, if obtained externally, to be used as a cached
23#'   version in the future.
24#' * `r_version`: R version string, or `package_version` object.
25#' * `bioc_version`: Bioc version string or `package_version` object,
26#'   or the string `"auto"` to use the one matching the current R version.
27#'
28#' `get_yaml_config()` returns the raw contents of the `config.yaml` file,
29#' linewise. It is typically not needed, except if one needs information
30#' that cannot be surfaces via the other API functions.
31#'
32#' `set_yaml_config()` can be used to _set_ the contents of the
33#' `config.yaml` file. This is useful, if one has already obtained it
34#' externally, but wants to use the obtained file with the rest of the
35#' bioc standalone code.
36#'
37#' `get_release_version()` returns the version of the current Bioconductor
38#' release.
39#'
40#' `get_devel_version()` returns the version of the current development
41#' version of Bioconductor.
42#'
43#' `get_version_map()` return the mapping between R versions and
44#' Bioconductor versions. Note that this is not a one to one mapping.
45#' E.g. currently R `3.6.x` maps to both Bioc `3.9` (Bioc release) and
46#' `3.10` (Bioc devel); and also Bioc `3.10` maps to both R `3.6.x` and
47#' R `3.7.x` (current R-devel). It returns a data frame with three columns:
48#' `bioc_version`, `r_version` and `bioc_status`. The first two columns
49#' contain `package_vesion` objects, the third is a factor with levels:
50#' `out-of-date`, `release`, `devel`, `future`.
51#'
52#' `get_matching_bioc_version()` returns the matching Bioc version for an
53#' R version. If the R version matches to both a released and a devel
54#' version, then the released version is chosen.
55#'
56#' `get_bioc_version()` returns the matching Bioc version for the
57#' specified R version. It does observe the `R_BIOC_VERSION` environment
58#' variable, which can be used to force a Bioconductor version. If this is
59#' not set, it just calls `get_matching_bioc_version()`.
60#'
61#' `get_repos()` returns the Bioc repositories of the specified Bioc
62#' version. It defaults to the Bioc version that matches the calling R
63#' version. It returns a named character vector.
64#'
65#' \section{NEWS:}
66#' * 2019-05-30 First version in remotes.
67#' * 2020-03-22 get_matching_bioc_version() is now correct if the current
68#'              R version is not in the builtin mapping.
69#' * 2020-11-21 Update internal map for 3.12.
70#'
71#' @name bioconductor
72#' @keywords internal
73#' @noRd
74NULL
75
76
77bioconductor <- local({
78
79  # -------------------------------------------------------------------
80  # Configuration that does not change often
81
82  config_url <- "https://bioconductor.org/config.yaml"
83
84  builtin_map <- list(
85    "2.1"  = package_version("1.6"),
86    "2.2"  = package_version("1.7"),
87    "2.3"  = package_version("1.8"),
88    "2.4"  = package_version("1.9"),
89    "2.5"  = package_version("2.0"),
90    "2.6"  = package_version("2.1"),
91    "2.7"  = package_version("2.2"),
92    "2.8"  = package_version("2.3"),
93    "2.9"  = package_version("2.4"),
94    "2.10" = package_version("2.5"),
95    "2.11" = package_version("2.6"),
96    "2.12" = package_version("2.7"),
97    "2.13" = package_version("2.8"),
98    "2.14" = package_version("2.9"),
99    "2.15" = package_version("2.11"),
100    "3.0"  = package_version("2.13"),
101    "3.1"  = package_version("3.0"),
102    "3.2"  = package_version("3.2"),
103    "3.3"  = package_version("3.4"),
104    "3.4"  = package_version("3.6"),
105    "3.5"  = package_version("3.8"),
106    "3.6"  = package_version("3.10"),
107    "4.0"  = package_version("3.12"),
108    "4.1"  = package_version("3.14")
109  )
110
111  # -------------------------------------------------------------------
112  # Cache
113
114  devel_version <- NULL
115  release_version <- NULL
116  version_map <- NULL
117  yaml_config <- NULL
118
119  # -------------------------------------------------------------------
120  # API
121
122  get_yaml_config <- function(forget = FALSE) {
123    if (forget || is.null(yaml_config)) {
124      new <- tryCatch(read_url(config_url), error = function(x) x)
125      if (inherits(new, "error")) {
126        http_url <- sub("^https", "http", config_url)
127        new <- tryCatch(read_url(http_url), error = function(x) x)
128      }
129      if (inherits(new, "error")) stop(new)
130      yaml_config <<- new
131    }
132
133    yaml_config
134  }
135
136  set_yaml_config <- function(text) {
137    if (length(text) == 1) text <- strsplit(text, "\n", fixed = TRUE)[[1]]
138    yaml_config <<- text
139  }
140
141  get_release_version <- function(forget = FALSE) {
142    if (forget || is.null(release_version)) {
143      yaml <- get_yaml_config(forget)
144      pattern <- "^release_version: \"(.*)\""
145      release_version <<- package_version(
146        sub(pattern, "\\1", grep(pattern, yaml, value=TRUE))
147      )
148    }
149    release_version
150  }
151
152  get_devel_version <- function(forget = FALSE) {
153    if (forget || is.null(devel_version)) {
154      yaml <- get_yaml_config(forget)
155      pattern <- "^devel_version: \"(.*)\""
156      devel_version <<- package_version(
157        sub(pattern, "\\1", grep(pattern, yaml, value=TRUE))
158      )
159    }
160    devel_version
161  }
162
163  get_version_map <- function(forget = FALSE) {
164    if (forget || is.null(version_map)) {
165      txt <- get_yaml_config(forget)
166      grps <- grep("^[^[:blank:]]", txt)
167      start <- match(grep("r_ver_for_bioc_ver", txt), grps)
168      map <- txt[seq(grps[start] + 1, grps[start + 1] - 1)]
169      map <- trimws(gsub("\"", "", sub(" #.*", "", map)))
170      pattern <- "(.*): (.*)"
171      bioc <- package_version(sub(pattern, "\\1", map))
172      r <- package_version(sub(pattern, "\\2", map))
173      status <- rep("out-of-date", length(bioc))
174      release <- get_release_version()
175      devel <- get_devel_version()
176      status[bioc == release] <- "release"
177      status[bioc == devel] <- "devel"
178
179      # append final version for 'devel' R
180      bioc <- c(
181        bioc, max(bioc)
182      )
183      r <- c(r, package_version(paste(unlist(max(r)) + 0:1, collapse = ".")))
184      status <- c(status, "future")
185
186      version_map <<- rbind(
187        .VERSION_MAP_SENTINEL,
188        data.frame(
189          bioc_version = bioc, r_version = r,
190          bioc_status = factor(
191            status,
192            levels = c("out-of-date", "release", "devel", "future")
193          )
194        )
195      )
196    }
197    version_map
198  }
199
200  get_matching_bioc_version <- function(r_version = getRversion(),
201                                        forget = FALSE) {
202
203    minor <- as.character(get_minor_r_version(r_version))
204    if (minor %in% names(builtin_map)) return(builtin_map[[minor]])
205
206    # If we are not in the map, then we need to look this up in
207    # YAML data. It is possible that the current R version matches multiple
208    # Bioc versions. Then we choose the latest released version. If none
209    # of them were released (e.g. they are 'devel' and 'future'), then
210    # we'll use the 'devel' version.
211
212    map <- get_version_map(forget = forget)
213    mine <- which(package_version(minor) == map$r_version)
214    if (length(mine) == 0) {
215      mine <- NA
216    } else if (length(mine) > 1) {
217      if ("release" %in% map$bioc_status[mine]) {
218        mine <- mine["release" == map$bioc_status[mine]]
219      } else if ("devel" %in% map$bioc_status[mine]) {
220        mine <- mine["devel" == map$bioc_status[mine]]
221      } else {
222        mine <- rev(mine)[1]
223      }
224    }
225    if (!is.na(mine)) return(map$bioc_version[mine])
226
227    # If it is not even in the YAML, then it must be some very old
228    # or very new version. If old, we fail. If new, we assume bioc-devel.
229    if (package_version(minor) < "2.1") {
230      stop("R version too old, cannot run Bioconductor")
231    }
232
233    get_devel_version()
234  }
235
236  get_bioc_version <- function(r_version = getRversion(),
237                               forget = FALSE) {
238    if (nzchar(v <- Sys.getenv("R_BIOC_VERSION", ""))) {
239      return(package_version(v))
240    }
241    get_matching_bioc_version(r_version, forget = forget)
242  }
243
244  get_repos <- function(bioc_version = "auto", forget = FALSE) {
245    if (identical(bioc_version, "auto")) {
246      bioc_version <- get_bioc_version(getRversion(), forget)
247    } else {
248      bioc_version <- package_version(bioc_version)
249    }
250    mirror <- Sys.getenv("R_BIOC_MIRROR", "https://bioconductor.org")
251    mirror <- getOption("BioC_mirror", mirror)
252    repos <- c(
253      BioCsoft      = "{mirror}/packages/{bv}/bioc",
254      BioCann       = "{mirror}/packages/{bv}/data/annotation",
255      BioCexp       = "{mirror}/packages/{bv}/data/experiment",
256      BioCworkflows =
257        if (bioc_version >= "3.7") "{mirror}/packages/{bv}/workflows",
258      BioCextra     =
259        if (bioc_version <= "3.5") "{mirror}/packages/{bv}/extra",
260      BioCbooks =
261        if (bioc_version >= "3.12") "{mirror}/packages/{bv}/books"
262    )
263
264    ## It seems that if a repo is not available yet for bioc-devel,
265    ## they redirect to the bioc-release version, so we do not need to
266    ## parse devel_repos from the config.yaml file
267
268    sub("{mirror}", mirror, fixed = TRUE,
269        sub("{bv}", bioc_version, repos, fixed = TRUE))
270  }
271
272  # -------------------------------------------------------------------
273  # Internals
274
275  read_url <- function(url) {
276    tmp <- tempfile()
277    on.exit(unlink(tmp), add = TRUE)
278    suppressWarnings(download.file(url, tmp, quiet = TRUE))
279    if (!file.exists(tmp) || file.info(tmp)$size == 0) {
280      stop("Failed to download `", url, "`")
281    }
282    readLines(tmp, warn = FALSE)
283  }
284
285  .VERSION_SENTINEL <- local({
286    version <- package_version(list())
287    class(version) <- c("unknown_version", class(version))
288    version
289  })
290
291  .VERSION_MAP_SENTINEL <- data.frame(
292    bioc_version = .VERSION_SENTINEL,
293    r_version = .VERSION_SENTINEL,
294    bioc_status = factor(
295      factor(),
296      levels = c("out-of-date", "release", "devel", "future")
297    )
298  )
299
300  get_minor_r_version <- function (x) {
301    package_version(x)[,1:2]
302  }
303
304  # -------------------------------------------------------------------
305
306  structure(
307    list(
308      .internal = environment(),
309      get_yaml_config = get_yaml_config,
310      set_yaml_config = set_yaml_config,
311      get_release_version = get_release_version,
312      get_devel_version = get_devel_version,
313      get_version_map = get_version_map,
314      get_matching_bioc_version = get_matching_bioc_version,
315      get_bioc_version = get_bioc_version,
316      get_repos = get_repos
317    ),
318    class = c("standalone_bioc", "standalone"))
319})
320