Merge pull request #4 from satijalab/feat/NoInternet

Feat/no internet

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: SeuratData
 Type: Package
 Title: Install and Manage Seurat Datasets
-Version: 0.1.0.9000
+Version: 0.1.0.9001
 Date: 2019-07-17
 Authors@R: c(
   person(given = 'Rahul', family = 'Satija', email = '[email protected]', role = 'aut', comment = c(ORCID = '0000-0001-9448-8833')),
@@ -21,6 +21,7 @@ RoxygenNote: 6.1.1
 Imports:
     cli,
     crayon,
+    rappdirs,
     stats,
     utils
 Collate:

NAMESPACE

@@ -15,6 +15,7 @@ importFrom(crayon,col_nchar)
 importFrom(crayon,green)
 importFrom(crayon,red)
 importFrom(crayon,yellow)
+importFrom(rappdirs,user_data_dir)
 importFrom(stats,na.omit)
 importFrom(utils,available.packages)
 importFrom(utils,data)

R/seurat_data.R

@@ -49,14 +49,20 @@ AvailableData <- function() {
 #'
 InstallData <- function(ds, force.reinstall = FALSE, ...) {
   UpdateManifest()
+  if (pkg.env$source != 'remote') {
+    stop(
+      "No access to remote SeuratData repository, unable to install new datasets",
+      call. = FALSE
+    )
+  }
   pkgs <- NameToPackage(ds = ds)
   if (!force.reinstall) {
     installed <- intersect(x = pkgs, y = rownames(x = InstalledData()))
     if (length(x = installed) > 0) {
       warning(
         "The following packages are already installed and will not be reinstalled: ",
         paste(
-          gsub(pattern = '\\.SeuratData', replacement = '', x = installed),
+          gsub(pattern = pkg.key, replacement = '', x = installed),
           collapse = ', '
         ),
         call. = FALSE,
@@ -73,7 +79,12 @@ InstallData <- function(ds, force.reinstall = FALSE, ...) {
   for (p in pkgs2[pkgs2 %in% search()]) {
     detach(name = p, unload = TRUE, character.only = TRUE)
   }
-  install.packages(pkgs = pkgs, repos = getOption(x = "SeuratData.repo.use"), type = 'source', ...)
+  install.packages(
+    pkgs = pkgs,
+    repos = getOption(x = "SeuratData.repo.use"),
+    type = 'source',
+    ...
+  )
   for (pkg in pkgs) {
     attachNamespace(ns = pkg)
     pkg.env$attached <- c(pkg.env$attached, pkg)
@@ -134,6 +145,7 @@ LoadData <- function(
   graphs = NULL,
   verbose = TRUE
 ) {
+  .NotYetImplemented()
   installed <- InstalledData()
   if (!NameToPackage(ds = ds) %in% rownames(x = installed)) {
     stop("Cannot find dataset ", ds, call. = FALSE)
@@ -209,6 +221,13 @@ RemoveData <- function(ds, lib) {
 #' }
 #'
 UpdateData <- function(ask = TRUE, lib.loc = NULL) {
+  UpdateManifest()
+  if (pkg.env$source != 'remote') {
+    stop(
+      "No access to remote SeuratData repository, unable to update datasets",
+      call. = FALSE
+    )
+  }
   update.packages(lib.loc = lib.loc, repos = getOption(x = "SeuratData.repo.use"), ask = ask, type = 'source')
   UpdateManifest()
   invisible(x = NULL)

R/zzz.R

@@ -2,11 +2,19 @@
 #'
 #' @section Package options:
 #'
-#' SeuratData uses the following [options()] to configure behaviour:
+#' SeuratData uses the following options to control behaviour, users can configure
+#' these with \code{\link[base]{options}}:
 #'
 #' \itemize{
 #'   \item `SeuratData.repo.use`: Set the location where the SeuratData datasets
 #'   are stored. Users generally should not modify.
+#'   \item `SeuratData.manifest.cache`: Cache the data manifest whenever we talk
+#'   to the data repository; note, setting to \code{FALSE} will simply prevent
+#'   SeuratData from caching the manifest, not from reading a previously cached
+#'   manifest
+#'   \item `SeuratData.roaming`: For Windows users, use a roaming profile directory
+#'   for domain users. See \url{https://en.wikipedia.org/wiki/Roaming_user_profile}
+#'   for a brief overview and Microsoft's documentation for greater detail
 #' }
 #'
 #' @docType package
@@ -17,16 +25,23 @@
 "_PACKAGE"
 
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-# Global variables and environment
+# Global variables, default options, and package environment
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 default.options <- list(
-  SeuratData.repo.use = 'https://seurat.nygenome.org'
+  SeuratData.repo.use = 'http://seurat.nygenome.org/',
+  SeuratData.manifest.cache = TRUE,
+  SeuratData.roaming = FALSE
 )
 
+pkg.key <- '\\.SeuratData$'
+
 pkg.env <- new.env()
-pkg.env$manifest <- vector(mode = 'character')
+pkg.env$manifest <- vector(mode = 'list')
+pkg.env$source <- vector(mode = 'character')
+pkg.env$update.call <- vector(mode = 'character')
 pkg.env$attached <- vector(mode = 'character')
+pkg.env$extdata.warn <- FALSE
 
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 # Internal functions
@@ -60,6 +75,28 @@ pkg.env$attached <- vector(mode = 'character')
   }
 }
 
+#' Get an application data directory
+#'
+#' @inheritParams AttachData
+#' @param author Author name for application
+#'
+#' @return A character vector with path to the application data dir
+#'
+#' @importFrom rappdirs user_data_dir
+#'
+#' @seealso \code{\link[rappdirs]{user_data_dir}}
+#'
+#' @keywords internal
+#'
+AppData <- function(pkgname = 'SeuratData', author = pkgname) {
+  return(user_data_dir(
+    appname = pkgname,
+    appauthor = author,
+    version = file.path('%p-platform', '%v'),
+    roaming = getOption(x = 'SeuratData.roaming', default = FALSE)
+  ))
+}
+
 #' Attach datasets
 #'
 #' @param pkgname Name of package
@@ -264,77 +301,134 @@ NameToPackage <- function(ds) {
 #' @keywords internal
 #'
 UpdateManifest <- function() {
-  avail.pkgs <- available.packages(
-    repos = getOption(x = "SeuratData.repo.use"),
-    type = 'source',
-    fields = c('Description', 'Title'),
-    ignore_repo_cache = TRUE
+  # Set some defaults
+  pkg.env$source <- 'remote'
+  cache.manifest <- file.path(
+    AppData(pkgname = 'SeuratData', author = 'Satija Lab'),
+    'manifest.Rds'
   )
-  avail.pkgs <- as.data.frame(x = avail.pkgs, stringsAsFactors = FALSE)
-  avail.pkgs <- avail.pkgs[grepl(pattern = '\\.SeuratData$', x = avail.pkgs$Package), , drop = FALSE]
-  avail.pkgs <- apply(
-    X = avail.pkgs,
-    MARGIN = 1,
-    FUN = function(pkg) {
-      dataset <- gsub(
-        pattern = '\\.SeuratData$',
-        replacement = '',
-        x = pkg[['Package']]
-      )
-      desc <- unlist(x = strsplit(x = pkg[['Description']], split = '\n'))
-      desc <- sapply(
-        X = strsplit(x = desc, split = ':'),
-        FUN = function(x) {
-          name <- trimws(x = x[[1]])
-          val <- trimws(x = unlist(x = strsplit(x = x[[2]], split = ',')))
-          val <- paste(val, collapse = ', ')
-          names(x = val) <- name
-          return(val)
-        }
-      )
-      desc <- sapply(
-        X = desc,
-        FUN = function(x) {
-          x <- tryCatch(
-            expr = as.numeric(x = x),
-            warning = function(...) {
-              return(x)
-            }
-          )
-          if (!is.numeric(x = x) && !is.na(x = as.logical(x = x))) {
-            x <- as.logical(x = x)
-          }
-          return(x)
-        },
-        simplify = FALSE,
-        USE.NAMES = TRUE
-      )
-      desc <- c(
-        'Dataset' = dataset,
-        'Version' = pkg[['Version']],
-        'Summary' = pkg[['Title']],
-        desc
+  # Attempt to get the manifest from the remote server
+  avail.pkgs <- tryCatch(
+    expr = available.packages(
+      repos = getOption(x = "SeuratData.repo.use"),
+      type = 'source',
+      fields = c('Description', 'Title'),
+      ignore_repo_cache = TRUE
+    ),
+    warning = function(...) {
+      pkg.env$source <- ifelse(
+        test = file.exists(cache.manifest),
+        yes = 'appdir',
+        no = 'extdata'
       )
-      return(desc)
     }
   )
-  manifest.names <- unique(x = unlist(
-    x = lapply(X = avail.pkgs, FUN = names),
-    use.names = FALSE
-  ))
-  for (pkg in names(x = avail.pkgs)) {
-    for (col in manifest.names) {
-      avail.pkgs[[pkg]][[col]] <- avail.pkgs[[pkg]][[col]] %||% NA
+  # Process the manifest
+  if (pkg.env$source == 'remote') {
+    # Lots of stuff to get the manifest modified from the available.packages format
+    # into something usable by SeuratData
+    pkg.env$extdata.warn <- FALSE
+    avail.pkgs <- as.data.frame(x = avail.pkgs, stringsAsFactors = FALSE)
+    # Ensure we only use datasets tagged with .SeuratData
+    avail.pkgs <- avail.pkgs[grepl(pattern = pkg.key, x = avail.pkgs$Package), , drop = FALSE]
+    # Filter down to dataset name, short summary from package title, and
+    # metadata contained in package description
+    avail.pkgs <- apply(
+      X = avail.pkgs,
+      MARGIN = 1,
+      FUN = function(pkg) {
+        # Get dataset name
+        dataset <- gsub(
+          pattern = pkg.key,
+          replacement = '',
+          x = pkg[['Package']]
+        )
+        # Process the description metadata
+        desc <- unlist(x = strsplit(x = pkg[['Description']], split = '\n'))
+        desc <- sapply(
+          X = strsplit(x = desc, split = ':'),
+          FUN = function(x) {
+            name <- trimws(x = x[[1]])
+            val <- trimws(x = unlist(x = strsplit(x = x[[2]], split = ',')))
+            val <- paste(val, collapse = ', ')
+            names(x = val) <- name
+            return(val)
+          }
+        )
+        desc <- sapply(
+          X = desc,
+          FUN = function(x) {
+            x <- tryCatch(
+              expr = as.numeric(x = x),
+              warning = function(...) {
+                return(x)
+              }
+            )
+            if (!is.numeric(x = x) && !is.na(x = as.logical(x = x))) {
+              x <- as.logical(x = x)
+            }
+            return(x)
+          },
+          simplify = FALSE,
+          USE.NAMES = TRUE
+        )
+        # Assemble the information
+        desc <- c(
+          'Dataset' = dataset,
+          'Version' = pkg[['Version']],
+          'Summary' = pkg[['Title']],
+          desc
+        )
+        return(desc)
+      }
+    )
+    # Pad missing metadata with NAs
+    manifest.names <- unique(x = unlist(
+      x = lapply(X = avail.pkgs, FUN = names),
+      use.names = FALSE
+    ))
+    for (pkg in names(x = avail.pkgs)) {
+      for (col in manifest.names) {
+        avail.pkgs[[pkg]][[col]] <- avail.pkgs[[pkg]][[col]] %||% NA
+      }
     }
+    # Convert each entry to a dataframe and bind everything together
+    avail.pkgs <- lapply(X = avail.pkgs, FUN = as.data.frame, stringsAsFactors = FALSE)
+    avail.pkgs <- do.call(what = 'rbind', args = avail.pkgs)
+    # Coerce version information to package_version
+    avail.pkgs$Version <- package_version(x = avail.pkgs$Version)
+  } else if (pkg.env$source == 'appdir') {
+    # Read cached manifest
+    pkg.env$extdata.warn <- FALSE
+    packageStartupMessage(
+      "Using cached data manifest, last updated at ",
+      file.info(cache.manifest)$ctime
+    )
+    avail.pkgs <- readRDS(file = cache.manifest)
+  } else if (pkg.env$source == 'extdata') {
+    # Read SeuratData-bundled manifest
+    if (!pkg.env$extdata.warn) {
+      warning(
+        "Using SeuratData-bundled data manifest. ",
+        "This may be out-of-date and not contain the latest datasets. ",
+        "This warning will be shown once per session or until we can read from a remote or cached data manifest",
+        call. = FALSE,
+        immediate. = TRUE
+      )
+    }
+    pkg.env$extdata.warn <- TRUE
+    avail.pkgs <- readRDS(file = system.file(
+      'extdata/manifest.Rds',
+      package = 'SeuratData',
+      mustWork = TRUE
+    ))
   }
-  avail.pkgs <- lapply(X = avail.pkgs, FUN = as.data.frame, stringsAsFactors = FALSE)
-  avail.pkgs <- do.call(what = 'rbind', args = avail.pkgs)
-  avail.pkgs$Version <- package_version(x = avail.pkgs$Version)
+  # Get dataset installation status
   avail.pkgs$Installed <- vapply(
     X = rownames(x = avail.pkgs),
     FUN = requireNamespace,
     FUN.VALUE = logical(length = 1L),
-    quietly = TRUE,
+    quietly = TRUE
   )
   avail.pkgs$InstalledVersion <- sapply(
     X = rownames(x = avail.pkgs),
@@ -348,14 +442,33 @@ UpdateManifest <- function() {
       return(as.character(x = pkg.version))
     }
   )
+  # Coerce version information to package_version
+  # Allow NAs to become effectively NA_pacakge_version_
   avail.pkgs$InstalledVersion <- package_version(
     x = avail.pkgs$InstalledVersion,
     strict = FALSE
   )
   # TODO: remove these when we allow loading of processed datasets
-  ds.index <- which(x = colnames(x = avail.pkgs) %in% c('default.dataset', 'other.datasets'))
-  avail.pkgs <- avail.pkgs[, -ds.index]
+  cols.remove <- c('default.dataset', 'other.datasets')
+  if (any(cols.remove %in% colnames(x = avail.pkgs))) {
+    ds.index <- which(x = colnames(x = avail.pkgs) %in% cols.remove)
+    avail.pkgs <- avail.pkgs[, -ds.index]
+  }
   pkg.env$manifest <- avail.pkgs
+  # Cache the manifest
+  if (getOption(x = 'SeuratData.manifest.cache', default = FALSE)) {
+    if (!dir.exists(paths = dirname(path = cache.manifest))) {
+      dir.create(path = dirname(path = cache.manifest), recursive = TRUE)
+    }
+    cached <- if (file.exists(cache.manifest)) {
+      readRDS(file = cache.manifest)
+    } else {
+      NULL
+    }
+    if (!isTRUE(x = all.equal(target = pkg.env$manifest, current = cached))) {
+      saveRDS(object = pkg.env$manifest, file = cache.manifest)
+    }
+  }
   invisible(x = NULL)
 }