Set up basic printing methods

hadley · hadley · commit c6e735944b89 · 2016-10-27T08:41:50.000-05:00
@krlmlr tibble::tibble(x = as.blob(1:5)) uses the default printing method, not the methods I've defined here. What am I doing wrong?
diff --git a/NAMESPACE b/NAMESPACE
@@ -4,6 +4,14 @@ S3method(as.blob,character)
 S3method(as.blob,integer)
 S3method(as.blob,list)
 S3method(as.blob,raw)
+S3method(format,blob)
+S3method(is_vector_s3,blob)
+S3method(obj_sum,blob)
+S3method(print,blob)
+S3method(type_sum,blob)
 export(as.blob)
 export(blob)
 export(new_blob)
+importFrom(tibble,is_vector_s3)
+importFrom(tibble,obj_sum)
+importFrom(tibble,type_sum)
diff --git a/R/format.R b/R/format.R
@@ -0,0 +1,48 @@
+#' @export
+format.blob <- function(x, ...) {
+  if (length(x) == 0)
+    return(character())
+
+  paste0("blob[", blob_size(x, ...) , "]")
+}
+
+#' @export
+print.blob <- function(x, ...) {
+  if (length(x) == 0) {
+    cat("blob()\n")
+  } else {
+    print(format(x, ...), quote = FALSE)
+  }
+}
+
+#' @export
+#' @importFrom tibble type_sum
+type_sum.blob <- function(x) {
+  "blob"
+}
+
+#' @export
+#' @importFrom tibble obj_sum
+obj_sum.blob <- function(x) {
+  format(x, trim = FALSE)
+}
+
+#' @export
+#' @importFrom tibble is_vector_s3
+is_vector_s3.blob <- function(x) TRUE
+
+blob_size <- function(x, digits = 3, trim = TRUE) {
+  x <- vapply(x, length, integer(1))
+
+  power <- min(floor(log(abs(x), 1000)), 4)
+  if (power < 1) {
+    unit <- "B"
+  } else {
+    unit <- c("kb", "Mb", "Gb", "Tb")[[power]]
+    x <- x / (1024 ^ power)
+  }
+
+  x1 <- signif(x, digits = digits)
+  x2 <- format(x1, big.mark = ",", scientific = FALSE, trim = trim)
+  paste0(x2, " ", unit)
+}
