addition of tests for fixes to pagination

insightsengineering · Jan 9, 2024 · adb28ca · adb28ca
1 parent 8264698
commit adb28ca
Show file tree

Hide file tree

Showing 6 changed files with 99 additions and 21 deletions.
diff --git a/R/rlistings.R b/R/rlistings.R
@@ -258,21 +258,24 @@ get_keycols <- function(df) {
   names(which(sapply(df, is_keycol)))
 }
 
-#' @export
 #' @inherit formatters::matrix_form
 #' @seealso [formatters::matrix_form()]
 #' @param indent_rownames logical(1). Silently ignored, as listings do not have row names
-#' nor indenting structure.
+#'   nor indenting structure.
 #'
 #' @examples
-#'
 #' lsting <- as_listing(mtcars)
 #' mf <- matrix_form(lsting)
 #'
 #' @return a `MatrixPrintForm` object
+#'
+#' @note Parameter `expand_newlines` should always be `TRUE` for listings. We keep it for
+#'   debugging reasons.
+#'
+#' @export
 setMethod(
   "matrix_form", "listing_df",
-  rix_form <- function(obj, indent_rownames = FALSE) {
+  rix_form <- function(obj, indent_rownames = FALSE, expand_newlines = TRUE) {
     ##  we intentionally silently ignore indent_rownames because listings have
     ## no rownames, but formatters::vert_pag_indices calls matrix_form(obj, TRUE)
     ## unconditionally.
@@ -339,11 +342,11 @@ setMethod(
         ncol = ncol(fullmat)
       ),
       row_info = make_row_df(obj),
-      nlines_header = 1, ## XXX this is probably wrong!!!
+      nlines_header = 1, # We allow only one level of headers and nl expansion happens after
       nrow_header = 1,
       has_topleft = FALSE,
       has_rowlabs = FALSE,
-      expand_newlines = TRUE,
+      expand_newlines = expand_newlines,
       main_title = main_title(obj),
       subtitles = subtitles(obj),
       page_titles = page_titles(obj),

diff --git a/man/matrix_form-listing_df-method.Rd b/man/matrix_form-listing_df-method.Rd
diff --git a/tests/testthat/_snaps/paginate_listing.md b/tests/testthat/_snaps/paginate_listing.md
@@ -34,3 +34,31 @@
          AB12345-BRA-1-id-65      25    MEDIUM                       
       
 
+# pagination repeats keycols in other pages
+
+    Code
+      cat(toString(mf_pages[[3]]))
+    Output
+      a   b 
+      ——————
+      1   17
+          18
+          19
+          20
+          21
+          22
+
+---
+
+    Code
+      cat(toString(mf_pages[[3]]))
+    Output
+      a   b 
+      ——————
+          17
+          18
+          19
+          20
+          21
+          22
+
diff --git a/tests/testthat/_snaps/print.md b/tests/testthat/_snaps/print.md
@@ -136,17 +136,33 @@
     Code
       res
     Output
-       [1] "                                                      "
-       [2] "                                                      "
-       [3] "       Unique           Description          a        "
-       [4] "       Subject              Of                        "
-       [5] "     Identifier         Planned Arm          n        "
-       [6] "------------------------------------------------------"
-       [7] "AB12345-CHN-11-id-220   -             10.2627340069523"
-       [8] "                        asd                           "
-       [9] "AB12345-CHN-15-id-262   ARM #: 3      4.05546277230382"
-      [10] " AB12345-RUS-3-id-378   -             2.80323956920649"
-      [11] "                        asd                           "
-      [12] "             aaatrial   ARM #: 1      14.424933692778 "
-      [13] "                trial                                 "
+       [1] "main_title: argh"                                      
+       [2] "asr"                                                   
+       [3] "subtitle: argh"                                        
+       [4] "asr"                                                   
+       [5] "sada"                                                  
+       [6] ""                                                      
+       [7] "------------------------------------------------------"
+       [8] "                                                      "
+       [9] "                                                      "
+      [10] "       Unique           Description          a        "
+      [11] "       Subject              Of                        "
+      [12] "     Identifier         Planned Arm          n        "
+      [13] "------------------------------------------------------"
+      [14] "AB12345-CHN-11-id-220   -             10.2627340069523"
+      [15] "                        asd                           "
+      [16] "AB12345-CHN-15-id-262   ARM #: 3      4.05546277230382"
+      [17] " AB12345-RUS-3-id-378   -             2.80323956920649"
+      [18] "                        asd                           "
+      [19] "             aaatrial   ARM #: 1      14.424933692778 "
+      [20] "                trial                                 "
+      [21] "------------------------------------------------------"
+      [22] ""                                                      
+      [23] "main_footer: argh"                                     
+      [24] "asr"                                                   
+      [25] "sada"                                                  
+      [26] ""                                                      
+      [27] "prov_footer: argh"                                     
+      [28] "asr"                                                   
+      [29] "sada"                                                  
 
diff --git a/tests/testthat/test-paginate_listing.R b/tests/testthat/test-paginate_listing.R
@@ -192,6 +192,25 @@ testthat::test_that("pagination repeats keycols in other pages", {
     "AB12345-BRA-1-id-42",
     paginate_to_mpfs(lsting, lpp = 33, cpp = 550)[[2]]$strings
   )[2])
+
+  # Simplified test
+  mf_pages <- as_listing(tibble("a" = rep("1", 25), "b" = seq(25)), key_cols = "a") %>%
+    paginate_to_mpfs(lpp = 10)
+
+  expect_snapshot(cat(toString(mf_pages[[3]])))
+
+  # Warning from empty key col
+  mf_pages <- suppressWarnings(
+    expect_warning(
+      as_listing(tibble("a" = rep("", 25), "b" = seq(25)), key_cols = "a") %>%
+        paginate_to_mpfs(lpp = 10)
+      )
+    )
+
+  expect_snapshot(
+    cat(toString(mf_pages[[3]]))
+  )
+
 })
 
 testthat::test_that("defunct is defunct", {

diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R
@@ -128,6 +128,10 @@ testthat::test_that("listings support newline characters", {
       ARM = fmt_config(format = sprintf_format("ARM #: %s"), na_str = "-\nasd\n", align = "left")
     )
   )
+  main_footer(lsting) <- c("main_footer: argh\nasr", "sada\n")
+  prov_footer(lsting) <- c("prov_footer: argh\nasr", "sada\n")
+  main_title(lsting) <- "main_title: argh\nasr"
+  subtitles(lsting) <- c("subtitle: argh\nasr", "sada\n")
 
   res <- strsplit(toString(matrix_form(lsting), hsep = "-"), "\\n")[[1]]
   testthat::expect_snapshot(res)