Tweaks

.github/ISSUE_TEMPLATE/bug_report.md

@@ -0,0 +1,17 @@
+---
+name: Bug Report
+about: Create a report to help us improve
+---
+<!-- IF THIS INVOLVES AUTHENTICATION: DO NOT SHARE YOUR USERNAME/PASSWORD, OR API KEYS/TOKENS IN THIS ISSUE - MOST LIKELY THE MAINTAINER WILL HAVE THEIR OWN EQUIVALENT KEY -->
+
+<!-- Please paste your sessioninfo::session_info() or sessionInfo() into the code block below, AND include a reproducible example (consider using a "reprex" https://cran.rstudio.com/web/packages/reprex/) If not, delete all this and proceed :) -->
+
+```r
+# replace this with your reproducible example
+```
+
+<details> <summary><strong>Session Info</strong></summary>
+```r
+# replace this by with the output from sessioninfo::session_info() or sessionInfo()
+```
+</details>

.github/ISSUE_TEMPLATE/feature_request.md

@@ -0,0 +1,20 @@
+---
+name: Feature Request
+about: Suggest an idea for this project
+---
+<!-- IF THIS INVOLVES AUTHENTICATION: DO NOT SHARE YOUR USERNAME/PASSWORD, OR API KEYS/TOKENS IN THIS ISSUE - MOST LIKELY THE MAINTAINER WILL HAVE THEIR OWN EQUIVALENT KEY -->
+
+<!-- Please describe the feature you propose as detailed as possible. 
+If possible, add some code examples below indicating how the updated code should work.
+Consider writing it as a <a href = "https://testthat.r-lib.org/">testthat</a> unit test-->
+
+```r
+# a silly feature request, fails under the current implementation
+b <- 1 + 1
+stopifnot(all.equal(b == 3))
+```
+
+```r
+# testthat version of the silly feature request
+expect_equal(1 + 1, 3)
+```

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: git2rdata
 Title: Store and Retrieve Data.frames in a Git Repository
-Version: 0.1
+Version: 0.1.0.9000
 Authors@R: c(
   person(
     "Thierry", "Onkelinx", role = c("aut", "cre"), 

NEWS.md

@@ -1,3 +1,16 @@
+git2rdata 0.1.0.9000 (2019-08-13)
+=================================
+
+### BREAKING FEATURES
+
+  * `write_vc()` and `read_vc()` fail when `file` is a location outside of `root` (#50).
+
+### NEW FEATURES
+
+  * Only require `upgrade_data()` for data written with versions prior to 0.0.5 (#44).
+  * Improve warnings() and error().
+  * Use vector version of logo.
+
 git2rdata 0.1 (2019-06-04)
 ============================
 

R/clean_data_path.R

@@ -11,6 +11,10 @@
 clean_data_path <- function(root, file, normalize = TRUE) {
   assert_that(is.flag(normalize), noNA(normalize))
   dir_name <- dirname(file)
+  if (length(grep("\\.\\.", dir_name))) {
+    stop("file should not contain '..'")
+  }
+
   file <- gsub("\\..*$", "", basename(file))
   if (dir_name == ".") {
     path <- file.path(root, file)

R/is_git2rdata.R

@@ -17,7 +17,7 @@ is_git2rdata <- function(file, root = ".",
 
 #' @export
 is_git2rdata.default <- function(file, root, message) {
-  stop("a 'root' of class ", class(root), " is not supported")
+  stop("a 'root' of class ", class(root), " is not supported", call. = FALSE)
 }
 
 #' @export
@@ -38,7 +38,8 @@ is_git2rdata.character <- function(file, root = ".",
 
   if (!file.exists(file["raw_file"])) {
     msg <- "Data file missing."
-    switch(message, error = stop(msg), warning = warning(msg))
+    switch(message, error = stop(msg, call. = FALSE),
+           warning = warning(msg, call. = FALSE))
     return(FALSE)
   }
 
@@ -50,13 +51,15 @@ is_git2rdata.character <- function(file, root = ".",
   header <- readLines(file["raw_file"], n = 1, encoding = "UTF-8")
   if (correct != header) {
     msg <- paste("Corrupt data, incorrect header. Expecting:", correct)
-    switch(message, error = stop(msg), warning = warning(msg))
+    switch(message, error = stop(msg, call. = FALSE),
+           warning = warning(msg, call. = FALSE))
     return(FALSE)
   }
 
   if (meta_data[["..generic"]][["data_hash"]] != hashfile(file[["raw_file"]])) {
     msg <- "Corrupt data, mismatching data hash."
-    switch(message, error = stop(msg), warning = warning(msg))
+    switch(message, error = stop(msg, call. = FALSE),
+           warning = warning(msg, call. = FALSE))
     return(FALSE)
   }
 

R/is_git2rmeta.R

@@ -23,7 +23,7 @@ is_git2rmeta <- function(file, root = ".",
 #' @export
 is_git2rmeta.default <- function(file, root,
                                  message = c("none", "warning", "error")) {
-  stop("a 'root' of class ", class(root), " is not supported")
+  stop("a 'root' of class ", class(root), " is not supported", call. = FALSE)
 }
 
 #' @export
@@ -39,44 +39,51 @@ is_git2rmeta.character <- function(file, root = ".",
 
   if (!file.exists(file["meta_file"])) {
     msg <- "Metadata file missing."
-    switch(message, error = stop(msg), warning = warning(msg))
+    switch(message, error = stop(msg, call. = FALSE),
+           warning = warning(msg, call. = FALSE))
     return(FALSE)
   }
 
   # read the metadata
   meta_data <- read_yaml(file["meta_file"])
   if (!has_name(meta_data, "..generic")) {
     msg <- "No '..generic' element."
-    switch(message, error = stop(msg), warning = warning(msg))
+    switch(message, error = stop(msg, call. = FALSE),
+           warning = warning(msg, call. = FALSE))
     return(FALSE)
   }
   if (!has_name(meta_data[["..generic"]], "hash")) {
     msg <- "Corrupt metadata, no hash found."
-    switch(message, error = stop(msg), warning = warning(msg))
+    switch(message, error = stop(msg, call. = FALSE),
+           warning = warning(msg, call. = FALSE))
     return(FALSE)
   }
   if (!has_name(meta_data[["..generic"]], "git2rdata")) {
     msg <- "Data stored using an older version of `git2rdata`.
 See `?upgrade_data()`."
-    switch(message, error = stop(msg), warning = warning(msg))
+    switch(message, error = stop(msg, call. = FALSE),
+           warning = warning(msg, call. = FALSE))
     return(FALSE)
   }
   if (package_version(meta_data[["..generic"]][["git2rdata"]]) <
-        packageVersion("git2rdata")) {
+      package_version("0.0.5")) {
     msg <- "Data stored using an older version of `git2rdata`.
 See `?upgrade_data()`."
-    switch(message, error = stop(msg), warning = warning(msg))
+    switch(message, error = stop(msg, call. = FALSE),
+           warning = warning(msg, call. = FALSE))
     return(FALSE)
   }
   if (!has_name(meta_data[["..generic"]], "data_hash")) {
     msg <- "Corrupt metadata, no data hash found."
-    switch(message, error = stop(msg), warning = warning(msg))
+    switch(message, error = stop(msg, call. = FALSE),
+           warning = warning(msg, call. = FALSE))
     return(FALSE)
   }
   current_hash <- meta_data[["..generic"]][["hash"]]
   if (current_hash != metadata_hash(meta_data)) {
     msg <- "Corrupt metadata, mismatching hash."
-    switch(message, error = stop(msg), warning = warning(msg))
+    switch(message, error = stop(msg, call. = FALSE),
+           warning = warning(msg, call. = FALSE))
     return(FALSE)
   }
 

R/list_data.R

@@ -40,7 +40,7 @@ list_data.character <- function(root = ".", path = ".", recursive = TRUE) {
                   FUN.VALUE = NA, root = root, message = "none")
   if (any(!check)) {
     warning("Invalid metadata files found. See ?is_git2rmeta():\n",
-            paste(meta_files_base[!check], collapse = "\n"))
+            paste(meta_files_base[!check], collapse = "\n"), call. = FALSE)
   }
   meta_files <- meta_files[check]
   data_files <- data_files[data_files %in% meta_files]

R/meta.R

@@ -205,7 +205,7 @@ meta.data.frame <- function(x, optimize = TRUE, na = "NA", sorting, ...) {
 
   # apply sorting
   if (missing(sorting) || is.null(sorting) || !length(sorting)) {
-    warning("No sorting applied.
+    warning(call. = FALSE, "No sorting applied.
 Sorting is strongly recommended in combination with version control.")
   } else {
     assert_that(is.character(sorting))
@@ -218,7 +218,7 @@ Sorting is strongly recommended in combination with version control.")
         sorted <- paste(sprintf("'%s'", sorting), collapse = ", ")
         sorted <- sprintf("Sorting on %s results in ties.
 Add extra sorting variables to ensure small diffs.", sorted)
-        warning(sorted)
+        warning(sorted, call. = FALSE)
       }
     }
     generic <- c(generic, sorting = list(sorting))

R/prune.R

@@ -30,7 +30,7 @@ rm_data <- function(
 rm_data.default <- function(
   root, path = NULL, recursive = TRUE, ...
 ){
-  stop("a 'root' of class ", class(root), " is not supported")
+  stop("a 'root' of class ", class(root), " is not supported", call. = FALSE)
 }
 
 #' @export
@@ -124,7 +124,7 @@ prune_meta <- function(
 prune_meta.default <- function(
   root, path = NULL, recursive = TRUE, ...
 ){
-  stop("a 'root' of class ", class(root), " is not supported")
+  stop("a 'root' of class ", class(root), " is not supported", call. = FALSE)
 }
 
 #' @export
@@ -153,7 +153,7 @@ prune_meta.character <- function(
                   FUN.VALUE = NA, root = root, message = "none")
   if (any(!check)) {
     warning("Invalid metadata files found. See ?is_git2rmeta():\n",
-            paste(to_do_base[!check], collapse = "\n"))
+            paste(to_do_base[!check], collapse = "\n"), call. = FALSE)
   }
   to_do <- to_do[check]
 
@@ -207,6 +207,7 @@ prune_meta.git_repository <- function(
     changed <- gsub("\\.tsv$", ".yml", file.path(root_wd, changed, fsep = "/"))
     if (any(to_do %in% changed)) {
       stop(
+        call. = FALSE,
 "cannot remove and stage metadata in combination with removed but unstaged data"
       )
     }
@@ -216,7 +217,8 @@ prune_meta.git_repository <- function(
     ))
     changed <- gsub("\\.tsv$", ".yml", file.path(root_wd, changed, fsep = "/"))
     if (any(to_do %in% changed)) {
-      warning("data removed and staged, metadata removed but unstaged")
+      warning("data removed and staged, metadata removed but unstaged",
+              call. = FALSE)
     }
   }
   file.remove(to_do)

R/read_vc.R

@@ -22,7 +22,7 @@ read_vc <- function(file, root = ".") {
 
 #' @export
 read_vc.default <- function(file, root) {
-  stop("a 'root' of class ", class(root), " is not supported")
+  stop("a 'root' of class ", class(root), " is not supported", call. = FALSE)
 }
 
 #' @export
@@ -41,9 +41,10 @@ read_vc.character <- function(file, root = ".") {
                  root = root, message = "error"),
     error = function(e) {
       if (e$message == "Corrupt data, mismatching data hash.") {
-        warning("Mismatching data hash. Data altered outside of git2rdata.")
+        warning("Mismatching data hash. Data altered outside of git2rdata.",
+                call. = FALSE)
       } else {
-        stop(e$message)
+        stop(e$message, call. = FALSE)
       }
     }
   )

R/recent_commit.R

@@ -102,7 +102,7 @@ recent_commit.git_repository <- function(file, root, data = FALSE) {
   blobs <- blobs[blobs$when == max(blobs$when), c("commit", "author", "when")]
   blobs <- unique(blobs)
   if (nrow(blobs) > 1) {
-      warning("More than one commit within the same second")
+      warning("More than one commit within the same second", call. = FALSE)
   }
   rownames(blobs) <- NULL
   blobs

R/relabel.R

@@ -69,7 +69,8 @@ relabel <- function(file, root = ".", change) {
 
 #' @export
 relabel.default <- function(file, root, change) {
-  stop("a 'change' of class ", class(change), " is not supported")
+  stop("a 'change' of class ", class(change), " is not supported",
+       call. = FALSE)
 }
 
 #' @export
@@ -94,7 +95,7 @@ relabel.list <- function(file, root = ".", change) {
   optimize <- meta_data[["..generic"]][["optimize"]]
   if (!optimize) {
     stop("relabelling factors on verbose data leads to large diffs.
-Use write_vc() instead.")
+Use write_vc() instead.", call. = FALSE)
   }
   assert_that(
     all(names(change) %in% names(meta_data)),

R/upgrade_data.R

@@ -72,8 +72,8 @@ upgrade_data.character <- function(
     msg = paste(target, "has corrupt metadata, no hash found.")
   )
   if (has_name(meta_data[["..generic"]], "git2rdata")) {
-    if (package_version(meta_data[["..generic"]][["git2rdata"]]) ==
-        packageVersion("git2rdata")
+    if (package_version(meta_data[["..generic"]][["git2rdata"]]) >=
+        package_version("0.0.5")
         ) {
       if (verbose) {
         message(target, " already up to date")

R/write_vc.R

@@ -7,6 +7,7 @@
 #' @param file the name of the git2rdata object. Git2rdata objects cannot
 #' have dots in their name. The name may include a relative path. `file` is a
 #' path relative to the `root`.
+#' Note that `file` must point to a location within `root`.
 #' @param root The root of a project. Can be a file path or a `git-repository`.
 #' Defaults to the current working directory (`"."`).
 #' @param sorting an optional vector of column names defining which columns to
@@ -27,7 +28,7 @@
 #' @export
 #' @family storage
 #' @template example-io
-#' @note `..generic` is a reserved name for the metadata and cannot be used as
+#' @note `..generic` is a reserved name for the metadata and is a forbidden
 #' column name in a `data.frame`.
 write_vc <- function(
   x, file, root = ".", sorting, strict = TRUE, optimize = TRUE, na = "NA",
@@ -67,7 +68,8 @@ write_vc.character <- function(
       is_git2rmeta(file = remove_root(file = file["meta_file"], root = root),
                    root = root, message = "error"),
       error = function(e) {
-        stop(paste("Existing metadata file is invalid.", e$message, sep = "\n"))
+        stop(paste("Existing metadata file is invalid.", e$message, sep = "\n"),
+             call. = FALSE)
       }
     )
     old <- read_yaml(file["meta_file"])
@@ -76,14 +78,18 @@ write_vc.character <- function(
                      old = old)
     problems <- compare_meta(attr(raw_data, "meta"), old)
     if (length(problems)) {
-      if (strict) {
-        problems <- c(
-          "The data was not overwritten because of the issues below.",
+      problems <- c(
 "See vignette('version_control', package = 'git2rdata') for more information.",
           "", problems)
+      if (strict) {
+        problems <- c(
+          "The data was not overwritten because of the issues below.", problems)
         stop(paste(problems, collapse = "\n"), call. = FALSE)
       }
-      warning(paste(problems, collapse = "\n"))
+      problems <- c(
+        "Changes in the metadata may lead to unnecessarily large diffs.",
+        problems)
+      warning(paste(problems, collapse = "\n"), call. = FALSE)
       if (missing(sorting) && !is.null(old[["..generic"]][["sorting"]])) {
         sorting <- old[["..generic"]][["sorting"]]
       }
@@ -97,6 +103,9 @@ write_vc.character <- function(
     col.names = TRUE, fileEncoding = "UTF-8"
   )
   meta_data <- attr(raw_data, "meta")
+  meta_data[["..generic"]][["git2rdata"]] <- as.character(
+    packageVersion("git2rdata")
+  )
   meta_data[["..generic"]][["data_hash"]] <- hashfile(file["raw_file"])
   write_yaml(meta_data, file["meta_file"],
              fileEncoding = "UTF-8")

README.md

@@ -1,5 +1,4 @@
-# The `git2rdata` package <img src="man/figures/logo.png" align="right" alt="" width="120" />
-
+# The `git2rdata` package <img src="https://ropensci.github.io/git2rdata/docs/reference/figures/logo.svg" align="right" alt="gitr2data logo" width="120" />
 
 <!-- badges: start -->
 [![CRAN status](https://www.r-pkg.org/badges/version/git2rdata)](https://cran.r-project.org/package=git2rdata)