From e1445a55285c1fdec6c64198e735a27b249b8387 Mon Sep 17 00:00:00 2001
From: "J. Allen Baron" <jabaron.phd@gmail.com>
Date: Wed, 11 Dec 2024 14:29:42 -0500
Subject: [PATCH 1/4] Add is_hex_color() predicate

---
 NAMESPACE                  |  1 +
 R/predicates.R             | 15 +++++++++++++++
 man/all_duplicated.Rd      |  1 +
 man/char_val_predicates.Rd |  1 +
 man/iff_all_vals.Rd        |  1 +
 man/is_curie.Rd            |  1 +
 man/is_hex_color.Rd        | 29 +++++++++++++++++++++++++++++
 man/is_invariant.Rd        |  1 +
 man/is_uri.Rd              |  1 +
 man/lgl_predicates.Rd      |  1 +
 man/num_val_predicates.Rd  |  1 +
 man/obo_ID_predicates.Rd   |  1 +
 12 files changed, 54 insertions(+)
 create mode 100644 man/is_hex_color.Rd

diff --git a/NAMESPACE b/NAMESPACE
index d6c1c589..b11d7735 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -86,6 +86,7 @@ export(invert_sublists)
 export(is_blank)
 export(is_boolean)
 export(is_curie)
+export(is_hex_color)
 export(is_invariant)
 export(is_missing)
 export(is_negative)
diff --git a/R/predicates.R b/R/predicates.R
index 741e571e..c3379fc6 100644
--- a/R/predicates.R
+++ b/R/predicates.R
@@ -373,6 +373,21 @@ iff_all_vals <- function(x, values) {
 }
 
 
