Inherit list_of(raw())

DESCRIPTION

@@ -21,11 +21,16 @@ URL: https://github.com/tidyverse/blob
 BugReports: https://github.com/tidyverse/blob/issues
 Imports: 
     methods,
-    prettyunits
+    prettyunits,
+    rlang,
+    vctrs
 Suggests: 
     covr,
+    crayon,
     pillar (>= 1.2.1),
     testthat
+Remotes: 
+    r-lib/vctrs
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE, roclets = c("collate", "namespace", "rd", "pkgapi::api_roclet"))

NAMESPACE

@@ -1,20 +1,32 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method("[",blob)
-S3method("[<-",blob)
-S3method("[[<-",blob)
-S3method("is.na<-",blob)
-S3method(as.blob,blob)
-S3method(as.blob,character)
-S3method(as.blob,integer)
-S3method(as.blob,list)
-S3method(as.blob,raw)
-S3method(as.data.frame,blob)
-S3method(c,blob)
+S3method(as.blob,default)
 S3method(format,blob)
-S3method(is.na,blob)
-S3method(print,blob)
+S3method(obj_print_data,blob)
+S3method(vec_cast,blob)
+S3method(vec_cast.blob,blob)
+S3method(vec_cast.blob,character)
+S3method(vec_cast.blob,default)
+S3method(vec_cast.blob,integer)
+S3method(vec_cast.blob,list)
+S3method(vec_cast.blob,logical)
+S3method(vec_cast.blob,raw)
+S3method(vec_cast.list,blob)
+S3method(vec_ptype_abbr,blob)
+S3method(vec_ptype_full,blob)
+S3method(vec_type2,blob)
+S3method(vec_type2.blob,blob)
+S3method(vec_type2.blob,default)
+S3method(vec_type2.blob,list)
+S3method(vec_type2.blob,vctrs_unspecified)
+S3method(vec_type2.list,blob)
 export(as.blob)
+export(as_blob)
 export(blob)
+export(is_blob)
 export(new_blob)
+export(vec_cast.blob)
+export(vec_type2.blob)
+import(rlang)
+import(vctrs)
 importFrom(methods,setOldClass)

R/blob.R

@@ -1,11 +1,19 @@
+#' @import vctrs
+#' @import rlang
+NULL
+
 #' @importFrom methods setOldClass
-setOldClass("blob")
+setOldClass(c("blob", "vctrs_list_of", "vctrs_vctr"))
 
 #' Construct a blob object
 #'
 #' `new_blob()` is a low-level constructor that takes a list of
-#' raw vectors. `blob()` constructs a blob from individual raw vectors,
-#' and `as.blob()` is a S3 generic that converts existing objects.
+#' raw vectors.
+#' `blob()` constructs a blob from individual raw vectors.
+#' `as_blob()` and `is_blob()` are simple forwarders to [vctrs::vec_cast()]
+#' and [inherits()], respectively.
+#'
+#' @seealso [as.blob()] for the legacy interface for specifying casts.
 #'
 #' @param ... Individual raw vectors
 #' @param x A list of raw vectors, or other object to coerce
@@ -19,48 +27,55 @@ setOldClass("blob")
 #'
 #' as.blob(c("Good morning", "Good evening"))
 blob <- function(...) {
-  new_blob(list(...))
+  x <- list2(...)
+  check_raw_list(x)
+  new_blob(x)
 }
 
