bulma_column_narrow() accepts TRUE/FALSE

DESCRIPTION

@@ -17,3 +17,5 @@ Encoding: UTF-8
 LazyData: true
 RoxygenNote: 6.1.1
 Roxygen: list(markdown = TRUE)
+Suggests: 
+    testthat

R/columns.R

@@ -127,6 +127,8 @@ validate_col_size <- function(size, var_name = "size") {
 bulma_column_narrow <- function(viewport = NULL) {
   ret <- if (is.null(viewport)) {
     "is-narrow"
+  } else if (is.logical(viewport)) {
+    if (isTRUE(viewport)) "is-narrow" else return(NULL)
   } else {
     viewport <- validate_viewport(viewport)
     c_is(c_prefix(viewport, "narrow-"))

R/utils.R

@@ -22,19 +22,24 @@ tag_function <- function(.tag = "div") {
 validate_value <- function(value = NULL, choices, several.ok = TRUE, value_name = "") {
   if (!is.null(value) && length(value)) {
     value_name <- if (nchar(value_name) > 0) glue("`{value_name}` - ") else ""
-    if (!several.ok && length(value) > 1) {
-      msg <- glue("{value_name}Using the first of {length(value)} values: {value[1]}")
-      rlang::warn(msg)
-      value <- value[1]
-    }
+    warnings <- c()
     not_in_choices <- setdiff(value, choices)
     if (length(not_in_choices)) {
-      msg <- glue("{value_name}Ignoring invalid choices: ",
+      warnings <- glue("{value_name}Ignoring invalid choices: ",
                   "\"{paste(not_in_choices, collapse = '\", \"')}\"")
-      rlang::warn(msg)
       value <- intersect(value, choices)
     }
+    if (!several.ok && length(value) > 1) {
+      warnings <- c(
+        warnings,
+        glue("{value_name}Using the first of {length(value)} values: {value[1]}")
+      )
+      value <- value[1]
+    }
     if (length(value)) {
+      if (length(warnings)) {
+        rlang::warn(paste(warnings, collapse = "\n"))
+      }
       value
     } else {
       rlang::abort(glue("{value_name}Must be one of the following valid choices: ",

tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(bulma)
+
+test_check("bulma")

tests/testthat/test-columns.R

@@ -0,0 +1,16 @@
+context("test-columns")
+
+test_that("bulma_column_narrow() handles viewport and logical", {
+  expect_equal_unclass <- function(x, y) {
+    expect_equal(unclass(x), y)
+  }
+  expect_equal_unclass(bulma_column_narrow("touch"), "is-narrow-touch")
+  expect_equal_unclass(bulma_column_narrow("desktop"), "is-narrow-desktop")
+  expect_s3_class(bulma_column_narrow("desktop"), "bulma_column_narrow")
+  expect_equal_unclass(bulma_column_narrow(TRUE), "is-narrow")
+  expect_equal_unclass(bulma_column_narrow(), "is-narrow")
+  expect_null(bulma_column_narrow(FALSE))
+  expect_error(bulma_column_narrow("touchscreen"))
+  expect_warning(bulma_column_narrow(c("touch", "desktop")))
+  expect_warning(bulma_column_narrow(c("touchscreen", "touch")))
+})