Remove type_sum() specializations

Use qualified access to vctrs functions

vec_is() requires vctrs > 0.1.0

NAMESPACE

@@ -43,14 +43,7 @@ S3method(print,pillar_vertical)
 S3method(print,rif_shaft)
 S3method(print,spark)
 S3method(print,squeezed_colonnade)
-S3method(type_sum,AsIs)
-S3method(type_sum,Date)
-S3method(type_sum,POSIXct)
-S3method(type_sum,data.frame)
 S3method(type_sum,default)
-S3method(type_sum,difftime)
-S3method(type_sum,factor)
-S3method(type_sum,ordered)
 export(colonnade)
 export(dim_desc)
 export(expect_known_display)

R/type-sum.R

@@ -10,46 +10,32 @@
 #' @export
 type_sum <- function(x) UseMethod("type_sum")
 
-#' @export
-type_sum.ordered <- function(x) "ord"
-#' @export
-type_sum.factor <- function(x) "fctr"
-#' @export
-type_sum.POSIXct <- function(x) "dttm"
-#' @export
-type_sum.difftime <- function(x) "drtn"
-#' @export
-type_sum.Date <- function(x) "date"
-#' @export
-type_sum.data.frame <- function(x) class(x)[[1]]
-#' @export
-type_sum.AsIs <- function(x) paste0("I<", type_sum(remove_as_is_class(x)), ">")
 #' @export
 type_sum.default <- function(x) {
-  if (!is.object(x)) {
-    switch(typeof(x),
-      logical = "lgl",
-      integer = "int",
-      double = "dbl",
-      character = "chr",
-      complex = "cpl",
-      builtin = ,
-      special = ,
-      closure = "fn",
-      environment = "env",
-      symbol =
-        if (is_missing(x)) {
-          "missing"
-        } else {
-          "sym"
-        },
-      typeof(x)
-    )
-  } else if (!isS4(x)) {
-    paste0("S3: ", class(x)[[1]])
-  } else {
-    paste0("S4: ", methods::is(x)[[1]])
-  }
+  if (is.object(x) || vec_is(x)) return(vctrs::vec_ptype_abbr(x))
+
+  switch(typeof(x),
+    builtin = ,
+    special = ,
+    closure = "fn",
+    environment = "env",
+    symbol =
+      if (is_missing(x)) {
+        "missing"
+      } else {
+        "sym"
+      },
+
+    typeof(x)
+  )
+}
+
+# vec_is() needs vctrs > 0.1.0
+# Defined in .onLoad()
+vec_is <- NULL
+
+compat_vec_is <- function(x) {
+  is_vector(x)
 }
 
 #' @description

R/zzz.R

@@ -16,6 +16,12 @@ NULL
     rm("strrep", inherits = TRUE)
   }
 
+  if (utils::packageVersion("vctrs") > "0.1.0") {
+    vec_is <<- get("vec_is", asNamespace("vctrs"))
+  } else {
+    vec_is <<- compat_vec_is
+  }
+
   compat_lengths()
 
   invisible()

tests/testthat/bw-out/list-narrow.txt

@@ -1,2 +1,2 @@
 <list>    
-<data.fra…
+<df[,5] […

tests/testthat/bw-out/lubridate.txt

@@ -1,4 +1,4 @@
-<S4: Duration>
-1s            
-2s            
-3s            
+<Duration>
+1s        
+2s        
+3s        

tests/testthat/bw-out/time-digits-secs.txt

@@ -1,3 +1,3 @@
-<S3: POSIXlt>           
+<dttm>                  
 2017-07-28 18:04:35.0000
 NA                      

tests/testthat/bw-out/time-posix.txt

@@ -1,3 +1,3 @@
-<S3: POSIXlt>      
+<dttm>             
 2017-07-28 18:04:35
 NA                 

tests/testthat/test-obj-sum.R

@@ -2,32 +2,29 @@ context("obj_sum")
 
 # obj_sum ----------------------------------------------------------------
 
-test_that("shows only first class name for S4", {
-  A <- methods::setClass("A")
-  expect_equal(obj_sum(A), "S4: classGeneratorFunction")
+test_that("forwards to vec_ptype_abbr() for S4", {
+  x <- methods::setClass("A")
+  expect_equal(obj_sum(x), vctrs::vec_ptype_abbr(x))
 })
 
-test_that("shows only first class name for S3", {
+test_that("forwards to vec_ptype_abbr() for S3", {
   x <- structure(list(), class = c("a", "b", "c"))
-  expect_equal(obj_sum(x), "S3: a")
+  expect_equal(obj_sum(x), vctrs::vec_ptype_abbr(x))
 })
 
 test_that("NULL handled specially", {
   expect_equal(obj_sum(NULL), "NULL")
 })
 
-test_that("data frame and tibbles include rows and cols", {
-  expect_equal(obj_sum(mtcars), paste0("data.frame [32 ", mult_sign(), " 11]"))
-})
-
-test_that("common data vectors treated as atomic", {
+test_that("data frames and common data vectors have size summary", {
   expect_obj_sum_is_ptype <- function(x) {
     obj_sum <- obj_sum(x)
-    ptype <- vec_ptype_abbr(x)
+    ptype <- vctrs::vec_ptype_abbr(x)
 
     expect_equal(obj_sum, !! paste0(ptype, size_sum(x)))
   }
 
+  expect_obj_sum_is_ptype(mtcars)
   expect_obj_sum_is_ptype(factor(1:3))
   expect_obj_sum_is_ptype(ordered(1:3))
   expect_obj_sum_is_ptype(Sys.Date() + 1:3)
@@ -42,7 +39,6 @@ test_that("less common objects get abbreviations", {
   expect_equal(type_sum(environment()), "env")
   expect_equal(type_sum(environment), "fn")
   expect_equal(type_sum(list), "fn")
-  expect_equal(type_sum(1i), "cpl")
   expect_equal(type_sum(quote(foo)), "sym")
   expect_equal(type_sum(expr()), "missing")
 })