-#' @export
-#' @rdname blob
-new_blob <- function(x) {
+check_raw_list <- function(x) {
+  quo <- enquo(x)
   if (!is_raw_list(x)) {
-    stop("`x` must be a list of raw vectors", call. = FALSE)
+    stop("`", as_label(quo), "` must be a list of raw vectors", call. = FALSE)
   }
-  structure(x, class = "blob")
 }
 
 #' @export
 #' @rdname blob
-as.blob <- function(x, ...) {
-  UseMethod("as.blob")
-}
-
-#' @export
-as.blob.blob <- function(x, ...) {
-  x
+new_blob <- function(x = list()) {
+  vec_assert(x, list())
+  new_list_of(x, ptype = raw(), class = "blob")
 }
 
 #' @export
-as.blob.list <- function(x, ...) {
-  new_blob(x)
+#' @rdname blob
+as_blob <- function(x) {
+  vec_cast(x, new_blob())
 }
 
 #' @export
-as.blob.raw <- function(x, ...) {
-  new_blob(list(x))
+#' @rdname blob
+is_blob <- function(x) {
+  inherits(x, "blob")
 }
 
+#' Deprecated generic
+#'
+#' The `as.blob()` generic has been deprecated in favor of
+#' [vec_cast.blob()].
+#' Implement a `vec_cast.blob.myclass()` method to support
+#' coercing objects of your class to blobs.
+#' See [vctrs::vec_cast()] for more detail.
+#'
+#' @param x An object.
+#' @param ... Passed on to methods.
+#'
 #' @export
-as.blob.character <- function(x, ...) {
-  new_blob(lapply(x, charToRaw))
+as.blob <- function(x, ...) {
+  signal_soft_deprecated("as.blob() is deprecated, use as_blob().")
+  UseMethod("as.blob")
 }
 
 #' @export
-as.blob.integer <- function(x, ...) {
-  new_blob(lapply(x, as.raw))
+as.blob.default <- function(x, ...) {
+  as_blob(x)
 }
-
-#' @export
-as.data.frame.blob <- as.data.frame.difftime

R/cast.R

@@ -0,0 +1,45 @@
+#' Casting
+#'
+#' Double dispatch methods to support [vctrs::vec_cast()].
+#'
+#' @inheritParams vctrs::vec_cast
+#'
+#' @method vec_cast blob
+#' @export
+#' @export vec_cast.blob
+vec_cast.blob <- function(x, to) UseMethod("vec_cast.blob")
+
+#' @method vec_cast.blob default
+#' @export
+vec_cast.blob.default <- function(x, to) stop_incompatible_cast(x, to)
+
+#' @method vec_cast.blob logical
+#' @export
+vec_cast.blob.logical <- function(x, to) vec_unspecified_cast(x, to)
+
+#' @method vec_cast.blob blob
+#' @export
+vec_cast.blob.blob <- function(x, to) x
+
+#' @method vec_cast.blob list
+#' @export
+vec_cast.blob.list <- function(x, to) blob(!!!x)
+
+#' @method vec_cast.blob integer
+#' @export
+vec_cast.blob.integer <- function(x, to) {
+  warn_deprecated("Coercing an integer vector to a blob is deprecated, please coerce to a list first.")
+  blob(!!!lapply(x, as_single_raw))
+}
+
+#' @method vec_cast.blob raw
+#' @export
+vec_cast.blob.raw <- function(x, to) blob(x)
+
+#' @method vec_cast.blob character
+#' @export
+vec_cast.blob.character <- function(x, to) blob(!!!lapply(x, charToRaw))
+
+#' @method vec_cast.list blob
+#' @export
+vec_cast.list.blob <- function(x, to) vec_data(x)

R/coerce.R

@@ -0,0 +1,38 @@
+#' Coercion
+#'
+#' Double dispatch methods to support [vctrs::vec_type2()].
+#'
+#' @inheritParams vctrs::vec_type2
+#'
+#' @method vec_type2 blob
+#' @export
+#' @export vec_type2.blob
+vec_type2.blob <- function(x, y) UseMethod("vec_type2.blob", y)
+
+#' @method vec_type2.blob default
+#' @export
+vec_type2.blob.default <- function(x, y) stop_incompatible_type(x, y)
+
+#' @method vec_type2.blob blob
+#' @export
+vec_type2.blob.blob <- function(x, y) {
+  new_blob(list())
+}
+
+#' @method vec_type2.blob vctrs_unspecified
+#' @export
+vec_type2.blob.vctrs_unspecified <- function(x, y) x
+
+#' @method vec_type2.blob list
+#' @export
+vec_type2.blob.list <- function(x, y) {
+  check_raw_list(y)
+  new_blob(list())
+}
+
+#' @method vec_type2.list blob
+#' @export
+vec_type2.list.blob <- function(x, y) {
+  check_raw_list(x)
+  new_blob(list())
+}