Skip to content

Commit

Permalink
Merge branch 'dev'
Browse files Browse the repository at this point in the history
* dev:
  Skip test if offline
  Rebuild documentation
  Make lines shorter
  Reorganize code; Delete code no longer used
  Use markdown for documentation #235
  Use markdown for documentation #235
  Document newly exposed functions #209, #235
  Use markdown in roxygen docs #235
  Use markdown in roxygen docs #235
  • Loading branch information
andrie committed Mar 16, 2017
2 parents 9b9dd5b + d9b269d commit 809dc73
Show file tree
Hide file tree
Showing 21 changed files with 265 additions and 193 deletions.
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -4,3 +4,4 @@
checkpoint.Rproj
.RData
inst/doc
tests/testthat/framed.sty
3 changes: 2 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -32,4 +32,5 @@ Suggests:
testthat(>= 0.9),
MASS
VignetteBuilder: knitr
RoxygenNote: 5.0.1
RoxygenNote: 6.0.1
Roxygen: list(markdown = TRUE)
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ export(checkpoint)
export(checkpointArchives)
export(checkpointRemove)
export(getValidSnapshots)
export(mranUrl)
export(setSnapshot)
importFrom(utils,Stangle)
importFrom(utils,available.packages)
Expand Down
14 changes: 8 additions & 6 deletions R/checkpoint-package.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,15 +2,17 @@
#'
#' The goal of checkpoint is to solve the problem of package reproducibility in R. Specifically, checkpoint allows you to install packages as they existed on CRAN on a specific snapshot date as if you had a CRAN time machine.
#'
#' To achieve reproducibility, the checkpoint() function installs the packages required or called by your project and scripts to a local library exactly as they existed at the specified point in time. Only those packages are available to your project, thereby avoiding any package updates that came later and may have altered your results. In this way, anyone using the checkpoint checkpoint() function can ensure the reproducibility of your scripts or projects at any time.
#' To achieve reproducibility, the [checkpoint()] function installs the packages required or called by your project and scripts to a local library exactly as they existed at the specified point in time. Only those packages are available tot your project, thereby avoiding any package updates that came later and may have altered your results. In this way, anyone using the checkpoint [checkpoint()] function can ensure the reproducibility of your scripts or projects at any time.
#'
#' To create the snapshot archives, once a day (at midnight UTC) we refresh the Austria CRAN mirror, on the checkpoint server (https://mran.microsoft.com/). Immediately after completion of the rsync mirror process, we take a snapshot, thus creating the archive. Snapshot archives exist starting from 2014-09-17.
#' To create the snapshot archives, once a day (at midnight UTC) we refresh the Austria CRAN mirror, on the checkpoint server (https://mran.microsoft.com/). Immediately after completion of the `rsync`` mirror process, we take a snapshot, thus creating the archive. Snapshot archives exist starting from 2014-09-17.
#'
#' checkpoint exposes only a single function:
#' checkpoint exposes functions for:
#'
#' \describe{
#' \item{\code{\link{checkpoint}}}{Configures R session to use packages as they existed on CRAN at time of snapshot.}
#' }
#' * [checkpoint()]: Configures R session to use packages as they existed on CRAN at time of snapshot.
#' * [checkpointArchives()]: List checkpoint archives on disk.
#' * [checkpointRemove()]: Remove checkpoint archive from disk.
#' * [setSnapshot()]: Set default CRAN repository to MRAN snapshot date.
#' * [getValidSnapshots()]: Read list of available snapshot dates from MRAN.
#'
#' @name checkpoint-package
#' @docType package
Expand Down
119 changes: 68 additions & 51 deletions R/checkpoint.R

Large diffs are not rendered by default.

