Merge pull request #9 from poissonconsulting/chk5

- Added chk_color(), chk_colour(), vld_color() and vld_colour().

NAMESPACE

@@ -1,6 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
+export(chk_color)
+export(chk_colour)
 export(darken)
 export(lighten)
 export(tinter)
+export(vld_color)
+export(vld_colour)
 import(chk)

R/chk.R

@@ -0,0 +1,57 @@
+#' Check Color String
+#'
+#' Checks that x is a string (non-missing character vector of length 1)
+#' that specifies a color.
+#'
+#' @inheritParams chk::chk_true
+#' @return `NULL`, invisibly. Called for the side effect of throwing an error
+#'   if the condition is not met.
+#' @seealso [vld_color()]
+#' @name chk_color
+NULL
+
+#' @describeIn chk_color Check Color String Object
+#'
+#' @description
+#'
+#' `chk_color`
+#' checks if a color string.
+#'
+#' @export
+#'
+#' @examples
+#'
+#' # chk_color
+#' chk_color("blue")
+#' try(chk_color("glue"))
+chk_color <- function(x, x_name = NULL) {
+  if (vld_color(x)) {
+    return(invisible())
+  }
+  if (is.null(x_name)) x_name <- deparse_backtick_chk(substitute(x))
+  chk_string(x, x_name = x_name)
+  abort_chk(x_name, " must be a valid color", call. = FALSE)
+}
+
+#' @describeIn chk_color Check Color String Object
+#'
+#' @description
+#'
+#' `chk_colour`
+#' checks if a color string.
+#'
+#' @export
+#'
+#' @examples
+#'
+#' # chk_colour
+#' chk_colour("blue")
+#' try(chk_colour("glue"))
+chk_colour <- function(x, x_name = NULL) {
+  if (vld_colour(x)) {
+    return(invisible())
+  }
+  if (is.null(x_name)) x_name <- deparse_backtick_chk(substitute(x))
+  chk_string(x, x_name = x_name)
+  abort_chk(x_name, " must be a valid color", call. = FALSE)
+}

R/tinter.R

@@ -13,7 +13,7 @@
 #' tinter("#fa6a5c", steps = 10, crop = 3)
 #' tinter("#fa6a5c", direction = "tints")
 tinter <- function(x, steps = 5, crop = 1, direction = "both", adjust = 0) {
-  check_colour(x)
+  chk_colour(x)
   chk_whole_number(steps)
   chk_whole_number(crop)
   chk_string(direction)
@@ -56,7 +56,7 @@ tinter <- function(x, steps = 5, crop = 1, direction = "both", adjust = 0) {
 #' @examples
 #' darken(tinter("blue"), 0.2)
 darken <- function(x, amount) {
-  lapply(x, check_colour)
+  chk_all(x, chk_colour)
   chk_number(amount)
   chk_range(amount)
   sapply(x, function(x) {
@@ -74,7 +74,7 @@ darken <- function(x, amount) {
 #' @examples
 #' lighten(tinter("blue"), 0.2)
 lighten <- function(x, amount) {
-  lapply(x, check_colour)
+  chk_all(x, chk_colour)
   chk_number(amount)
   chk_range(amount)
 

R/utils.R

@@ -13,11 +13,3 @@ tint <- function(x, steps, crop) {
   }
   tint[-(seq_len(crop))]
 }
-
-check_colour <- function(x) {
-  chk_string(x)
-  res <- try(grDevices::col2rgb(x), silent = TRUE)
-  if (class(res) == "try-error") {
-    stop(x, " is not a valid color", call. = FALSE)
-  }
-}

R/vld.R

@@ -0,0 +1,36 @@
+#' Validate Color String
+#'
+#' Validates whether x is a string (non-missing character vector of length 1)
+#' that specifies a color.
+#'
+#' @inheritParams chk::chk_true
+#' @return A flag indicating whether the object was validated.
+#' @seealso \code{\link{chk_color}()}
+#' @name vld_color
+NULL
+
+#' @describeIn vld_color Validate Color String
+#'
+#' @export
+#'
+#' @examples
+#'
+#' # vld_color
+#' vld_color("blue")
+#' vld_color("glue")
+vld_color <- function(x) {
+  vld_string(x) && !inherits(try(grDevices::col2rgb(x), silent = TRUE), "try-error")
+}
+
+#' @describeIn vld_color Validate Colour String
+#'
+#' @export
+#'
+#' @examples
+#'
+#' # vld_color
+#' vld_colour("blue")
+#' vld_colour("glue")
+vld_colour <- function(x) {
+  vld_color(x)
+}

tests/testthat/test-chk.R

@@ -0,0 +1,11 @@
+test_that("chk_color", {
+  expect_null(chk_color("green"))
+  expect_invisible(chk_color("green"))
+  chk::expect_chk_error(chk_color(1))
+})
+
+test_that("chk_colour", {
+  expect_null(chk_colour("green"))
+  expect_invisible(chk_colour("green"))
+  chk::expect_chk_error(chk_colour(1))
+})

tests/testthat/test-utils.R

@@ -1,6 +0,0 @@
-context("utils")
-
-test_that("utils", {
-  expect_error(check_colour("b"), "b is not a valid color")
-  expect_error(check_colour("#000"), "#000 is not a valid color")
-})

tests/testthat/test-vld.R

@@ -0,0 +1,17 @@
+test_that("vld_color", {
+  expect_true(vld_color("blue"))
+  expect_false(vld_color(1))
+  expect_false(vld_color(character(0)))
+  expect_false(vld_color(NA_character_))
+  expect_false(vld_color(c("blue", "green")))
+  expect_false(vld_color("glue"))
+})
+
+test_that("vld_colour", {
+  expect_true(vld_colour("blue"))
+  expect_false(vld_colour(1))
+  expect_false(vld_colour(character(0)))
+  expect_false(vld_colour(NA_character_))
+  expect_false(vld_colour(c("blue", "green")))
+  expect_false(vld_colour("glue"))
+})