Feature/connection dataset

NAMESPACE

@@ -37,6 +37,7 @@ export(neuprint_skeleton_connectivity_matrix)
 export(neuprint_version)
 export(progress_natprogress)
 importFrom(drvid,read.neuron.dvid)
+importFrom(httr,parse_url)
 importFrom(memoise,memoise)
 importFrom(nat,nlapply)
 importFrom(nat,progress_natprogress)

R/conn.R

@@ -5,9 +5,13 @@
 #'   specified by a \code{neuprint_connection} object. If such an object is not
 #'   specified, then the last successful connection in this R session is reused
 #'   if possible otherwise a new connection object is created using
-#'   \code{options} of the form "neuprint_*" (see details). It is also very
-#'   useful to set the default neuPrint dataset you want to work with, if the
-#'   server hosts multiple datasets, see details.
+#'   \code{environment variables} of the form "neuprint_*" (see details).
+#'
+#'   If your server has more than one dataset available, it is also a good idea
+#'   to set the default neuPrint dataset you want to work with, either by
+#'   passing an explicit \code{dataset} argument (to \code{neuprint_login} or
+#'   \code{neuprint_connection}) when first making the connection or by setting
+#'   a \code{neuprint_dataset} environment variable.
 #'
 #'   The connection object returned by \code{neuprint_login} (or cached when
 #'   \code{Cache=TRUE}, the default) can then be used for future requests to the
@@ -38,6 +42,9 @@
 #'   account.
 #' @param server the neuprint server
 #' @param token your personal Bearer token
+#' @param dataset A default dataset to use with this connection (you can still
+#'   override this using the \code{dataset} argument of other \code{neuprintr}
+#'   functions.)
 #' @param conn a neuprintr connection object
 #' @param config an \code{httr::\link[httr]{config}} object that can be used to
 #'   set advanced curl options (e.g. additional authentication, proxy settings
@@ -46,7 +53,7 @@
 #'   reused automatically.
 #' @param Force Whether to force a new login to the CATMAID server (default
 #'   \code{FALSE})
-#' @param ... methods passed to neuprint_connection
+#' @param ... methods passed to \code{neuprint_connection}
 #' @return a \code{neuprint_connection} object that can be used to make
 #'   authenticated https requests to a neuPrint server, specifically by making
 #'   use of its \code{$config} field.
@@ -77,14 +84,15 @@
 #'   neuprint_token =
 #'   "asBatEsiOIJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJlbWFpbCI6ImFsZXhhbmRlci5zaGFrZWVsLmJhdGVzQGdtYWlsLmNvbSIsImxldmVsIjoicmVhZHdyaXRlIiwiaW1hZ2UtdXJsIjoiaHR0cHM7Ly9saDQuZ29vZ2xldXNlcmNvbnRlbnQuY29tLy1QeFVrTFZtbHdmcy9BQUFBQUFBQUFBDD9BQUFBQUFBQUFBQS9BQ0hpM3JleFZMeEI4Nl9FT1asb0dyMnV0QjJBcFJSZlBRL21vL3Bob3RvLapwZz9zej01MCIsImV4cCI6MTczMjc1MjU2HH0.jhh1nMDBPl5A1HYKcszXM518NZeAhZG9jKy3hzVOWEU"}
 #'
-#'
 #'   and \bold{must} finish with a return at the end of the last line. Your
 #'   \code{neuprint_token} is unique to you and must be obtained from a neuPrint
 #'   web page once you have logged in with an approved Google account.
 #'
 #'   The use of the \code{neuprint_dataset} environment variable is optional and
 #'   only recommended when your default neuprint server has more than one
-#'   dataset.
+#'   dataset. This default will \emph{not} apply to connections that refer to a
+#'   server other than the one specified by the \code{neuprint_server}
+#'   environment variable.
 #'
 #'   \preformatted{neuprint_dataset = "hemibrain:v1.0"}
 #'
@@ -140,20 +148,31 @@
 #'
 #' ## which, if you have edited your R.profile / R.environ, should produce the same results as
 #' available.datasets = neuprint_datasets(conn=NULL)
+#'
+#' # make connection to second server
+#' conn2=neuprint_login(server="https://server2.org",
+#'   token=Sys.getenv('NPSERVER2'))
+#'
+#' # specify a default dataset (only required when >1 dataset available)
+#' conn2=neuprint_login(server="https://server2.org",
+#'   token=Sys.getenv('NPSERVER2'), dataset="hemibrain")
 #' }
 #' @export
 #' @rdname neuprint_login
