Merge pull request #158 from OHDSI/issue_143

test cardFromMd
OHDSI · Oct 14, 2024 · 54840de · 54840de
2 parents 14e01cc + d836e26
commit 54840de
Show file tree

Hide file tree

Showing 4 changed files with 43 additions and 4 deletions.
diff --git a/R/summary.R b/R/summary.R
@@ -46,12 +46,22 @@ resultOverview <- function(result){
 
   # present result_types
   resultTypes <- unique(sets$result_type)
-  s2 <- "- Results contain **{num(length(resultTypes))}** different result types: `{glue::glue_collapse(resultTypes, sep = '`, `', last = '` and `')}`." |>
+  rTypes <- ifelse(
+    length(resultTypes) == 0,
+    ".",
+    glue::glue(": `{glue::glue_collapse(resultTypes, sep = '`, `', last = '` and `')}`.")
+  )
+  s2 <- "- Results contain **{num(length(resultTypes))}** different result types{rTypes}" |>
     glue::glue()
 
   # present cdm names
   cdmNames <- unique(result$cdm_name)
-  s3 <- "- Results contain data from **{num(length(cdmNames))}** different cdm objects: \"*{glue::glue_collapse(cdmNames, sep = '*\", \"*', last = '*\" and \"*')}*\"." |>
+  cNames <- ifelse(
+    length(cdmNames) == 0,
+    ".",
+    glue::glue(": \"*{glue::glue_collapse(cdmNames, sep = '*\", \"*', last = '*\" and \"*')}*\".")
+  )
+  s3 <- "- Results contain data from **{num(length(cdmNames))}** different cdm objects{cNames}" |>
     glue::glue()
 
   c("### Result overview", s1, s2, s3)

diff --git a/tests/testthat/_snaps/background.md b/tests/testthat/_snaps/background.md
@@ -16,3 +16,17 @@
     Output
       
 
+# test cardFromMd
+
+    Code
+      cat(as.character(bkg))
+    Output
+      <div class="card bslib-card bslib-mb-spacing html-fill-item html-fill-container" data-bslib-card-init data-require-bs-caller="card()" data-require-bs-version="5">
+        <div class="card-header">This is the header of the background</div>
+        <div class="card-body bslib-gap-spacing html-fill-item html-fill-container" style="margin-top:auto;margin-bottom:auto;flex:1 1 auto;"><h1 id="title">Title</h1>
+      <h2 id="subtitle">subtitle</h2>
+      <p>content</p>
+      </div>
+        <script data-bslib-card-init>bslib.Card.initializeAllCards();</script>
+      </div>
+
diff --git a/tests/testthat/_snaps/summary.md b/tests/testthat/_snaps/summary.md
@@ -9,8 +9,8 @@
           <h3>Result overview</h3>
       <ul>
       <li>Results contain <strong>0</strong> rows with <strong>0</strong> different result_ids.</li>
-      <li>Results contain <strong>0</strong> different result types: ``.</li>
-      <li>Results contain data from <strong>0</strong> different cdm objects: &quot;**&quot;.</li>
+      <li>Results contain <strong>0</strong> different result types.</li>
+      <li>Results contain data from <strong>0</strong> different cdm objects.</li>
       </ul>
       <h3>Package versions</h3>
       <h3>Result suppression</h3>

diff --git a/tests/testthat/test-background.R b/tests/testthat/test-background.R
@@ -18,3 +18,18 @@ test_that("background", {
 
   expect_snapshot(createBackground(FALSE) |> cat(sep = "\n"))
 })
+
+test_that("test cardFromMd", {
+  tfile <- tempfile(fileext = ".md")
+  def <- defaultBackground()
+  writeLines(def, con = tfile)
+
+  expect_no_error(bkg <- cardFromMd(tfile))
+  expect_true(inherits(bkg, "bslib_fragment"))
+  expect_snapshot(bkg |> as.character() |> cat())
+
+  expect_warning(nobkg <- cardFromMd("not file"))
+  expect_identical(nobkg, bslib::card())
+
+  unlink(tfile)
+})