Add constructors

hadley · hadley · commit b21e5ec258e1 · 2016-10-27T08:24:37.000-05:00
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -15,3 +15,5 @@ Encoding: UTF-8
 LazyData: true
 URL: https://github.com/hadley/blob
 BugReports: https://github.com/hadley/blob/issues
+Suggests: testthat
+RoxygenNote: 5.0.1.9000
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,2 +1,9 @@
-# Generated by roxygen2: fake comment so roxygen2 overwrites silently.
-exportPattern("^[^\\.]")
+# Generated by roxygen2: do not edit by hand
+
+S3method(as.blob,character)
+S3method(as.blob,integer)
+S3method(as.blob,list)
+S3method(as.blob,raw)
+export(as.blob)
+export(blob)
+export(new_blob)
diff --git a/R/blob.R b/R/blob.R
@@ -0,0 +1,53 @@
+#' Construct a blob object
+#'
+#' \code{new_blob} is a low-level constructor that takes a list of
+#' raw vectors. \code{blob} constructs a blob from individual raw vectors,
+#' and \code{as.blob} is a S3 generic that converts existing objects.
+#'
+#' @param ... Individual raw vectors
+#' @param x A list of raw vectors, or other object to coerce
+#' @export
+#' @examples
+#' x1 <- charToRaw("Good morning")
+#' x2 <- as.raw(c(0x48, 0x65, 0x6c, 0x6c, 0x6f))
+#'
+#' new_blob(list(x1, x2))
+#' blob(x1, x2)
+#'
+#' as.blob(c("Good morning", "Good evening"))
+blob <- function(...) {
+  new_blob(list(...))
+}
+
+#' @export
+#' @rdname blob
+new_blob <- function(x) {
+  check_blob(x)
+  structure(x, class = "blob")
+}
+
+#' @export
+#' @rdname blob
+as.blob <- function(x, ...) {
+  UseMethod("as.blob")
+}
+
+#' @export
+as.blob.list <- function(x, ...) {
+  new_blob(x)
+}
+
+#' @export
+as.blob.raw <- function(x, ...) {
+  new_blob(list(x))
+}
+
+#' @export
+as.blob.character <- function(x, ...) {
+  new_blob(lapply(x, charToRaw))
+}
+
+#' @export
+as.blob.integer <- function(x, ...) {
+  new_blob(lapply(x, as.raw))
+}
diff --git a/R/util.R b/R/util.R
@@ -0,0 +1,5 @@
+check_blob <- function(x) {
+  if (!is.list(x) || !all(vapply(x, is.raw, logical(1)))) {
+    stop("`x` must be a list of raw vectors", call. = FALSE)
+  }
+}
diff --git a/man/blob.Rd b/man/blob.Rd
diff --git a/tests/testthat.R b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(blob)
+
+test_check("blob")
diff --git a/tests/testthat/test-construction.R b/tests/testthat/test-construction.R
@@ -0,0 +1,7 @@
+context("construction")
+
+test_that("input must be list of raw blobs", {
+  expect_error(new_blob(1), "must be a list of raw vectors")
+  expect_error(new_blob(list(1)), "must be a list of raw vectors")
+  expect_error(new_blob(list(1, as.raw(1))), "must be a list of raw vectors")
+})
