Skip to content

Commit

Permalink
allow custom .md file
Browse files Browse the repository at this point in the history
  • Loading branch information
catalamarti committed Oct 28, 2024
1 parent 6da4220 commit 2124063
Show file tree
Hide file tree
Showing 3 changed files with 41 additions and 5 deletions.
11 changes: 6 additions & 5 deletions R/appStatic.R
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,6 @@ exportStaticApp <- function(result,
omopgenerics::assertCharacter(title, length = 1)
omopgenerics::assertLogical(summary, length = 1)
omopgenerics::assertCharacter(theme, length = 1, null = TRUE)
omopgenerics::assertLogical(background, length = 1)
directory <- validateDirectory(directory)
if (isTRUE(directory)) {
return(cli::cli_inform(c("i" = "{.strong shiny} folder will not be overwritten. Stopping process.")))
Expand All @@ -71,6 +70,9 @@ exportStaticApp <- function(result,
# copy the logos to the shiny folder
logo <- copyLogos(logo, directory)

# background
background <- validateBackground(background, logo)

# create ui
ui <- c(
messageShiny(),
Expand All @@ -79,7 +81,7 @@ exportStaticApp <- function(result,
logo = logo,
title = title,
summary = summary,
background = background,
background = !is.null(background),
theme = theme,
panels = panels
)
Expand Down Expand Up @@ -110,9 +112,8 @@ exportStaticApp <- function(result,

# write files in the corresponding directory
dir.create(file.path(directory, "data"), showWarnings = FALSE)
if (background) {
defaultBackground(logo) |>
writeLines(con = file.path(directory, "background.md"))
if (!is.null(background)) {
writeLines(background, con = file.path(directory, "background.md"))
}
writeLines(ui, con = file.path(directory, "ui.R"))
writeLines(server, con = file.path(directory, "server.R"))
Expand Down
21 changes: 21 additions & 0 deletions R/utilities.R
Original file line number Diff line number Diff line change
Expand Up @@ -93,3 +93,24 @@ panelNames <- function(x) {
getTitle <- function(x) {
getInfo(x, "title", formatTit(x))
}
validateBackground <- function(background, logo, call = parent.frame()) {
msg <- "'background' must be either TRUE/FALSE or a path to an existing `.md` file."
if (is.logical(background)) {
omopgenerics::assertLogical(background, length = 1, call = call, msg = msg)
if (background) {
background <- defaultBackground(logo = logo)
} else {
background <- NULL
}
} else if (is.character(background)) {
omopgenerics::assertCharacter(background, length = 1, call = call, msg = msg)
if (file.exists(background)) {
background <- readLines(background)
} else {
cli::cli_abort(message = "background file ({.path {background}}) does not exist.", call = call)
}
} else {
cli::cli_abort(message = msg, call = call)
}
return(background)
}
14 changes: 14 additions & 0 deletions tests/testthat/test-background.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,20 @@ test_that("background", {
expect_snapshot(createBackground(TRUE) |> cat(sep = "\n"))

expect_snapshot(createBackground(FALSE) |> cat(sep = "\n"))

# existing md file
backgroundFile <- tempfile(fileext = ".md")
content <- "# test\n\ncustom background"
writeLines(content, con = backgroundFile)
expect_no_error(exportStaticApp(
result = emptySummarisedResult(),
directory = tdir,
background = backgroundFile
))
background <- readLines(file.path(tdir, "shiny", "background.md"))
expect_identical(content, paste0(background, collapse = "\n"))
unlink(file.path(tdir, "shiny"), recursive = TRUE)

})

test_that("test cardFromMd", {
Expand Down

0 comments on commit 2124063

Please sign in to comment.