diff --git a/DESCRIPTION b/DESCRIPTION index 4fa54436..91265b3b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,6 +31,7 @@ Imports: here, htmltools, rlang (>= 1.0.0), + roxygen2, shiny (>= 1.5.0), utils, yaml @@ -55,7 +56,6 @@ Suggests: remotes, renv, rmarkdown, - roxygen2, rsconnect, rstudioapi, sass, @@ -71,4 +71,4 @@ Config/testthat/edition: 3 Encoding: UTF-8 Language: en-US Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 diff --git a/NAMESPACE b/NAMESPACE index 37bd5092..58a443e0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,8 @@ # Generated by roxygen2: do not edit by hand +S3method(format,rd_section_shinyModule) +S3method(roxy_tag_parse,roxy_tag_shinyModule) +S3method(roxy_tag_rd,roxy_tag_shinyModule) export(activate_js) export(add_css_file) export(add_dockerfile) @@ -34,6 +37,7 @@ export(browser_button) export(browser_dev) export(bundle_resources) export(cat_dev) +export(check_namespace_sanity) export(create_golem) export(css_template) export(detach_all_attached) @@ -76,6 +80,7 @@ export(set_golem_name) export(set_golem_options) export(set_golem_version) export(set_golem_wd) +export(shinyModule_roclet) export(use_external_css_file) export(use_external_file) export(use_external_html_template) @@ -102,6 +107,13 @@ importFrom(attempt,stop_if_not) importFrom(attempt,without_warning) importFrom(config,get) importFrom(htmltools,htmlDependency) +importFrom(roxygen2,block_get_tag) +importFrom(roxygen2,parse_package) +importFrom(roxygen2,rd_section) +importFrom(roxygen2,roclet) +importFrom(roxygen2,roxy_tag_parse) +importFrom(roxygen2,roxy_tag_rd) +importFrom(roxygen2,tag_markdown) importFrom(shiny,addResourcePath) importFrom(shiny,getShinyOption) importFrom(shiny,htmlTemplate) @@ -112,6 +124,7 @@ importFrom(tools,file_ext) importFrom(utils,capture.output) importFrom(utils,file.edit) importFrom(utils,getFromNamespace) +importFrom(utils,getParseData) importFrom(utils,menu) importFrom(utils,modifyList) importFrom(utils,person) diff --git a/R/find_invalid_url.R b/R/find_invalid_url.R new file mode 100644 index 00000000..d297f741 --- /dev/null +++ b/R/find_invalid_url.R @@ -0,0 +1,66 @@ +#' @noRd +extract_urls_from_file <- function(file) { + content <- readLines(file, warn = FALSE) + url_pattern <- "(http|https)://[a-zA-Z0-9./?=_-]*" + urls <- unique(unlist(regmatches(content, gregexpr(url_pattern, content)))) + names(urls) <- rep(file, length(urls)) + return(urls) +} + +#' @noRd +check_url <- function(url) { + response <- try(httr::GET(url), silent = TRUE) + if (inherits(response, "try-error")) { + res <- FALSE + } + + res <- httr::status_code(response) == 200 + res <- stats::setNames(res, url) + + return(res) +} + +#' Check for the validity of the URLs in the R folder +#' +#' @param exclude a character vector of urls to exclude +#' +#' @return a message if some URLs are invalid +#' @export +check_url_validity <- function(exclude = NA_character_) { + if (!curl::has_internet()) { + cli::cli_alert_info("No internet connection.") + return(invisible(FALSE)) + } + + if (!dir.exists("R")) { + cli::cli_alert_info("No R folder found.") + return(invisible(FALSE)) + } + + urls <- purrr::map( + files, + ~ extract_urls_from_file(file = .x) + ) |> + unlist() |> + purrr::discard( + ~ .x %in% exclude + ) |> + purrr::map( + check_url + ) + + invalid_urls <- urls |> + purrr::keep( + ~ .x == FALSE + ) + + if (length(invalid_urls) > 0) { + cli::cli_alert_info("Some URLs are invalid.") + purrr::walk( + invalid_urls, + ~ cli::cli_alert_danger(sprintf("URL %s is invalid in file {.file %s}", names(.x), names(invalid_urls))) + ) + } else { + cli::cli_alert_success("All URLs are valid.") + } +} diff --git a/R/find_missing_ns.R b/R/find_missing_ns.R new file mode 100644 index 00000000..02eed311 --- /dev/null +++ b/R/find_missing_ns.R @@ -0,0 +1,206 @@ +#' @noRd +is_ns <- function(text) { + text == "ns" +} + +#' @noRd +is_shiny_input_output_funmodule <- function( + text, + extend_input_output_funmodule = NA_character_) { + stopifnot(is.character(extend_input_output_funmodule)) + + input_output_knew <- c("Input|Output|actionButton|radioButtons") + ui_funmodule_pattern <- c("mod_\\w+_ui") + + patterns <- paste( + input_output_knew, + ui_funmodule_pattern, + sep = "|" + ) + + if ( + !is.null(extend_input_output_funmodule) || + !is.na(extend_input_output_funmodule) || + extend_input_output_funmodule == "" + ) { + patterns <- paste( + patterns, + extend_input_output_funmodule, + sep = "|" + ) + } + + grepl( + pattern = patterns, + x = text + ) +} + +#' @noRd +fix_ns_in_data <- function(data) { + for (i in 1:nrow(data)) { + line_index <- data$next_line1[i] + col_start <- data$next_col1[i] + col_end <- data$next_col2[i] + file <- data$path[i] + + file_content <- readLines(file) + + line_to_modify <- file_content[line_index] + modified_line <- paste0( + substr(line_to_modify, 1, col_start - 1), + "ns(", + substr(line_to_modify, col_start, col_end), + ")", + substr(line_to_modify, col_end + 1, nchar(line_to_modify)) + ) + file_content[line_index] <- modified_line + writeLines(file_content, file) + } +} + +#' @noRd +#' @importFrom utils getParseData +check_namespace_in_file <- function( + path, + extend_input_output_funmodule = NA_character_) { + getParseData( + parse( + file = path, + keep.source = TRUE + ) + ) |> + dplyr::mutate( + path = path + ) |> + dplyr::filter( + token %in% c( + "SYMBOL_FUNCTION_CALL", + "STR_CONST" + ) + ) |> + dplyr::mutate( + is_input_output_funmodule = is_shiny_input_output_funmodule( + text = text, + extend_input_output_funmodule = extend_input_output_funmodule + ), + dplyr::across( + dplyr::starts_with("line"), + ~ dplyr::lead(.x), + .names = "next_{.col}" + ), + dplyr::across( + dplyr::starts_with("col"), + ~ dplyr::lead(.x), + .names = "next_{.col}" + ), + next_text = dplyr::lead(text), + is_followed_by_ns = is_ns(next_text) + ) |> + dplyr::filter( + is_input_output_funmodule + ) +} + +#' check namespace sanity +#' Will check if the namespace (NS) are correctly set in the shiny modules +#' +#' @param pkg Character. The package path +#' @param extend_input_output_funmodule Character. Extend the input, output or function module to check +#' @param auto_fix Logical. Fix the missing namespace automatically. Default is TRUE +#' +#' @importFrom roxygen2 parse_package block_get_tag +#' +#' @return Logical. TRUE if the namespace are correctly set, FALSE otherwise +#' +#' @export +check_namespace_sanity <- function( + pkg = golem::get_golem_wd(), + extend_input_output_funmodule = NA_character_, + auto_fix = TRUE) { + check_desc_installed() + check_cli_installed() + + base_path <- normalizePath( + path = pkg, + mustWork = TRUE + ) + + encoding <- desc::desc_get("Encoding", file = base_path)[[1]] + + if (!identical(encoding, "UTF-8")) { + warning("roxygen2 requires Encoding: UTF-8", call. = FALSE) + } + + blocks <- roxygen2::parse_package( + path = base_path, + env = NULL + ) + + shinymodule_blocks <- blocks |> + purrr::map( + .f = \(x) { + return <- roxygen2::block_get_tag(x, tag = "shinyModule") + if (is.null(return)) { + NULL + } else { + return + } + } + ) |> + purrr::compact() + + if (length(shinymodule_blocks) == 0) { + cli::cli_alert_info("No shiny module found") + return(invisible(FALSE)) + } + + shinymodule_links <- shinymodule_blocks |> + purrr::map_chr( + .f = ~ .x[["file"]] + ) |> + unique() + + data <- shinymodule_links |> + purrr::map_df( + .f = ~ check_namespace_in_file( + path = .x, + extend_input_output_funmodule = extend_input_output_funmodule + ) + ) |> + dplyr::filter( + !is_followed_by_ns + ) |> + dplyr::mutate( + message = sprintf("... see line %d in {.file %s:%d:%d}.", line1, path, line1, col1) + ) + + missing_ns_detected <- nrow(data) + + if (missing_ns_detected == 0) { + cli::cli_alert_success("NS check passed") + return(invisible(TRUE)) + } + + cli::cli_text( + "It seems that ", + cli::bg_br_yellow( + "{missing_ns_detected} namespace{?s} (NS) {?is/are} missing..." + ) + ) + + cli::cli_alert_info("We recommand to fix {?this/these} {missing_ns_detected} missing namespace{?s} before to continue...") + + purrr::walk(data$message, cli::cli_alert_danger) + + + if (isTRUE(auto_fix)) { + cli::cli_process_start("`auto_fix` is TRUE so we will fix the missing namespace") + fix_ns_in_data(data = data) + cli::cli_process_done() + } else { + return(invisible(FALSE)) + } + + return(invisible(TRUE)) +} diff --git a/R/module_roclet.R b/R/module_roclet.R new file mode 100644 index 00000000..aaef7671 --- /dev/null +++ b/R/module_roclet.R @@ -0,0 +1,36 @@ +#' @importFrom roxygen2 roxy_tag_parse +#' @importFrom roxygen2 roxy_tag_rd +NULL + +#' @importFrom roxygen2 tag_markdown +#' @export +roxy_tag_parse.roxy_tag_shinyModule <- function(x) { + tag_markdown( + x = x + ) +} + +#' @importFrom roxygen2 rd_section +#' @export +roxy_tag_rd.roxy_tag_shinyModule <- function(x, base_path, env) { + rd_section( + type = "shinyModule", + value = x$val + ) +} + +#' @export +format.rd_section_shinyModule <- function(x, ...) { + paste0( + "\\section{Shiny module}{\n", + x$value, + "\n}" + ) +} + +#' shinyModule tag +#' @importFrom roxygen2 roclet +#' @export +shinyModule_roclet <- function() { + roclet("shinyModule") +} diff --git a/R/modules_fn.R b/R/modules_fn.R index 9cba26c8..cb787b89 100644 --- a/R/modules_fn.R +++ b/R/modules_fn.R @@ -26,20 +26,19 @@ #' #' @return The path to the file, invisibly. add_module <- function( - name, - pkg = get_golem_wd(), - open = TRUE, - dir_create = TRUE, - fct = NULL, - utils = NULL, - r6 = NULL, - js = NULL, - js_handler = NULL, - export = FALSE, - module_template = golem::module_template, - with_test = FALSE, - ... - ) { + name, + pkg = get_golem_wd(), + open = TRUE, + dir_create = TRUE, + fct = NULL, + utils = NULL, + r6 = NULL, + js = NULL, + js_handler = NULL, + export = FALSE, + module_template = golem::module_template, + with_test = FALSE, + ...) { # Let's start with the checks for the validity of the name check_name_length_is_one(name) check_name_syntax(name) @@ -187,13 +186,12 @@ add_module <- function( #' @export #' @seealso [add_module()] module_template <- function( - name, - path, - export, - ph_ui = " ", - ph_server = " ", - ... - ) { + name, + path, + export, + ph_ui = " ", + ph_server = " ", + ...) { write_there <- function(...) { write(..., file = path, append = TRUE) } @@ -204,6 +202,8 @@ module_template <- function( write_there("#'") write_there("#' @param id,input,output,session Internal parameters for {shiny}.") write_there("#'") + write_there("#' @shinyModule A Golem module.") + write_there("#'") if (export) { write_there(sprintf("#' @rdname mod_%s", name)) write_there("#' @export ") @@ -274,10 +274,9 @@ module_template <- function( #' @return Used for side effect. Returns the path invisibly. #' @export use_module_test <- function( - name, - pkg = get_golem_wd(), - open = TRUE - ) { + name, + pkg = get_golem_wd(), + open = TRUE) { # Remove the extension if any name <- file_path_sans_ext(name) # Remove the "mod_" if any diff --git a/inst/shinyexample/dev/run_dev.R b/inst/shinyexample/dev/run_dev.R index 08030f44..63e5db4d 100644 --- a/inst/shinyexample/dev/run_dev.R +++ b/inst/shinyexample/dev/run_dev.R @@ -8,6 +8,12 @@ options(shiny.port = httpuv::randomPort()) golem::detach_all_attached() # rm(list=ls(all.names = TRUE)) +# Check for invalid URLs +golem::check_url_validity() + +# Check for missing namespaces +golem::check_namespace_sanity(auto_fix = TRUE) + # Document and reload your package golem::document_and_reload() diff --git a/man/check_namespace_sanity.Rd b/man/check_namespace_sanity.Rd new file mode 100644 index 00000000..694dc5ed --- /dev/null +++ b/man/check_namespace_sanity.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/find_missing_ns.R +\name{check_namespace_sanity} +\alias{check_namespace_sanity} +\title{check namespace sanity +Will check if the namespace (NS) are correctly set in the shiny modules} +\usage{ +check_namespace_sanity( + pkg = golem::get_golem_wd(), + extend_input_output_funmodule = NA_character_, + auto_fix = TRUE +) +} +\arguments{ +\item{pkg}{Character. The package path} + +\item{extend_input_output_funmodule}{Character. Extend the input, output or function module to check} + +\item{auto_fix}{Logical. Fix the missing namespace automatically. Default is TRUE} +} +\value{ +Logical. TRUE if the namespace are correctly set, FALSE otherwise +} +\description{ +check namespace sanity +Will check if the namespace (NS) are correctly set in the shiny modules +} diff --git a/man/shinyModule_roclet.Rd b/man/shinyModule_roclet.Rd new file mode 100644 index 00000000..1c67a589 --- /dev/null +++ b/man/shinyModule_roclet.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_roclet.R +\name{shinyModule_roclet} +\alias{shinyModule_roclet} +\title{shinyModule tag} +\usage{ +shinyModule_roclet() +} +\description{ +shinyModule tag +} diff --git a/tests/testthat/test-find_missing_ns.R b/tests/testthat/test-find_missing_ns.R new file mode 100644 index 00000000..63a54242 --- /dev/null +++ b/tests/testthat/test-find_missing_ns.R @@ -0,0 +1,513 @@ +test_that("check is_shiny_input_output_funmodule works", { + expect_true( + all( + is_shiny_input_output_funmodule( + text = c( + "textInput", + "textOutput", + "actionButton", + "mod_test_module_ui" + ) + ) + ) + ) + + expect_true( + all( + is_shiny_input_output_funmodule( + text = c( + "textInput", + "textOutput", + "actionButton", + "mod_test_module_ui", + "sk_select_input" + ), + extend_input_output_funmodule = "sk_select_input" + ) + ) + ) + + expect_false( + all( + is_shiny_input_output_funmodule( + text = c( + "textInput", + "textOutput", + "mod_test_module" + ) + ) + ) + ) +}) + +test_that("Check check_namespace_in_file", { + path <- tempfile(fileext = ".R") + + writeLines( + c( + "mod_test_module_ui <- function(id) {", + " ns <- NS(id)", + " tagList(", + " selectInput(", + " inputId = 'selectinput',", # Missing NS + " label = 'Select input',", + " choices = c(LETTERS[1:10])", + " ),", + " actionButton(", + " inputId = 'actionbutton',", # Missing NS + " label = 'Action button'", + " )", + " )", + "}", + "", + "mod_test_module_server <- function(id) {", + " observeEvent(input$actionbutton, {", + " message(input$actionbutton)", + " message(input$selectinput)", + " })", + "}" + ), + con = path + ) + + expect_equal( + check_namespace_in_file( + path = path, + ), + structure( + list( + line1 = c(4L, 9L), + col1 = c(5L, 5L), + line2 = c(4L, 9L), + col2 = 15:16, + id = c(32L, 89L), + parent = c(34L, 91L), + token = c( + "SYMBOL_FUNCTION_CALL", + "SYMBOL_FUNCTION_CALL" + ), + terminal = c(TRUE, TRUE), + text = c( + "selectInput", + "actionButton" + ), + path = rep(path, 2), + is_input_output_funmodule = c(TRUE, TRUE), + next_line1 = c( + 5L, + 10L + ), + next_line2 = c(5L, 10L), + next_col1 = c(17L, 17L), + next_col2 = 29:30, + next_text = c( + "'selectinput'", + "'actionbutton'" + ), + is_followed_by_ns = c(FALSE, FALSE) + ), + row.names = c(NA, -2L), + class = "data.frame" + ), + ignore_attr = TRUE + ) + + writeLines( + c( + "mod_test_module_ui <- function(id) {", + " ns <- NS(id)", + " tagList(", + " selectInput(", + " inputId = ns('selectinput'),", # NS present + " label = 'Select input',", + " choices = c(LETTERS[1:10])", + " ),", + " actionButton(", + " inputId = ns('actionbutton'),", # NS present + " label = 'Action button'", + " )", + " )", + "}", + "", + "mod_test_module_server <- function(id) {", + " observeEvent(input$actionbutton, {", + " message(input$actionbutton)", + " message(input$selectinput)", + " })", + "}" + ), + con = path + ) + + expect_equal( + check_namespace_in_file( + path = path, + ), + structure( + list( + line1 = c(4L, 9L), + col1 = c(5L, 5L), + line2 = c(4L, 9L), + col2 = 15:16, + id = c(32L, 97L), + parent = c(34L, 99L), + token = c( + "SYMBOL_FUNCTION_CALL", + "SYMBOL_FUNCTION_CALL" + ), + terminal = c(TRUE, TRUE), + text = c( + "selectInput", + "actionButton" + ), + path = rep(path, 2), + is_input_output_funmodule = c(TRUE, TRUE), + next_line1 = c(5L, 10L), + next_line2 = c(5L, 10L), + next_col1 = c(17L, 17L), + next_col2 = c(18L, 18L), + next_text = c("ns", "ns"), + is_followed_by_ns = c(TRUE, TRUE) + ), + row.names = c(NA, -2L), + class = "data.frame" + ), + ignore_attr = TRUE + ) + + writeLines( + c( + "mod_test_module_ui <- function(id) {", + " ns <- NS(id)", + " tagList(", + " sk_select_input(", + " inputId = 'selectinput',", # missing NS with custom fun + " label = 'Select input',", + " choices = c(LETTERS[1:10])", + " ),", + " mod_test_2_module_ui(", + " id = ns('actionbutton')", # NS present + " )", + " )", + "}", + "", + "mod_test_module_server <- function(id) {", + " observeEvent(input$actionbutton, {", + " message(input$actionbutton)", + " message(input$selectinput)", + " })", + "}" + ), + con = path + ) + + expect_equal( + check_namespace_in_file( + path = path + ), + structure( + list( + line1 = 9L, + col1 = 5L, + line2 = 9L, + col2 = 24L, + id = 89L, + parent = 91L, + token = "SYMBOL_FUNCTION_CALL", + terminal = TRUE, + text = "mod_test_2_module_ui", + path = path, + is_input_output_funmodule = TRUE, + next_line1 = 10L, + next_line2 = 10L, + next_col1 = 12L, + next_col2 = 13L, + next_text = "ns", + is_followed_by_ns = TRUE + ), + row.names = c(NA, -1L), + class = "data.frame" + ), + ignore_attr = TRUE + ) + + expect_equal( + check_namespace_in_file( + path = path, + extend_input_output_funmodule = "sk_select_input" + ), + structure( + list( + line1 = c(4L, 9L), + col1 = c(5L, 5L), + line2 = c(4L, 9L), + col2 = c(19L, 24L), + id = c(32L, 89L), + parent = c(34L, 91L), + token = c( + "SYMBOL_FUNCTION_CALL", + "SYMBOL_FUNCTION_CALL" + ), + terminal = c(TRUE, TRUE), + text = c( + "sk_select_input", + "mod_test_2_module_ui" + ), + path = rep(path, 2), + is_input_output_funmodule = c(TRUE, TRUE), + next_line1 = c(5L, 10L), + next_line2 = c(5L, 10L), + next_col1 = c(17L, 12L), + next_col2 = c(29L, 13L), + next_text = c( + "'selectinput'", + "ns" + ), is_followed_by_ns = c(FALSE, TRUE) + ), + row.names = c(NA, -2L), + class = "data.frame" + ), + ignore_attr = TRUE + ) +}) + +test_that("Check fix_ns_in_data works", { + path <- tempfile(fileext = ".R") + + writeLines( + c( + "mod_test_module_ui <- function(id) {", + " ns <- NS(id)", + " tagList(", + " selectInput(", + " inputId = 'selectinput',", # Missing NS + " label = 'Select input',", + " choices = c(LETTERS[1:10])", + " ),", + " actionButton(", + " inputId = 'actionbutton',", # Missing NS + " label = 'Action button'", + " )", + " )", + "}", + "", + "mod_test_module_server <- function(id) {", + " observeEvent(input$actionbutton, {", + " message(input$actionbutton)", + " message(input$selectinput)", + " })", + "}" + ), + con = path + ) + + data <- check_namespace_in_file( + path = path + ) + + fix_ns_in_data(data) + + expect_equal( + readLines(path), + c( + "mod_test_module_ui <- function(id) {", + " ns <- NS(id)", + " tagList(", + " selectInput(", + " inputId = ns('selectinput'),", # NS present + " label = 'Select input',", + " choices = c(LETTERS[1:10])", + " ),", + " actionButton(", + " inputId = ns('actionbutton'),", # NS present + " label = 'Action button'", + " )", + " )", + "}", + "", + "mod_test_module_server <- function(id) {", + " observeEvent(input$actionbutton, {", + " message(input$actionbutton)", + " message(input$selectinput)", + " })", + "}" + ) + ) +}) + +dummy_dir_check_ns <- tempfile(pattern = "dummy") +dir.create(dummy_dir_check_ns) + +withr::with_dir(dummy_dir_check_ns, { + test_that("golem is created and properly populated", { + dummy_golem_path <- file.path(dummy_dir_check_ns, "checkns") + create_golem(dummy_golem_path, open = FALSE) + + expect_message( + checkns <- check_namespace_sanity( + pkg = dummy_golem_path + ), + "No shiny module found" + ) + + expect_false(checkns) + + file.create( + file.path(dummy_golem_path, "R", "mod_test_module.R") + ) + + writeLines( + c( + "#' first UI Function", + "#'", + "#' @description A shiny Module.", + "#'", + "#' @param id,input,output,session Internal parameters for {shiny}.", + "#'", + "#' @shinyModule A Golem module.", + "#'", + "#' @importFrom shiny NS tagList", + "mod_test_module_ui <- function(id) {", + " ns <- NS(id)", + " tagList(", + " selectInput(", + " inputId = ns('selectinput'),", + " label = 'Select input',", + " choices = c(LETTERS[1:10])", + " ),", + " actionButton(", + " inputId = ns('actionbutton'),", + " label = 'Action button'", + " )", + " )", + "}", + "", + "#' first Server Functions", + "#'", + "mod_test_module_server <- function(id) {", + " moduleServer(id, function(input, output, session) {", + " ns <- session$ns", + "", + " observeEvent(input$actionbutton, {", + " message(input$actionbutton)", + " message(input$selectinput)", + " })", + " })", + "}" + ), + con = file.path(dummy_golem_path, "R", "mod_test_module.R") + ) + + devtools::document(pkg = dummy_golem_path) + + expect_message( + checkns <- check_namespace_sanity( + pkg = dummy_golem_path + ), + "NS check passed" + ) + + expect_true(checkns) + + writeLines( + c( + "#' first UI Function", + "#'", + "#' @description A shiny Module.", + "#'", + "#' @param id,input,output,session Internal parameters for {shiny}.", + "#'", + "#' @shinyModule A Golem module.", + "#'", + "#' @importFrom shiny NS tagList", + "mod_test_module_ui <- function(id) {", + " ns <- NS(id)", + " tagList(", + " selectInput(", + " inputId = 'selectinput',", + " label = 'Select input',", + " choices = c(LETTERS[1:10])", + " ),", + " actionButton(", + " inputId = ns('actionbutton'),", + " label = 'Action button'", + " )", + " )", + "}", + "", + "#' first Server Functions", + "#'", + "mod_test_module_server <- function(id) {", + " moduleServer(id, function(input, output, session) {", + " ns <- session$ns", + "", + " observeEvent(input$actionbutton, {", + " message(input$actionbutton)", + " message(input$selectinput)", + " })", + " })", + "}" + ), + con = file.path(dummy_golem_path, "R", "mod_test_module.R") + ) + + expect_message( + checkns <- check_namespace_sanity( + pkg = dummy_golem_path, + auto_fix = TRUE + ), + "It seems that..." + ) + + expect_true(checkns) + + expect_message( + checkns <- check_namespace_sanity( + pkg = dummy_golem_path + ), + "NS check passed" + ) + + expect_equal( + readLines(file.path(dummy_golem_path, "R", "mod_test_module.R")), + c( + "#' first UI Function", + "#'", + "#' @description A shiny Module.", + "#'", + "#' @param id,input,output,session Internal parameters for {shiny}.", + "#'", + "#' @shinyModule A Golem module.", + "#'", + "#' @importFrom shiny NS tagList", + "mod_test_module_ui <- function(id) {", + " ns <- NS(id)", + " tagList(", + " selectInput(", + " inputId = ns('selectinput'),", + " label = 'Select input',", + " choices = c(LETTERS[1:10])", + " ),", + " actionButton(", + " inputId = ns('actionbutton'),", + " label = 'Action button'", + " )", + " )", + "}", + "", + "#' first Server Functions", + "#'", + "mod_test_module_server <- function(id) {", + " moduleServer(id, function(input, output, session) {", + " ns <- session$ns", + "", + " observeEvent(input$actionbutton, {", + " message(input$actionbutton)", + " message(input$selectinput)", + " })", + " })", + "}" + ) + ) + }) +}) diff --git a/tests/testthat/test-module_template.R b/tests/testthat/test-module_template.R new file mode 100644 index 00000000..4ae113c3 --- /dev/null +++ b/tests/testthat/test-module_template.R @@ -0,0 +1,50 @@ +test_that("Check module_template output", { + tmp <- tempdir() + + unlink(file.path(tmp, "test.R")) + + module_template( + name = "test", + path = file.path(tmp, "test.R"), + export = TRUE + ) + + file_content <- readLines(file.path(tmp, "test.R")) + + tags <- c( + "@export", + "@shinyModule", + "@rdname mod_test" + ) + + expect_true( + sapply( + tags, + \(x) any(grepl(x, file_content)) + ) |> + all() + ) + + unlink(file.path(tmp, "test.R")) + + module_template( + name = "test", + path = file.path(tmp, "test.R"), + export = FALSE + ) + + file_content <- readLines(file.path(tmp, "test.R")) + + tags <- c( + "@noRd", + "@shinyModule" + ) + + expect_true( + sapply( + tags, + \(x) any(grepl(x, file_content)) + ) |> + all() + ) +})