5 changes: 3 additions & 2 deletions R/checkpoint_remove.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
#'
#' @inheritParams checkpoint
#' @export
#' @seealso checkpointRemove
#' @family checkpoint functions
#' @example inst/examples/example_remove.R
checkpointArchives <- function(checkpointLocation = "~/"){
z <- list.files(path = paste0(normalizePath(checkpointLocation), ".checkpoint"),
Expand All @@ -13,11 +13,12 @@ checkpointArchives <- function(checkpointLocation = "~/"){
normalizePath(z, winslash = "/")
}


#' Remove checkpoint archive from disk.
#'
#' @inheritParams checkpoint
#' @export
#' @seealso checkpointArchives
#' @family checkpoint functions
#' @example inst/examples/example_remove.R
checkpointRemove <- function(snapshotDate, checkpointLocation = "~/"){
z <- list.files(path = paste0(normalizePath(checkpointLocation), ".checkpoint"),
Expand Down
84 changes: 16 additions & 68 deletions R/mranUrl.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,44 +3,27 @@ stopIfInvalidDate <- function(snapshotDate, verbose = TRUE){
if(missing(snapshotDate) || is.null(snapshotDate))
stop("You have to specify a snapshotDate", call. = FALSE)
if(!grepl("^\\d{4}-\\d{2}-\\d{2}$", snapshotDate))
stop("snapshotDate must be a valid date using format YYYY-MM-DD", call. = FALSE)
stop("snapshotDate must be a valid date using format YYYY-MM-DD",
call. = FALSE)
if(as.Date(snapshotDate) < as.Date("2014-09-17"))
stop("Snapshots are only available after 2014-09-17", call. = FALSE)
if(as.Date(snapshotDate) > Sys.Date())
stop("snapshotDate can not be in the future!", call. = FALSE)


validSnapshots <- tryCatch(as.Date(getValidSnapshots()), error=function(e)e)
if(inherits(validSnapshots, "error")){
mssg(verbose, "Unable to connect to MRAN. Skipping some date validations.")
} else {
if(!as.Date(snapshotDate) %in% validSnapshots) {
i <- findInterval(as.Date(snapshotDate), validSnapshots)
suggestions <- validSnapshots[c(i, i+1)]
stop(sprintf("Snapshot does not exist on MRAN. Try %s or %s.", validSnapshots[i], validSnapshots[i+1]))
stop(sprintf("Snapshot does not exist on MRAN. Try %s or %s.",
validSnapshots[i],
validSnapshots[i+1]))
}
}


}

# testHttps <- function(https){
# tf = tempfile()
# dir.create(tf)
# on.exit(unlink(tf))
# testpkg = "memoise"
# repos <- paste0(https, "snapshot/2014-09-12/")
# tryCatch(suppressWarnings(utils::install.packages(testpkg, lib = tf,
# repos = repos ,
# dependencies = FALSE,
# type = "source",
# quiet = TRUE)))
# if(testpkg %in% installed.packages(lib.loc = tf)[, "Package"]) {
# TRUE
# } else {
# FALSE
# }
# }

mranUrlDefault <- function(){
http = "http://mran.microsoft.com/"
Expand All @@ -63,30 +46,15 @@ isHttpsUrl <- function(url){
grepl("^https://", url)
}

# setDownloadOption <- function(mranUrl){
#
# download.method <- switch(
# .Platform$OS.type,
# windows = "wininet",
# unix = if(capabilities("libcurl")) "libcurl" else "curl"
# )
# url.method <- switch(
# .Platform$OS.type,
# windows = "wininet",
# unix = if(capabilities("libcurl")) "libcurl" else "internal"
# )
#
# options(download.file.method = download.method,
# url.method = url.method)
# }
#
# resetDownloadOption <- function(opts){
# options(opts)
# }


# ------------------------------------------------------------------------

#' Returns MRAN URL by querying options and defaults.
#'
#' The default MRAN URL is `http(s)://mran.microsoft.com/`, but you can override this by setting the `checkpoint.mranUrl` option.
#'
#'
#' @export
#' @return Character string with URL
#' @family checkpoint functions
mranUrl <- function(){
url <- getOption("checkpoint.mranUrl")
url <- if(is.null(url)) mranUrlDefault() else url
Expand All @@ -107,6 +75,9 @@ setCheckpointUrl <- function(url){


tryUrl <- function(url){
timeout <- getOption("timeout")
on.exit(options(timeout = timeout))
options(timeout = 5)
con <- suppressWarnings(tryCatch(url(url), error = function(e)e))
msg <- paste0(
"Invalid value for mranRootUrl.\n",
Expand All @@ -118,29 +89,6 @@ tryUrl <- function(url){
con
}

#' Read list of available snapshot dates from MRAN url.
#'
#' @param mranRootUrl URL of MRAN root, e.g. \code{"https://mran.microsoft.com/snapshot/"} or \code{"file:///local/path"}
#'
#' @export
getValidSnapshots <- function(mranRootUrl = mranUrl()){
con <- tryUrl(mranRootUrl)
on.exit(close(con))
text <- if (inherits(con, "file")) {
dir(summary(con)$description)
} else {
suppressWarnings(tryCatch(readLines(con, warn = TRUE), error = function(e) e))
}
if (inherits(text, "error")) {
stop(sprintf("Unable to download from MRAN: %s",
text$message))
}
ptn <- "\\d{4}-\\d{2}-\\d{2}"
idx <- grep(ptn, text)
gsub(sprintf("^<a href=.*?>(%s).*?</a>.*$", ptn),
"\\1", text[idx])
}


# ------------------------------------------------------------------------

Expand Down
31 changes: 31 additions & 0 deletions R/setSnapshot.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,8 @@
#'
#' @export
#' @example /inst/examples/example_setSnapshot.R
#'
#' @family checkpoint functions
#'
setSnapshot <- function(snapshotDate){
if (missing(snapshotDate) || is.null(snapshotDate)) return(getOption("repos"))
Expand All @@ -14,3 +16,32 @@ setSnapshot <- function(snapshotDate){
options(repos = c(CRAN = repoDate))
message(paste("Using CRAN mirror at", repoDate))
}


#' Read list of available snapshot dates from MRAN.
#'
#' Returns vector of available dates from MRAN or local MRAN repository.
#'
#' @param mranRootUrl MRAN root. This can be a URL, e.g. `https://mran.microsoft.com/snapshot/` or the path to a local MRAN repository, e.g.`file:///local/path`
#'
#' @export
#' @return Character vector with dates of valid snapshots
#' @family checkpoint functions
getValidSnapshots <- function(mranRootUrl = mranUrl()){
con <- tryUrl(mranRootUrl)
on.exit(close(con))
text <- if (inherits(con, "file")) {
dir(summary(con)$description)
} else {
suppressWarnings(tryCatch(readLines(con, warn = TRUE), error = function(e) e))
}
if (inherits(text, "error")) {
stop(sprintf("Unable to download from MRAN: %s",
text$message))
}
ptn <- "\\d{4}-\\d{2}-\\d{2}"
idx <- grep(ptn, text)
gsub(sprintf("^<a href=.*?>(%s).*?</a>.*$", ptn),
"\\1", text[idx])
}

16 changes: 9 additions & 7 deletions man/checkpoint-package.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit 809dc73

Please sign in to comment.