+#' Test for Hexadecimal Colors
+#'
+#' Tests whether values in a character vector are valid hexadecimal color codes.
+#' Will _NOT_ recognize [abbreviated hex codes](https://en.wikipedia.org/wiki/Web_colors#Shorthand_hexadecimal_form)
+#' (e.g. `#fff`).
+#'
+#' @param x A character vector.
+#'
+#' @family predicates
+#' @export
+is_hex_color <- function(x) {
+    stringr::str_detect(x, "^#([0-9a-fA-F]{2}){3,4}$")
+}
+
+
 # Type tests for internal use only ----------------------------------------
 
 is_vctr_or_df <- function(x) {
diff --git a/man/all_duplicated.Rd b/man/all_duplicated.Rd
index 8f3c5f74..c3d88315 100644
--- a/man/all_duplicated.Rd
+++ b/man/all_duplicated.Rd
@@ -21,6 +21,7 @@ Other predicates:
 \code{\link{char_val_predicates}},
 \code{\link{iff_all_vals}()},
 \code{\link{is_curie}()},
+\code{\link{is_hex_color}()},
 \code{\link{is_invariant}()},
 \code{\link{is_uri}()},
 \code{\link{lgl_predicates}},
diff --git a/man/char_val_predicates.Rd b/man/char_val_predicates.Rd
index d58d1297..5fce760c 100644
--- a/man/char_val_predicates.Rd
+++ b/man/char_val_predicates.Rd
@@ -32,6 +32,7 @@ Other predicates:
 \code{\link{all_duplicated}()},
 \code{\link{iff_all_vals}()},
 \code{\link{is_curie}()},
+\code{\link{is_hex_color}()},
 \code{\link{is_invariant}()},
 \code{\link{is_uri}()},
 \code{\link{lgl_predicates}},
diff --git a/man/iff_all_vals.Rd b/man/iff_all_vals.Rd
index 81ec266f..9083f39c 100644
--- a/man/iff_all_vals.Rd
+++ b/man/iff_all_vals.Rd
@@ -24,6 +24,7 @@ Other predicates:
 \code{\link{all_duplicated}()},
 \code{\link{char_val_predicates}},
 \code{\link{is_curie}()},
+\code{\link{is_hex_color}()},
 \code{\link{is_invariant}()},
 \code{\link{is_uri}()},
 \code{\link{lgl_predicates}},
diff --git a/man/is_curie.Rd b/man/is_curie.Rd
index 7c8ddbe3..db459025 100644
--- a/man/is_curie.Rd
+++ b/man/is_curie.Rd
@@ -65,6 +65,7 @@ Other predicates:
 \code{\link{all_duplicated}()},
 \code{\link{char_val_predicates}},
 \code{\link{iff_all_vals}()},
+\code{\link{is_hex_color}()},
 \code{\link{is_invariant}()},
 \code{\link{is_uri}()},
 \code{\link{lgl_predicates}},
diff --git a/man/is_hex_color.Rd b/man/is_hex_color.Rd
new file mode 100644
index 00000000..e2ed8f8d
--- /dev/null
+++ b/man/is_hex_color.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/predicates.R
+\name{is_hex_color}
+\alias{is_hex_color}
+\title{Test for Hexadecimal Colors}
+\usage{
+is_hex_color(x)
+}
+\arguments{
+\item{x}{A character vector.}
+}
+\description{
+Tests whether values in a character vector are valid hexadecimal color codes.
+Will \emph{NOT} recognize \href{https://en.wikipedia.org/wiki/Web_colors#Shorthand_hexadecimal_form}{abbreviated hex codes}
+(e.g. \verb{#fff}).
+}
+\seealso{
+Other predicates: 
+\code{\link{all_duplicated}()},
+\code{\link{char_val_predicates}},
+\code{\link{iff_all_vals}()},
+\code{\link{is_curie}()},
+\code{\link{is_invariant}()},
+\code{\link{is_uri}()},
+\code{\link{lgl_predicates}},
+\code{\link{num_val_predicates}},
+\code{\link{obo_ID_predicates}}
+}
+\concept{predicates}
diff --git a/man/is_invariant.Rd b/man/is_invariant.Rd
index 5b430079..426bf889 100644
--- a/man/is_invariant.Rd
+++ b/man/is_invariant.Rd
@@ -44,6 +44,7 @@ Other predicates:
 \code{\link{char_val_predicates}},
 \code{\link{iff_all_vals}()},
 \code{\link{is_curie}()},
+\code{\link{is_hex_color}()},
 \code{\link{is_uri}()},
 \code{\link{lgl_predicates}},
 \code{\link{num_val_predicates}},
diff --git a/man/is_uri.Rd b/man/is_uri.Rd
index eed10407..3891abdf 100644
--- a/man/is_uri.Rd
+++ b/man/is_uri.Rd
@@ -57,6 +57,7 @@ Other predicates:
 \code{\link{char_val_predicates}},
 \code{\link{iff_all_vals}()},
 \code{\link{is_curie}()},
+\code{\link{is_hex_color}()},
 \code{\link{is_invariant}()},
 \code{\link{lgl_predicates}},
 \code{\link{num_val_predicates}},
diff --git a/man/lgl_predicates.Rd b/man/lgl_predicates.Rd
index e5aaac8b..cb68a924 100644
--- a/man/lgl_predicates.Rd
+++ b/man/lgl_predicates.Rd
@@ -20,6 +20,7 @@ Other predicates:
 \code{\link{char_val_predicates}},
 \code{\link{iff_all_vals}()},
 \code{\link{is_curie}()},
+\code{\link{is_hex_color}()},
 \code{\link{is_invariant}()},
 \code{\link{is_uri}()},
 \code{\link{num_val_predicates}},
diff --git a/man/num_val_predicates.Rd b/man/num_val_predicates.Rd
index c6bb8131..01fb48ac 100644
--- a/man/num_val_predicates.Rd
+++ b/man/num_val_predicates.Rd
@@ -41,6 +41,7 @@ Other predicates:
 \code{\link{char_val_predicates}},
 \code{\link{iff_all_vals}()},
 \code{\link{is_curie}()},
+\code{\link{is_hex_color}()},
 \code{\link{is_invariant}()},
 \code{\link{is_uri}()},
 \code{\link{lgl_predicates}},
diff --git a/man/obo_ID_predicates.Rd b/man/obo_ID_predicates.Rd
index 8ad1e7e9..54426288 100644
--- a/man/obo_ID_predicates.Rd
+++ b/man/obo_ID_predicates.Rd
@@ -78,6 +78,7 @@ Other predicates:
 \code{\link{char_val_predicates}},
 \code{\link{iff_all_vals}()},
 \code{\link{is_curie}()},
+\code{\link{is_hex_color}()},
 \code{\link{is_invariant}()},
 \code{\link{is_uri}()},
 \code{\link{lgl_predicates}},

From 4ccf7c8498f2ddfb79a6170eeb88f17ae1f97579 Mon Sep 17 00:00:00 2001
From: "J. Allen Baron" <jabaron.phd@gmail.com>
Date: Wed, 11 Dec 2024 15:48:28 -0500
Subject: [PATCH 2/4] Add internal gs_col2rgb() and capture Google Sheets
 colors

gs_col2rgb() recognizes a subset of the standard Google Sheets
colors by name (as seen by hover in Google Sheets) or hex code
and converts these values to RGB.

RGB is needed for googlesheets4 to set fill color. See examples
of googlesheets4::range_flood().

Only a subset of Google Sheets colors are included in gs_color.
---
 R/googlesheets.R  | 50 +++++++++++++++++++++++++++++++++++++++++++----
 man/gs_col2rgb.Rd | 21 ++++++++++++++++++++
 2 files changed, 67 insertions(+), 4 deletions(-)
 create mode 100644 man/gs_col2rgb.Rd

diff --git a/R/googlesheets.R b/R/googlesheets.R
index f97e7d59..3c22a3f2 100644
--- a/R/googlesheets.R
+++ b/R/googlesheets.R
@@ -80,8 +80,50 @@ range_add_dropdown <- function(ss, range, values, msg = "Choose a valid value",
 }
 
 
-# microbenchmark(
-#   cur_cols %>% purrr::map_dfc(setNames, object = list(logical())),
-#   cur_cols %>% purrr::map_dfc(~ tibble::tibble(!!.x := logical())),
+#' Convert Google Sheets Colors to RGB
+#'
+#' Converts one or more Google Sheets color names or hex codes to RGB values.
+#'
+#' @param colors A character vector of hex codes or one of the following color
+#' names from Google Sheets `r paste0(names(gs_color), collapse = ", ")`.
+#' @return A 3 x `length(colors)` matrix with `Red`, `Green`, & `Blue` rows in
+#' 1 column for each color in `colors`.
+#'
+#' @family Google Sheets Formatting
+#'
+#' @keywords internal
+gs_col2rgb <- function(colors) {
+  stopifnot(
+    "`colors` must be one or more recognized DO.utils:::gs_color name(s) or hex code(s)" =
+      all(colors %in% gs_color | colors %in% names(gs_color))
+  )
+  color_data <- ifelse(colors %in% gs_color, colors, gs_color[colors])
+  names(color_data) <- names(gs_color[gs_color %in% color_data])
+
+  col2rgb(color_data)
+}
+
 
-# )
+# Google Sheets colors defined in DO.utils
+gs_color <- c(
+  "red" = "#ff0000",
+  "orange" = "#ff9900",
+  "yellow" = "#ffff00",
+  "green" = "#00ff00",
+  "cyan" = "#00ffff",
+  "blue" = "#0000ff",
+  "purple" = "#9900ff",
+  "magenta" = "#ff00ff",
+  "light red 3" = "#f4cccc",
+  "light orange 3" = "#fce5cd",
+  "light yellow 3" = "#fff2cc",
+  "light green 3" = "#d9ead3",
+  "light cyan 3" = "#d0e0e3",
+  "light blue 3" = "#cfe2f3",
+  "light purple 3" = "#d9d2e9",
+  "light magenta 3" = "#ead1dc",
+  "white" = "#ffffff",
+  "black" = "#000000",
+  "dark grey 1" = "#b7b7b7",
+  "light grey 2" = "#efefef"
+)
diff --git a/man/gs_col2rgb.Rd b/man/gs_col2rgb.Rd
new file mode 100644
index 00000000..dd5ab294
--- /dev/null
+++ b/man/gs_col2rgb.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/googlesheets.R
+\name{gs_col2rgb}
+\alias{gs_col2rgb}
+\title{Convert Google Sheets Colors to RGB}
+\usage{
+gs_col2rgb(colors)
+}
+\arguments{
+\item{colors}{A character vector of hex codes or one of the following color
+names from Google Sheets red, orange, yellow, green, cyan, blue, purple, magenta, light red 3, light orange 3, light yellow 3, light green 3, light cyan 3, light blue 3, light purple 3, light magenta 3, white, black, dark grey 1, light grey 2.}
+}
+\value{
+A 3 x \code{length(colors)} matrix with \code{Red}, \code{Green}, & \code{Blue} rows in
+1 column for each color in \code{colors}.
+}
+\description{
+Converts one or more Google Sheets color names or hex codes to RGB values.
+}
+\concept{Google Sheets Formatting}
+\keyword{internal}

From 8eafc17c180fb90906f1ca2b404301171277a7c6 Mon Sep 17 00:00:00 2001
From: "J. Allen Baron" <jabaron.phd@gmail.com>
Date: Wed, 11 Dec 2024 15:55:53 -0500
Subject: [PATCH 3/4] Improve gs_col2rgb()

- Allow all hex color codes... not sure why I chose to limit them
in the first place.
- Drop naming of output... not all hex codes will have names and
the names could be added in the wrong order anyway.
---
 R/googlesheets.R | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/R/googlesheets.R b/R/googlesheets.R
index 3c22a3f2..a953da9d 100644
--- a/R/googlesheets.R
+++ b/R/googlesheets.R
@@ -93,12 +93,12 @@ range_add_dropdown <- function(ss, range, values, msg = "Choose a valid value",
 #'
 #' @keywords internal
 gs_col2rgb <- function(colors) {
+  hex <- is_hex_color(colors)
   stopifnot(
-    "`colors` must be one or more recognized DO.utils:::gs_color name(s) or hex code(s)" =
-      all(colors %in% gs_color | colors %in% names(gs_color))
+    "`colors` must be one or more hex code(s) or recognized DO.utils:::gs_color name(s)" =
+      all(hex | colors %in% names(gs_color))
   )
-  color_data <- ifelse(colors %in% gs_color, colors, gs_color[colors])
-  names(color_data) <- names(gs_color[gs_color %in% color_data])
+  color_data <- ifelse(hex, colors, gs_color[colors])
 
   col2rgb(color_data)
 }

From 50f47b1e38ef3d80235385123af841425600e98c Mon Sep 17 00:00:00 2001
From: "J. Allen Baron" <jabaron.phd@gmail.com>
Date: Wed, 11 Dec 2024 16:00:33 -0500
Subject: [PATCH 4/4] Create internal function set_gs_fill()

To set fill color of cells. Intended for use in
curation_template() when .data is provided.
---
 R/googlesheets.R   | 50 +++++++++++++++++++++++++++++++++++++++++++++-
 man/gs_col2rgb.Rd  |  6 +++++-
 man/set_gs_fill.Rd | 44 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 98 insertions(+), 2 deletions(-)
 create mode 100644 man/set_gs_fill.Rd

diff --git a/R/googlesheets.R b/R/googlesheets.R
index a953da9d..6a291780 100644
--- a/R/googlesheets.R
+++ b/R/googlesheets.R
@@ -80,6 +80,54 @@ range_add_dropdown <- function(ss, range, values, msg = "Choose a valid value",
 }
 
 
+#' Set Google Sheets Range Fill Color
+#'
+#' Sets the fill color for one or more ranges in a Google Sheet.
+#'
+#' @inheritParams curation_template
+#' @param ranges A character vector of ranges to set the background color for,
+#' as recognized by [googlesheets4::range_flood()].
+#'
+#' @section NOTE:
+#' This function relies on internal functions from the `googlesheets4` package
+#' and may break if the package is updated. See examples of
+#' [googlesheets4::range_flood()] for reference.
+#'
+#' @family Google Sheets Formatting functions
+#'
+#' @keywords internal
+set_gs_fill <- function(ss, sheet, ranges, colors) {
+  stopifnot(
+    "`ranges` and `colors` must be same length" =
+      length(ranges) == length(colors),
+  )
+  color_mat <- gs_col2rgb(colors)
+
+  gs_fill <- purrr::map(
+    seq_along(ranges),
+    function(.i) {
+      googlesheets4:::CellData(
+        userEnteredFormat = googlesheets4:::new(
+          "CellFormat",
+          backgroundColor = googlesheets4:::new(
+            "Color",
+            red = color_mat[1, .i] / 255,
+            green = color_mat[2, .i] / 255,
+            blue = color_mat[3, .i] / 255
+          )
+        )
+      )
+    }
+  )
+
+  purrr::walk2(
+    ranges,
+    gs_fill,
+    ~ googlesheets4::range_flood(ss, sheet, range = .x, cell = .y)
+  )
+}
+
+
 #' Convert Google Sheets Colors to RGB
 #'
 #' Converts one or more Google Sheets color names or hex codes to RGB values.
@@ -89,7 +137,7 @@ range_add_dropdown <- function(ss, range, values, msg = "Choose a valid value",
 #' @return A 3 x `length(colors)` matrix with `Red`, `Green`, & `Blue` rows in
 #' 1 column for each color in `colors`.
 #'
-#' @family Google Sheets Formatting
+#' @family Google Sheets Formatting functions
 #'
 #' @keywords internal
 gs_col2rgb <- function(colors) {
diff --git a/man/gs_col2rgb.Rd b/man/gs_col2rgb.Rd
index dd5ab294..ccdea019 100644
--- a/man/gs_col2rgb.Rd
+++ b/man/gs_col2rgb.Rd
@@ -17,5 +17,9 @@ A 3 x \code{length(colors)} matrix with \code{Red}, \code{Green}, & \code{Blue}
 \description{
 Converts one or more Google Sheets color names or hex codes to RGB values.
 }
-\concept{Google Sheets Formatting}
+\seealso{
+Other Google Sheets Formatting functions: 
+\code{\link{set_gs_fill}()}
+}
+\concept{Google Sheets Formatting functions}
 \keyword{internal}
diff --git a/man/set_gs_fill.Rd b/man/set_gs_fill.Rd
new file mode 100644
index 00000000..2c2f77a6
--- /dev/null
+++ b/man/set_gs_fill.Rd
@@ -0,0 +1,44 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/googlesheets.R
+\name{set_gs_fill}
+\alias{set_gs_fill}
+\title{Set Google Sheets Range Fill Color}
+\usage{
+set_gs_fill(ss, sheet, ranges, colors)
+}
+\arguments{
+\item{ss}{Something that identifies a Google Sheet:
+\itemize{
+\item its file id as a string or \code{\link[googledrive:drive_id]{drive_id}}
+\item a URL from which we can recover the id
+\item a one-row \code{\link[googledrive:dribble]{dribble}}, which is how googledrive
+represents Drive files
+\item an instance of \code{googlesheets4_spreadsheet}, which is what \code{\link[googlesheets4:gs4_get]{gs4_get()}}
+returns
+}
+
+Processed through \code{\link[googlesheets4:as_sheets_id]{as_sheets_id()}}.}
+
+\item{sheet}{(OPTIONAL) The sheet name, as a string. If \code{NULL} (default), the
+sheet name will default to "curation-" with today's date appended (formatted
+as "\%Y\%m\%d"; see \code{\link[=format.Date]{format.Date()}}).}
+
+\item{ranges}{A character vector of ranges to set the background color for,
+as recognized by \code{\link[googlesheets4:range_flood]{googlesheets4::range_flood()}}.}
+}
+\description{
+Sets the fill color for one or more ranges in a Google Sheet.
+}
+\section{NOTE}{
+
+This function relies on internal functions from the \code{googlesheets4} package
+and may break if the package is updated. See examples of
+\code{\link[googlesheets4:range_flood]{googlesheets4::range_flood()}} for reference.
+}
+
+\seealso{
+Other Google Sheets Formatting functions: 
+\code{\link{gs_col2rgb}()}
+}
+\concept{Google Sheets Formatting functions}
+\keyword{internal}