-neuprint_connection <- function(server=NULL, token=NULL, conn=NULL, config=httr::config()) {
+neuprint_connection <- function(server=NULL, token=NULL, dataset=NULL,
+                                conn=NULL, config=httr::config()) {
   if (!is.null(conn))
     return(conn)
+
   # Set a default server if none specified
   neuprint_server <-
     if(is.null(server)) unlist(getenvoroption("server")) else server
   # Set a default server if none specified
   neuprint_token <- if(is.null(token)) unlist(getenvoroption("token")) else token
   # collect any curl options defined as environment variables
   config=neuprint_curl_options(config)
-  conn=list(server = neuprint_server, token = neuprint_token, config=config)
+  conn=list(server = neuprint_server, token = neuprint_token, config=config,
+            dataset=dataset)
   class(conn)='neuprint_connection'
   conn
 }
@@ -162,6 +181,8 @@ neuprint_connection <- function(server=NULL, token=NULL, conn=NULL, config=httr:
 print.neuprint_connection <- function(x, ...) {
   cat("Connection to neuPrint server:\n  ",
       x$server, sep="", "\n")
+  if(!is.null(x$dataset))
+    cat("with default dataset:\n  ", x$dataset, "\n")
   if(!is.null(x$authresponse)) {
     cat("Login active since:", httr::headers(x$authresponse)$date)
   } else {
@@ -209,17 +230,7 @@ neuprint_connection_fingerprint <- function(conn){
 }
 
 #' @export
-#' @examples
-#' \dontrun{
-#'   conn=neuprint_login()
-#'   conn
-#'
-#'   # make connection to second server
-#'   #
-#'   conn2=neuprint_login(server="https://server2.org",
-#'     token=Sys.getenv('NPSERVER2'))
-#'
-#' }
+#' @name neuprint_login
 neuprint_login <- function(conn = NULL, Cache = TRUE, Force = FALSE, ...){
   if (is.character(conn) && grepl("^http", conn)) {
     stop("To connect to : ", conn, ", you must name the server argument i.e.\n",
@@ -250,7 +261,7 @@ neuprint_login <- function(conn = NULL, Cache = TRUE, Force = FALSE, ...){
                                       referer = conn$server)
     }
     else warning("I can't seem to find a GAPS token.", "You will not be able to POST to this site!")
-  }else {
+  } else {
     if(is.null(conn$config)) conn$config=httr::config()
     conn$config = c(
       conn$config,
@@ -265,6 +276,8 @@ neuprint_login <- function(conn = NULL, Cache = TRUE, Force = FALSE, ...){
   }
   conn$cookies = unlist(httr::cookies(conn$authresponse))
   conn$config = c(conn$config, httr::set_cookies(conn$cookies))
+  # set a default dataset if none exists / check one specified in connection
+  conn$dataset=check_dataset(conn = conn)
   if (Cache)
     neuprint_cache_connection(conn)
   invisible(conn)

R/fetch.R

@@ -136,34 +136,47 @@ neuprint_dataset_prefix <- memoise(function(dataset, conn=NULL) {
 })
 
 # hidden
+#' @importFrom httr parse_url
 check_dataset <-
   function(dataset = NULL, conn = NULL) {
-    # Get a default dataset if none specified
-    defaults4conn <- default_dataset(conn)
+    # login if NULL
+    conn=neuprint_login(conn)
+
+    # use the default in the connection object if no argument specified
+    if(is.null(dataset)) dataset=conn$dataset
+
+    # see what datasets are available for this connection
+    datasets4conn <- default_dataset(conn)
 
     if (is.null(dataset)) {
-      dataset = unlist(getenvoroption("dataset"))
+      # check if there is a default dataset from environment variable
+      # but don't use if there is a default server set that is different from the one
+      # specified in the connection object
+      defaultServer=unlist(getenvoroption("server"))
+      if(is.null(defaultServer) ||
+          isTRUE(all.equal(parse_url(conn$server), parse_url(defaultServer))))
+        dataset = unlist(getenvoroption("dataset"))
       if (is.null(dataset) || nchar(dataset)<1) {
-        if (length(defaults4conn) == 0)
+        if (length(datasets4conn) == 0)
           stop(
             "I'm sorry I can't find a default dataset for your current neuPrint connection.\n",
-            "Please supply a dataset argument or set a default one using the ",
+            "Please supply a `dataset` argument or set a default one using the ",
             "neuprint_dataset environment variable!\nSee ?neuprint_login for details."
           )
-        dataset = defaults4conn[1]
-        if (length(defaults4conn) > 1) {
-          warning(
-            "Please supply a dataset or set a default one using the ",
+        dataset = datasets4conn[1]
+        if (length(datasets4conn) > 1) {
+          warning(call.=F,
+            "Please supply a `dataset` argument or set a default one at login or using the ",
             "neuprint_dataset environment variable! See ?neuprint_login for details.",
-            " For now we will use ",
-            dataset
+            " For now we will use '",
+            dataset,"'."
           )
         }
       }
     }
-    if(length(defaults4conn) && !dataset %in% defaults4conn){
-      warning("Specified dataset: `", dataset, "` does not match those provided by your ",
-      "neuPrint connection:\n  ", paste(defaults4conn, collapse=", "),
+    if(length(datasets4conn) && !dataset %in% datasets4conn){
+      stop("Specified dataset: `", dataset, "` does not match those provided by your ",
+      "neuPrint connection:\n  ", paste(datasets4conn, collapse=", "),
       "\nSee ?neuprint_login for details.")
     }
     dataset

tests/testthat/test-conn.R

@@ -0,0 +1,5 @@
+skip_if(as.logical(Sys.getenv("SKIP_NP_SERVER_TESTS")))
+
+test_that("neuprint_login works", {
+  expect_error(neuprint_login(server="https://neuprint.janelia.org", dataset='rhubarb'))
+})

tests/testthat/test-name.R

@@ -50,5 +50,5 @@ test_that("test name searches ", {
 })
 
 test_that("test bad dataset specification ", {
-  expect_warning(neuprint_search(".*DA2.*", dataset = 'hemibrain1'))
+  expect_error(neuprint_search(".*DA2.*", dataset = 'hemibrain1'))
 })