From 1216f309dbddcc13c763ddc6e5177ba43aa4c093 Mon Sep 17 00:00:00 2001
From: Vincent Arel-Bundock <vincent.arel-bundock@umontreal.ca>
Date: Mon, 15 Jan 2024 17:00:49 -0500
Subject: [PATCH 1/3] lazy styles

---
 R/print.R    |  9 +++++----
 R/style_tt.R | 49 +++++++++++++++++++++++++++----------------------
 R/tt.R       |  1 +
 R/utils.R    | 12 ++++++++++++
 4 files changed, 45 insertions(+), 26 deletions(-)

diff --git a/R/print.R b/R/print.R
index 695676ee..3ef7eb78 100644
--- a/R/print.R
+++ b/R/print.R
@@ -26,20 +26,21 @@ knit_print.tinytable <- function(x, ...) {
 
 #' @export
 print.tinytable <- function(x, ...) {
-  m <- meta(x)
+  # lazy styles get evaluated here, at the very end
+  x <- eval_style(x)
 
-  if (m$output == "latex") {
+  if (meta(x, "output") == "latex") {
     out <- x
     class(out) <- "character"
     cat("\n")
     cat(out)
     cat("\n")
 
-  } else if (m$output == "markdown") {
+  } else if (meta(x, "output") == "markdown") {
     cat("\n")
     cat(x, sep = "\n")
 
-  } else if (m$output == "html") {
+  } else if (meta(x, "output") == "html") {
     dir <- tempfile()
     dir.create(dir)
     htmlFile <- file.path(dir, "index.html")
diff --git a/R/style_tt.R b/R/style_tt.R
index 83291ba5..7fe3b62d 100644
--- a/R/style_tt.R
+++ b/R/style_tt.R
@@ -54,21 +54,20 @@ style_tt <- function (x,
                       bootstrap_css_rule = NULL) {
 
   # sanity x
-  m <- meta(x)
-  if (is.null(m)) stop("`x` must be generated by `tinytable::tt()`.", call. = FALSE)
-  if (!isTRUE(m$output %in% c("html", "latex"))) return(x)
+  if (is.null(meta(x))) stop("`x` must be generated by `tinytable::tt()`.", call. = FALSE)
+  if (!isTRUE(meta(x)$output %in% c("html", "latex"))) return(x)
 
   out <- x
   if (is.null(i)) {
-    ival <- seq_len(m$nrows)
+    ival <- seq_len(meta(x)$nrows)
   } else {
     ival <- i
   }
   if (is.null(j)) {
-    jval <- seq_len(m$ncols)
+    jval <- seq_len(meta(x)$ncols)
   } else {
-    if (is.character(j) && length(j) == 1 && is.character(m$colnames)) {
-      jval <- grep(j, m$colnames, perl = TRUE)
+    if (is.character(j) && length(j) == 1 && is.character(meta(x)$colnames)) {
+      jval <- grep(j, meta(x)$colnames, perl = TRUE)
     } else {
       jval <- j
     }
@@ -85,13 +84,13 @@ style_tt <- function (x,
 
 
   if (!is.null(colspan)) {
-    if (m$output == "html") {
+    if (meta(x)$output == "html") {
       warning("`colspan` is not available for HTML tables yet. You can follow progress here: https://github.com/vincentarelbundock/tinytable/issues/43", call. = FALSE )
     }
     if (is.null(j) || is.null(i) || (!is.null(i) && length(ival) != 1) || (!is.null(j) && length(jval) != 1)) {
       stop("`i` and `j` must be of length 1 when using `colspan`.", call. = FALSE)
     }
-    assert_integerish(colspan, len = 1, lower = 1, upper = jval + m$ncols)
+    assert_integerish(colspan, len = 1, lower = 1, upper = jval + meta(x)$ncols)
   }
 
   settings <- expand.grid(i = ival, j = jval)
@@ -99,7 +98,7 @@ style_tt <- function (x,
     settings <- settings[order(settings$i, settings$j), ]
   }
 
-  if (m$output == "latex") {
+  if (meta(x)$output == "latex") {
     # colspan requires cell level, so we keep the full settings DF
     if (is.null(colspan)) {
       if (is.null(i) && is.null(j)) {
@@ -115,12 +114,12 @@ style_tt <- function (x,
   settings$tabularray <- settings$bootstrap <- ""
 
   # do not style the header. JS 0-indexing
-  if (m$output == "latex" && "i" %in% colnames(settings)) {
-    settings$i <- settings$i + m$nhead
+  if (meta(x)$output == "latex" && "i" %in% colnames(settings)) {
+    settings$i <- settings$i + meta(x)$nhead
   }
 
   # settings have a different size for latex, so bootstrap breaks
-  if (m$output == "html") {
+  if (meta(x)$output == "html") {
     vectorize_bootstrap <- function(setting, userinput, string) {
 
       # simple cases
@@ -203,7 +202,12 @@ style_tt <- function (x,
   if (!is.null(cols)) {
     hex <- cols[grepl("^#", cols)]
     for (h in hex) {
-      out <- style_tabularray(out, body = sprintf("\\tinytableDefineColor{%s}{HTML}{%s}", sub("^#", "c", h), sub("^#", "", h)))
+      b <- sprintf(
+        "\\tinytableDefineColor{%s}{HTML}{%s}",
+        sub("^#", "c", h), sub("^#", "", h))
+      cal <- call("style_tabularray", body = b)
+      browser()
+      out <- meta(out, "lazy_style", c(meta(out)$lazy_style, list(cal)))
     }
   }
   if (!is.null(background)) {
@@ -224,7 +228,7 @@ style_tt <- function (x,
 
   span <- if (!is.null(colspan)) paste0("c=", colspan, ",") else ""
 
-  if (m$output == "latex") {
+  if (meta(x)$output == "latex") {
     for (k in seq_len(nrow(settings))) {
       if (all(c("i", "j") %in% colnames(settings))) {
         spec <- sprintf("cell{%s}{%s}={%s}{%s},", settings$i[k], settings$j[k], span, settings$tabularray[k])
@@ -235,18 +239,19 @@ style_tt <- function (x,
       else if ("j" %in% colnames(settings)) {
         spec <- sprintf("column{%s}={%s},", settings$j[k], settings$tabularray[k])
       }
-      out <- style_tabularray(out, inner = spec)
+      cal <- call("style_tabularray", inner = spec)
+      out <- meta(out, "lazy_style", c(meta(out)$lazy_style, list(cal)))
     }
   }
   if (!is.null(tabularray_inner) || !is.null(tabularray_outer)) {
-    out <- style_tabularray(out, inner = tabularray_inner, outer = tabularray_outer)
+    cal <- call("style_tabularray", inner = tabularray_inner, outer = tabularray_outer)
+    out <- meta(out, "lazy_style", c(meta(out)$lazy_style, list(cal)))
   }
   if (!is.null(bootstrap_css) || !is.null(bootstrap_css_rule)) {
-    out <- style_bootstrap(out, i = ival, j = jval, css = bootstrap_css, css_rule = bootstrap_css_rule)
+    cal <- call("style_bootstrap", i = ival, j = jval, css = bootstrap_css, css_rule = bootstrap_css_rule)
+    out <- meta(out, "lazy_style", c(meta(out)$lazy_style, list(cal)))
   }
 
-
-  attr(out, "tinytable_meta") <- m
   return(out)
 }
 
@@ -275,8 +280,8 @@ assert_style_tt <- function (x,
 
   m <- meta(x)
 
-  assert_integerish(ival, lower = 1 - m$nhead, upper = m$nrows, name = "i")
-  assert_integerish(jval, lower = 1, upper = m$ncols, name = "j")
+  assert_integerish(ival, lower = 1 - meta(x)$nhead, upper = meta(x)$nrows, name = "i")
+  assert_integerish(jval, lower = 1, upper = meta(x)$ncols, name = "j")
   assert_string(width, null.ok = TRUE)
   assert_choice(align, c("c", "l", "r"), null.ok = TRUE)
   assert_numeric(indent, len = 1, lower = 0)
diff --git a/R/tt.R b/R/tt.R
index c163ca8a..9b6cf9c7 100644
--- a/R/tt.R
+++ b/R/tt.R
@@ -73,6 +73,7 @@ tt <- function(x,
   out <- meta(out, "nhead", if (is.null(colnames(x))) 0 else 1)
   out <- meta(out, "nrows", nrow(x))
   out <- meta(out, "ncols", ncol(x))
+  out <- meta(out, "lazy_style", list())
 
   if (!is.null(align)) {
     if (nchar(align) != ncol(x)) {
diff --git a/R/utils.R b/R/utils.R
index b9010f8c..b472b6ea 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -28,3 +28,15 @@ meta <- function(x, get, set) {
   return(meta_attr[[get]])
 }
 
+
+
+# style_tt() stores style calls and we only want to evaluate them at the end because 
+# some rows may be added, which changes how the style is applied
+eval_style <- function(x) {
+  out <- x
+  for (lazy_style in meta(x)$lazy_style) {
+    lazy_style[["x"]] <- out
+    out <- eval(lazy_style)
+  }
+  return(out)
+}

From 3ff950cd875b4142612edcbda5b8c0be6db1919f Mon Sep 17 00:00:00 2001
From: Vincent Arel-Bundock <vincent.arel-bundock@umontreal.ca>
Date: Mon, 15 Jan 2024 17:12:18 -0500
Subject: [PATCH 2/3] lazy style eval

---
 R/print.R    | 7 ++++---
 R/save_tt.R  | 5 +++--
 R/style_tt.R | 1 -
 3 files changed, 7 insertions(+), 6 deletions(-)

diff --git a/R/print.R b/R/print.R
index 3ef7eb78..08b3f4d9 100644
--- a/R/print.R
+++ b/R/print.R
@@ -3,9 +3,10 @@
 #' @keywords internal
 #' @export
 knit_print.tinytable <- function(x, ...) {
-  m <- meta(x)
+  # lazy styles get evaluated here, at the very end
+  x <- eval_style(x)
 
-  if (m$output == "html") {
+  if (meta(x)$output == "html") {
     # from htmltools:::html_preserve
     # GPL3
     inline <- grepl(x, "\n", fixed = TRUE)
@@ -15,7 +16,7 @@ knit_print.tinytable <- function(x, ...) {
       out <- sprintf("\n```{=html}\n%s\n```\n", x)
     }
 
-  } else if (m$output %in% c("latex", "markdown")) {
+  } else if (meta(x)$output %in% c("latex", "markdown")) {
     out <- x
   }
 
diff --git a/R/save_tt.R b/R/save_tt.R
index f35ea226..9cf97f20 100644
--- a/R/save_tt.R
+++ b/R/save_tt.R
@@ -17,10 +17,8 @@
 #' }
 #'
 save_tt <- function(x, filename, overwrite = FALSE) {
-
   m <- meta(x)
 
-
   assert_string(filename)
   assert_flag(overwrite)
   if (file.exists(filename) && !overwrite) {
@@ -30,6 +28,9 @@ save_tt <- function(x, filename, overwrite = FALSE) {
     stop("`x` must be an object produced by the `tinytable::tt()` function.", call. = FALSE)
   }
 
+  # evaluate styles at the very end of the pipeline
+  x <- eval_style(x)
+
   write(x, file = filename)
 
   return(invisible(TRUE))
diff --git a/R/style_tt.R b/R/style_tt.R
index 7fe3b62d..0b67e1b3 100644
--- a/R/style_tt.R
+++ b/R/style_tt.R
@@ -206,7 +206,6 @@ style_tt <- function (x,
         "\\tinytableDefineColor{%s}{HTML}{%s}",
         sub("^#", "c", h), sub("^#", "", h))
       cal <- call("style_tabularray", body = b)
-      browser()
       out <- meta(out, "lazy_style", c(meta(out)$lazy_style, list(cal)))
     }
   }

From e07aa90735c70251e7b246aeb11e17199141ca8d Mon Sep 17 00:00:00 2001
From: Vincent Arel-Bundock <vincent.arel-bundock@umontreal.ca>
Date: Mon, 15 Jan 2024 18:22:54 -0500
Subject: [PATCH 3/3] bug: dont' overwrite meta

---
 R/group_tabularray.R | 1 -
 1 file changed, 1 deletion(-)

diff --git a/R/group_tabularray.R b/R/group_tabularray.R
index 26507c8a..db568387 100644
--- a/R/group_tabularray.R
+++ b/R/group_tabularray.R
@@ -59,7 +59,6 @@ group_tabularray_col <- function(x, j, ...) {
     out <- do.call(style_tt, args)
   }
 
-  attr(out, "tinytable_meta") <- m
   return(out)
 
 }