Let a second call refine the config verbs instead of replacing it (#119)

NEWS.md

@@ -1,5 +1,6 @@
 # clinify (development version)
 
+- Fixed a second call to `clin_row_height()`, `clin_header_pad()` or `clin_spanner_rule()` replacing the first instead of refining it. Arguments the later call does not name now keep whatever the earlier one set, so a house wide setting and a per table exception can both be stated without restating the rest. Previously the earlier values reverted to their defaults with no error or warning ([#119](https://github.com/atorus-research/clinify/issues/119))
 - `clin_row_height()` gained `header` and `header_leading`, completing the vertical pitch controls asked for in #97. `header` bounds the column header rows the way `body` bounds the body rows, and `header_leading` closes the gap between the lines *within* a header cell, which is what a wrapped arm label sitting looser than a reference output actually needs. Leading is a multiple of single spacing rather than a length, since that is how flextable and Word express it ([#117](https://github.com/atorus-research/clinify/issues/117))
 - Fixed `clintable()` erroring on data carrying haven value labels. `attr()` partial matches, so a `labels` attribute of value labels - which `haven::read_xpt()` attaches to coded variables - was answering a request for `label` and being read as header text ([#107](https://github.com/atorus-research/clinify/issues/107))
 - Fixed `use_labels = FALSE` not actually leaving column labels alone. flextable reads labels of its own accord and was never told not to, so the raw label string went into the header, `||` delimiter and all. This also gives a way past the flextable side of #107, since labels can now be turned off ([#107](https://github.com/atorus-research/clinify/issues/107))

R/header_pad.R

@@ -30,6 +30,9 @@
 #' added above the header it keeps its own spacing, since it is put there as
 #' the table renders.
 #'
+#' Called a second time, this refines what the first call set rather than
+#' replacing it: arguments this call does not name keep their earlier value.
+#'
 #' Spacing is given in points, which is what flextable measures cell padding
 #' in. Whatever is set here replaces the header padding clinify starts with.
 #'
@@ -80,9 +83,23 @@ clin_header_pad <- function(
     stop("`rule_to_body` must be a single number of points")
   }
 
-  pad$rows <- check_header_pad_rows_(rows)
+  # Only what this call actually named, so a second call refines the first
+  named <- c(
+    if (!missing(above)) "above",
+    if (!missing(below)) "below",
+    if (!missing(rule_to_body)) "rule_to_body"
+  )
+
+  supplied <- pad[named]
 
-  x$clinify_config$header_pad <- pad
+  if (!missing(rows)) {
+    supplied$rows <- check_header_pad_rows_(rows)
+  }
+
+  x$clinify_config$header_pad <- merge_config_(
+    x$clinify_config$header_pad,
+    supplied
+  )
   x
 }
 
@@ -175,7 +192,10 @@ apply_header_pad_ <- function(x) {
     rows <- seq_len(depth)
   } else if (!all(rows <= depth)) {
     stop(sprintf(
-      "`rows` must be header row numbers between 1 and %s, the number of rows this header has",
+      paste(
+        "`rows` must be header row numbers between 1 and %s, the number of",
+        "rows this header has"
+      ),
       depth
     ))
   }
@@ -204,7 +224,10 @@ pad_header_rows_ <- function(x, rows, value, side) {
 
   if (!length(value) %in% c(1, length(rows))) {
     stop(sprintf(
-      "Header spacing must be one value, or one for each of the %s rows it is aimed at, not %s",
+      paste(
+        "Header spacing must be one value, or one for each of the %s rows it",
+        "is aimed at, not %s"
+      ),
       length(rows),
       length(value)
     ))

R/row_height.R

@@ -18,6 +18,11 @@
 #' gap *between* those lines, so it is the one to reach for when a wrapped arm
 #' label sits looser than a reference output. They can be used together.
 #'
+#' Called a second time, this refines what the first call set rather than
+#' replacing it: arguments this call does not name keep their earlier value. So
+#' a house wide pitch can be set once and a single table can add an exception
+#' without restating the rest.
+#'
 #' The height is applied to whole parts, so it is a pitch for every row of the
 #' surface rather than a per-row height. Anything already set with
 #' `flextable::height()` or `flextable::height_all()` is replaced. Because the
@@ -70,6 +75,11 @@ clin_row_height <- function(
   unit = c("pt", "in", "cm", "mm")
 ) {
   stopifnot(inherits(x, "clintable") || inherits(x, "clindoc"))
+
+  # Captured before match.arg() assigns to them, which would clear their
+  # missing status and make a second call look like it had asked for the default
+  rule_given <- !missing(rule)
+
   rule <- match.arg(rule)
   unit <- match.arg(unit)
 
@@ -95,10 +105,38 @@ clin_row_height <- function(
     )
   }
 
-  x$clinify_config$row_height <- c(
-    heights,
-    list(rule = rule, header_leading = check_header_leading_(header_leading))
+  # Only what this call actually named, so a second call refines the first
+  # rather than replacing it. `rule` has a default, so being NULL cannot tell
+  # us whether the caller asked for it
+  named <- c(
+    if (!missing(body)) "body",
+    if (!missing(title)) "title",
+    if (!missing(footnote)) "footnote",
+    if (!missing(header)) "header"
+  )
+
+  supplied <- heights[named]
+
+  if (!missing(header_leading)) {
+    supplied$header_leading <- check_header_leading_(header_leading)
+  }
+
+  if (rule_given) {
+    supplied$rule <- rule
+  }
+
+  # A second call refines the first rather than replacing it, so a house wide
+  # pitch and a per table exception can both be stated
+  x$clinify_config$row_height <- merge_config_(
+    x$clinify_config$row_height,
+    supplied
   )
+
+  # Whatever ends up configured still needs a rule to be applied with
+  if (is.null(x$clinify_config$row_height$rule)) {
+    x$clinify_config$row_height$rule <- rule
+  }
+
   x
 }
 
@@ -313,3 +351,31 @@ apply_header_leading_ <- function(x) {
 
   flextable::line_spacing(x, space = leading, part = "header")
 }
+
+#' Fold a verb's arguments into whatever it was given before
+#'
+#' The verbs that carry several settings are meant to be usable twice - a house
+#' wide call, then a per table exception - so a second call refines the first
+#' rather than replacing it. Only the arguments actually supplied are taken
+#' from the new call; the rest keep what the earlier one set.
+#'
+#' Arguments whose default is not NULL, like `rule`, cannot be recognised by
+#' being NULL, so the caller passes the names it actually saw with
+#' `missing()`.
+#'
+#' @param previous The configuration already on the clintable, or NULL
+#' @param supplied A named list of the values this call is setting
+#'
+#' @return The merged configuration
+#'
+#' @noRd
+merge_config_ <- function(previous, supplied) {
+  if (is.null(previous)) {
+    return(supplied)
+  }
+
+  # A name present in `supplied` wins, even where its value is NULL, so that
+  # nothing the caller asked for is quietly dropped
+  previous[names(supplied)] <- supplied
+  previous
+}

R/spanner_rule.R

@@ -19,6 +19,9 @@
 #'   rather than a spanner, and the rule under the bottom row is the one the
 #'   styling function draws across the whole table.
 #'
+#' Called a second time, this refines what the first call set rather than
+#' replacing it: arguments this call does not name keep their earlier value.
+#'
 #' The rule is drawn as the table renders, after the default styling function
 #' has run. That is what makes it survive a house style: the stock
 #' `clinify_table_default()` opens with `flextable::border_remove()`, which
@@ -65,10 +68,28 @@
 clin_spanner_rule <- function(x, border = TRUE, rows = NULL) {
   stopifnot(inherits(x, "clintable"))
 
-  x$clinify_config$spanner_rule <- list(
-    border = check_spanner_border_(border),
-    rows = check_spanner_rows_(rows)
+  # Only what this call actually named, so a second call refines the first.
+  # `border` has a default, so being NULL cannot say if it was asked for
+  supplied <- list()
+
+  if (!missing(border)) {
+    supplied$border <- check_spanner_border_(border)
+  }
+
+  if (!missing(rows)) {
+    supplied$rows <- check_spanner_rows_(rows)
+  }
+
+  x$clinify_config$spanner_rule <- merge_config_(
+    x$clinify_config$spanner_rule,
+    supplied
   )
+
+  # A first call that named nothing still means "rule the spanners"
+  if (is.null(x$clinify_config$spanner_rule$border)) {
+    x$clinify_config$spanner_rule$border <- check_spanner_border_(border)
+  }
+
   x
 }
 

tests/testthat/test-header_pad.R

@@ -284,3 +284,24 @@ test_that("Per row header spacing is validated", {
     "single number of points"
   )
 })
+
+test_that("A second call refines the first rather than replacing it", {
+  # Same silent loss as #119, in the other verb that carries several settings
+  base <- clintable(head(mtcars[, 1:2], 2)) |>
+    clin_column_headers(mpg = c("Sp", "x"), cyl = c("Sp", "y"))
+
+  refined <- base |>
+    clin_header_pad(above = 18, below = 4) |>
+    clin_header_pad(rule_to_body = 6)
+
+  pad <- refined$clinify_config$header_pad
+  expect_equal(pad$above, 18)
+  expect_equal(pad$below, 4)
+  expect_equal(pad$rule_to_body, 6)
+
+  # A value named again is replaced
+  expect_equal(
+    clin_header_pad(clin_header_pad(base, above = 18, below = 4), below = 9)$clinify_config$header_pad$below,
+    9
+  )
+})

tests/testthat/test-row_height.R

@@ -336,3 +336,66 @@ test_that("Header pitch is validated", {
   # The "nothing asked for" message now names all five
   expect_error(clin_row_height(ct), "header_leading needs")
 })
+
+test_that("A second call refines the first rather than replacing it", {
+  # A house wide pitch plus a per table exception is the natural pattern, and a
+  # second call used to silently revert everything the first had set (#119)
+  base <- clintable(head(mtcars[, 1:2], 2)) |>
+    clin_column_headers(mpg = "A", cyl = "B")
+
+  house <- clin_row_height(
+    base,
+    body = 15.35,
+    title = 11.4,
+    footnote = 11.4,
+    rule = "atleast",
+    unit = "pt"
+  )
+
+  refined <- clin_row_height(house, header_leading = 0.75)
+  cfg <- refined$clinify_config$row_height
+
+  expect_equal(cfg$body, 15.35 / 72)
+  expect_equal(cfg$title, 11.4 / 72)
+  expect_equal(cfg$footnote, 11.4 / 72)
+  expect_equal(cfg$header_leading, 0.75)
+
+  # And it reaches the rendered table, which is where it bit
+  expect_equal(
+    unique(finish_table_(refined)$body$rowheights),
+    15.35 / 72
+  )
+
+  # A value named again is replaced, as it should be
+  expect_equal(
+    clin_row_height(house, body = 20)$clinify_config$row_height$body,
+    20 / 72
+  )
+})
+
+test_that("A rule set by an earlier call is not reset by a later one", {
+  # `rule` has a default, so being NULL cannot say whether the caller asked for
+  # it - and match.arg() assigns to the formal, which clears missing()
+  base <- clintable(head(mtcars[, 1:2], 2))
+
+  exact <- clin_row_height(base, body = 15.35, rule = "exact")
+  expect_equal(exact$clinify_config$row_height$rule, "exact")
+
+  # A later call that says nothing about the rule keeps it
+  expect_equal(
+    clin_row_height(exact, title = 11.4)$clinify_config$row_height$rule,
+    "exact"
+  )
+
+  # A later call that does name it wins
+  expect_equal(
+    clin_row_height(exact, title = 11.4, rule = "atleast")$clinify_config$row_height$rule,
+    "atleast"
+  )
+
+  # And a first call with no rule still gets the default
+  expect_equal(
+    clin_row_height(base, body = 15.35)$clinify_config$row_height$rule,
+    "atleast"
+  )
+})

tests/testthat/test-spanner_rule.R

@@ -428,3 +428,31 @@ test_that("The HTML preview survives a configured spanner rule", {
     clin_spanner_rule(border = officer::fp_border(style = "dashed"))
   expect_no_error(clintable_as_html(paged))
 })
+
+test_that("A second call refines the first rather than replacing it", {
+  # `border` has a default, so a later call naming only `rows` used to reset the
+  # pen back to it (#119)
+  base <- clintable(head(mtcars[, 1:3], 2)) |>
+    clin_column_headers(
+      mpg = c("Spanner", "x"),
+      cyl = c("Spanner", "y"),
+      disp = c("", "z")
+    )
+
+  dashed <- officer::fp_border(style = "dashed", width = 2)
+  refined <- clin_spanner_rule(clin_spanner_rule(base, dashed), rows = 1)
+
+  cfg <- refined$clinify_config$spanner_rule
+  expect_equal(cfg$border$style, "dashed")
+  expect_equal(cfg$border$width, 2)
+  expect_equal(cfg$rows, 1L)
+
+  # A bare first call still means "rule the spanners", and border = FALSE still
+  # means do not - "no rule" is carried as a zero width pen rather than a FALSE
+  bare <- clin_spanner_rule(base)$clinify_config$spanner_rule$border
+  expect_gt(bare$width, 0)
+
+  none <- clin_spanner_rule(base, border = FALSE)$clinify_config$spanner_rule$border
+  expect_equal(none$width, 0)
+  expect_equal(none$style, "none")
+})