From e0a72d1f9e7c84eba4b9cc906ef6f5c7499dbb96 Mon Sep 17 00:00:00 2001 From: narayanan-iyer-pfizer <114721252+narayanan-iyer-pfizer@users.noreply.github.com> Date: Wed, 14 Feb 2024 00:09:07 +0530 Subject: [PATCH 01/12] refactor code by using archive library to read package tarballs in memory --- DESCRIPTION | 3 +- NAMESPACE | 2 ++ R/app_server.R | 19 +++--------- R/mod_code_explorer.R | 58 +++++++++++++++++++++++++------------ R/mod_code_explorer_utils.R | 44 +++++++++++++++++++--------- R/mod_pkg_explorer.R | 22 ++++++++++---- 6 files changed, 95 insertions(+), 53 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6b0876a73..c920913fa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -67,7 +67,8 @@ Imports: shinyWidgets, stringr, shinyAce, - sortable + sortable, + archive Suggests: chromote (>= 0.1.1.9001), fontawesome, diff --git a/NAMESPACE b/NAMESPACE index d902838a7..d7a9446cb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,8 @@ importFrom(DT,selectRows) importFrom(DT,styleEqual) importFrom(RSQLite,SQLite) importFrom(RSQLite,sqliteCopyDatabase) +importFrom(archive,archive) +importFrom(archive,archive_read) importFrom(bslib,bs_theme) importFrom(cranlogs,cran_downloads) importFrom(desc,desc_fields) diff --git a/R/app_server.R b/R/app_server.R index 616e9091c..7ac012253 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -224,35 +224,24 @@ app_server <- function(input, output, session) { }) create_src_dir <- eventReactive(input$tabs, input$tabs == "Source Explorer") - pkgdir <- reactiveVal() + pkgarchive <- reactiveVal() observe({ req(selected_pkg$name() != "-") req(create_src_dir()) req(file.exists(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")))) - - src_dir <- file.path("source", selected_pkg$name()) - if (dir.exists(src_dir)) { - pkgdir(src_dir) - } else { - withProgress( - utils::untar(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), exdir = "source"), - message = glue::glue("Unpacking {selected_pkg$name()}_{selected_pkg$version()}.tar.gz"), - value = 1 - ) - pkgdir(src_dir) - } + pkgarchive(archive::archive(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")))) }) %>% bindEvent(selected_pkg$name(), create_src_dir()) mod_pkg_explorer_server("pkg_explorer", selected_pkg, - pkgdir = pkgdir, + pkgarchive = pkgarchive, creating_dir = create_src_dir, user = user, credentials = credential_config) mod_code_explorer_server("code_explorer", selected_pkg, - pkgdir = pkgdir, + pkgarchive = pkgarchive, creating_dir = create_src_dir, user = user, credentials = credential_config) diff --git a/R/mod_code_explorer.R b/R/mod_code_explorer.R index 436a4ca4e..a30dea443 100644 --- a/R/mod_code_explorer.R +++ b/R/mod_code_explorer.R @@ -11,14 +11,14 @@ mod_code_explorer_ui <- function(id){ ns <- NS(id) uiOutput(ns("func_explorer_ui")) } - #' code_explorer Server Functions #' #' @noRd #' #' @importFrom tools Rd2HTML #' @importFrom purrr map_dfr -mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), creating_dir = reactiveVal(TRUE), user, credentials){ +#' @importFrom archive archive_read archive +mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(), creating_dir = reactiveVal(TRUE), user, credentials){ moduleServer( id, function(input, output, session){ ns <- session$ns @@ -79,14 +79,15 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c } }) - exported_functions <- eventReactive(pkgdir(), { - get_exported_functions(pkgdir()) + exported_functions <- eventReactive(pkgarchive(), { + get_exported_functions(pkgarchive,selected_pkg) }) parse_data <- eventReactive(exported_functions(), { + purrr::map_dfr( c("test", "source"), - ~ get_parse_data(.x, pkgdir(), exported_functions()) + ~ get_parse_data(.x, pkgarchive, selected_pkg,exported_functions()) ) }) @@ -96,26 +97,36 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c observeEvent(input$exported_function, { req(input$exported_function) test_files(get_files(input$exported_function, "test", parse_data())) - updateSelectInput(session, "test_files", choices = test_files(), - selected = if (!rlang::is_empty(test_files())) test_files()[1] else NULL) + updateSelectInput(session, "test_files", choices = basename(test_files()), + selected = if (!rlang::is_empty(test_files())) basename(test_files())[1] else NULL) source_files(get_files(input$exported_function, "source", parse_data())) - updateSelectInput(session, "source_files", choices = source_files(), - selected = if (!rlang::is_empty(source_files())) source_files()[1] else NULL) + updateSelectInput(session, "source_files", choices = basename(source_files()), + selected = if (!rlang::is_empty(source_files())) basename(source_files())[1] else NULL) - man_files(get_files(input$exported_function, "man", pkgdir())) - updateSelectInput(session, "man_files", choices = man_files(), - selected = if (!rlang::is_empty(man_files())) man_files()[1] else NULL) + man_files(get_files(input$exported_function, "man", pkgarchive,selected_pkg)) + updateSelectInput(session, "man_files", choices = basename(man_files()), + selected = if (!rlang::is_empty(man_files())) basename(man_files())[1] else NULL) }) test_code <- reactive({ if (rlang::is_empty(test_files())) return(HTML("No files to display")) req(input$test_files) - fp <- if (file.exists(file.path(pkgdir(), "tests", "testthat.R"))) file.path(pkgdir(), "tests", "testthat", input$test_files) else file.path(pkgdir(), "tests", input$test_files) - lines <- readLines(fp) + if (file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat.R") %in% pkgarchive()$path ) + { + fp <- file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat",input$test_files)} + else + { + fp <- file.path(glue::glue("{selected_pkg$name()}"),"tests",input$test_files) + } + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = fp) + lines <- readLines(con) + close(con) func_list <- c(input$exported_function, paste0("`", input$exported_function, "`")) highlight_index <- parse_data() %>% - filter(file == input$test_files & func %in% func_list) %>% + filter(stringr::str_ends(file,input$test_files) & func %in% func_list) %>% pull(line) renderCode(lines, highlight_index) }) %>% @@ -124,10 +135,15 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c source_code <- reactive({ if (rlang::is_empty(source_files())) return(HTML("No files to display")) req(input$source_files) - lines <- readLines(file.path(pkgdir(), "R", input$source_files)) + fp <- file.path(glue::glue("{selected_pkg$name()}"),"R", input$source_files) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = fp) + lines <- readLines(con) + close(con) func_list <- c(input$exported_function, paste0("`", input$exported_function, "`")) highlight_index <- parse_data() %>% - filter(file == input$source_files & func %in% func_list) %>% + filter(stringr::str_ends(file,input$source_files) & func %in% func_list) %>% pull(line) renderCode(lines, highlight_index) }) %>% @@ -137,7 +153,13 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c if (rlang::is_empty(man_files())) return(HTML("No files to display")) req(input$man_files) out_dir <- tempdir() - tools::Rd2HTML(file.path(pkgdir(), "man", input$man_files), package = c(selected_pkg$name(), selected_pkg$version()), out = file.path(out_dir, "man.html")) + fp <- file.path(glue::glue("{selected_pkg$name()}"), "man", input$man_files) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = fp) + Rdfile <-tools::parse_Rd(con) + close(con) + tools::Rd2HTML(Rdfile, package = c(selected_pkg$name(), selected_pkg$version()), out = file.path(out_dir, "man.html")) includeHTML(file.path(out_dir, "man.html")) }) %>% bindEvent(input$man_files, input$exported_function, ignoreNULL = FALSE) diff --git a/R/mod_code_explorer_utils.R b/R/mod_code_explorer_utils.R index f45d3e706..87c0a071a 100644 --- a/R/mod_code_explorer_utils.R +++ b/R/mod_code_explorer_utils.R @@ -2,14 +2,18 @@ #' #' Scrapes NAMESPACE for exported functions and returns them as a list #' -#' @param pkgdir The package directory to evaluate +#' @param pkgArchive The package directory to evaluate #' #' @return A character vector of the function names #' #' @noRd -get_exported_functions <- function(pkgdir) { - nsFile <- parse(file.path(pkgdir, "NAMESPACE"), keep.source = FALSE, srcfile = NULL) +get_exported_functions <- function(pkgArchive,selected_pkg ) { + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = glue::glue("{selected_pkg$name()}/NAMESPACE")) + nsFile <- parse(con,keep.source = TRUE) nsexp <- character(); nsimp <- character() + close(con) for (e in nsFile) { switch (as.character(e[[1L]]), export = { @@ -28,7 +32,7 @@ get_exported_functions <- function(pkgdir) { #' Parses the files to determine which contain the function(s) of interest #' #' @param type The type of files to parse -#' @param pkgdir The package directory +#' @param pkgArchive The package directory #' @param funcnames The list of functions to evaluate #' #' @return A `tibble` object containing the type of file, file name, function, @@ -37,17 +41,25 @@ get_exported_functions <- function(pkgdir) { #' @noRd #' #' @importFrom utils getParseData -get_parse_data <- function(type = c("test", "source"), pkgdir, funcnames = NULL) { +get_parse_data <- function(type = c("test", "source"), pkgarchive ,selected_pkg, funcnames = NULL) { + type <- match.arg(type) dirpath <- switch (type, - test = if (file.exists(file.path(pkgdir, "tests", "testthat.R"))) file.path(pkgdir, "tests", "testthat") else file.path(pkgdir, "tests"), - source = file.path(pkgdir, "R") + test = if (file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat.R") %in% pkgarchive()$path ){ + file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat") } + else { file.path(glue::glue("{selected_pkg$name()}"),"tests") } + , + source = file.path(glue::glue("{selected_pkg$name()}"),"R") ) - filenames <- list.files(dirpath, ".+\\.[R|r]$") + filenames <- na.omit((str_extract(pkgarchive()$path,paste0(dirpath,".+\\.[R|r]$")))) dplyr::bind_rows(lapply(filenames, function(filename) { - d <- parse(file.path(dirpath, filename), keep.source = TRUE) %>% + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = filename) + d <- parse( text =readLines(con)) %>% utils::getParseData() %>% dplyr::filter(token %in% c("SYMBOL_FUNCTION_CALL", "SYMBOL", "SPECIAL", "STR_CONST")) + close(con) d <- d %>% dplyr::mutate( type = type, @@ -91,6 +103,7 @@ get_test_files <- function(funcname, parse_data) { #' #' @noRd get_source_files <- function(funcname, parse_data) { + #browser() func_list <- c(funcname, paste0("`", funcname, "`")) parse_data %>% dplyr::filter(type == "source", @@ -104,17 +117,22 @@ get_source_files <- function(funcname, parse_data) { #' Returns the man files from the package directory corresponding to the function of interest #' #' @param funcname The name of the function to evaluate -#' @param pkgdir The package directory +#' @param pkgArchive The package directory #' #' @noRd -get_man_files <- function(funcname, pkgdir) { - man_files <- list.files(file.path(pkgdir, "man"), ".+\\.Rd$") +get_man_files <- function(funcname, pkgarchive,selected_pkg ) { + man_files <- na.omit((str_extract(pkgarchive()$path, + paste(glue::glue("{selected_pkg$name()}"),"man",".+\\.Rd$",sep ="/")))) funcname_regex <- gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", funcname) %>% gsub(pattern = "`", replacement = "`?") %>% gsub(pattern = "\\%", replacement = "\\\\\\\\\\%") i <- sapply(man_files, function(f) { - s <- readLines(file.path(pkgdir, "man", f)) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = f) + s <- readLines(con) + close(con) any(grepl(sprintf("name\\{%s\\}|alias\\{%s\\}", funcname_regex, funcname_regex), s)) }) man_files[i] diff --git a/R/mod_pkg_explorer.R b/R/mod_pkg_explorer.R index e5b62ad21..a3d95180f 100644 --- a/R/mod_pkg_explorer.R +++ b/R/mod_pkg_explorer.R @@ -18,12 +18,13 @@ mod_pkg_explorer_ui <- function(id){ #' @importFrom shinyAce updateAceEditor #' @importFrom utils untar #' @importFrom shinyTree shinyTree renderTree updateTree get_selected +#' @importFrom archive archive_read archive #' #' @noRd mod_pkg_explorer_server <- function(id, selected_pkg, accepted_extensions = c("r", "rmd", "rd", "txt", "md","csv", "tsv", "json", "xml", "yaml", "yml", "dcf", "html", "js", "css", "c", "cpp", "h", "java", "scala", "py", "perl", "sh", "sql"), accepted_filenames = c("DESCRIPTION", "NAMESPACE", "LICENSE", "LICENSE.note", "NEWS", "README", "CHANGES", "MD5"), - pkgdir = reactiveVal(), + pkgarchive = reactiveVal(), creating_dir = reactiveVal(TRUE), user, credentials) { moduleServer( id, function(input, output, session){ @@ -31,7 +32,6 @@ mod_pkg_explorer_server <- function(id, selected_pkg, output$pkg_explorer_ui <- renderUI({ - # Lets the user know that a package needs to be selected. if(identical(selected_pkg$name(), character(0))) { showHelperMessage() @@ -84,8 +84,13 @@ mod_pkg_explorer_server <- function(id, selected_pkg, bindEvent(selected_pkg$name(), creating_dir()) nodes <- reactive({ - req(pkgdir()) - s <- make_nodes(list.files(pkgdir(), recursive = TRUE)) + req(pkgarchive()) + s <- pkgarchive() %>% + filter(size > 0) %>% + filter(grepl("/",path)) %>% + dplyr::pull(path) %>% + make_nodes() %>% + .[[1]] if(!is.null(s[["DESCRIPTION"]])){ attr(s[["DESCRIPTION"]],"stselected") = TRUE } @@ -93,9 +98,10 @@ mod_pkg_explorer_server <- function(id, selected_pkg, f <- names(head(purrr::keep(s, \(x) !is.null(attr(x, "sttype"))), 1)) attr(s[[f]],"stselected") = TRUE } + s }) %>% - bindEvent(pkgdir(), selected_pkg$name()) + bindEvent(pkgarchive (), selected_pkg$name()) output$dirtree <- shinyTree::renderTree(nodes()) @@ -117,7 +123,11 @@ mod_pkg_explorer_server <- function(id, selected_pkg, filename <- basename(filepath) e <- tolower(tools::file_ext(filepath)) if (e %in% accepted_extensions || filename %in% accepted_filenames) { - s <- readLines(file.path(pkgdir(), filepath)) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = glue::glue("{selected_pkg$name()}/{filepath}")) + s <- readLines(con) + close(con) s <- paste(s, collapse = "\n") } else { s <- "file format not supported" From 8a58bcc322ee9e8556f1a7c894078169d3001e67 Mon Sep 17 00:00:00 2001 From: narayanan-iyer-pfizer <114721252+narayanan-iyer-pfizer@users.noreply.github.com> Date: Wed, 14 Feb 2024 00:09:07 +0530 Subject: [PATCH 02/12] refactor code by using archive library to read package tarballs in memory --- DESCRIPTION | 5 ++-- NAMESPACE | 2 ++ NEWS.md | 1 + R/app_server.R | 19 +++--------- R/mod_code_explorer.R | 58 +++++++++++++++++++++++++------------ R/mod_code_explorer_utils.R | 44 +++++++++++++++++++--------- R/mod_pkg_explorer.R | 22 ++++++++++---- 7 files changed, 97 insertions(+), 54 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6b0876a73..6879bde26 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: riskassessment Title: A web app designed to interface with the `riskmetric` package -Version: 3.0.0.9008 +Version: 3.0.0.9009 Authors@R: c( person("Aaron", "Clark", role = c("aut", "cre"), email = "aaron.clark@biogen.com"), person("Robert", "Krajcik", role = "aut", email = "robert.krajcik@biogen.com"), @@ -67,7 +67,8 @@ Imports: shinyWidgets, stringr, shinyAce, - sortable + sortable, + archive Suggests: chromote (>= 0.1.1.9001), fontawesome, diff --git a/NAMESPACE b/NAMESPACE index d902838a7..d7a9446cb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,8 @@ importFrom(DT,selectRows) importFrom(DT,styleEqual) importFrom(RSQLite,SQLite) importFrom(RSQLite,sqliteCopyDatabase) +importFrom(archive,archive) +importFrom(archive,archive_read) importFrom(bslib,bs_theme) importFrom(cranlogs,cran_downloads) importFrom(desc,desc_fields) diff --git a/NEWS.md b/NEWS.md index fd38151f0..2502829fe 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,7 @@ * Fix typo in Privileges table (#719) * Fixed bug where HTML reports displayed a darker green in the cards' meters * Only run configuration checkers when configuring the database +* Shorten waiting time in code explorer/package explorer by reading tarballs in memory(#707) # riskassessment 3.0.0 diff --git a/R/app_server.R b/R/app_server.R index 616e9091c..7ac012253 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -224,35 +224,24 @@ app_server <- function(input, output, session) { }) create_src_dir <- eventReactive(input$tabs, input$tabs == "Source Explorer") - pkgdir <- reactiveVal() + pkgarchive <- reactiveVal() observe({ req(selected_pkg$name() != "-") req(create_src_dir()) req(file.exists(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")))) - - src_dir <- file.path("source", selected_pkg$name()) - if (dir.exists(src_dir)) { - pkgdir(src_dir) - } else { - withProgress( - utils::untar(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), exdir = "source"), - message = glue::glue("Unpacking {selected_pkg$name()}_{selected_pkg$version()}.tar.gz"), - value = 1 - ) - pkgdir(src_dir) - } + pkgarchive(archive::archive(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")))) }) %>% bindEvent(selected_pkg$name(), create_src_dir()) mod_pkg_explorer_server("pkg_explorer", selected_pkg, - pkgdir = pkgdir, + pkgarchive = pkgarchive, creating_dir = create_src_dir, user = user, credentials = credential_config) mod_code_explorer_server("code_explorer", selected_pkg, - pkgdir = pkgdir, + pkgarchive = pkgarchive, creating_dir = create_src_dir, user = user, credentials = credential_config) diff --git a/R/mod_code_explorer.R b/R/mod_code_explorer.R index 436a4ca4e..a30dea443 100644 --- a/R/mod_code_explorer.R +++ b/R/mod_code_explorer.R @@ -11,14 +11,14 @@ mod_code_explorer_ui <- function(id){ ns <- NS(id) uiOutput(ns("func_explorer_ui")) } - #' code_explorer Server Functions #' #' @noRd #' #' @importFrom tools Rd2HTML #' @importFrom purrr map_dfr -mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), creating_dir = reactiveVal(TRUE), user, credentials){ +#' @importFrom archive archive_read archive +mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(), creating_dir = reactiveVal(TRUE), user, credentials){ moduleServer( id, function(input, output, session){ ns <- session$ns @@ -79,14 +79,15 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c } }) - exported_functions <- eventReactive(pkgdir(), { - get_exported_functions(pkgdir()) + exported_functions <- eventReactive(pkgarchive(), { + get_exported_functions(pkgarchive,selected_pkg) }) parse_data <- eventReactive(exported_functions(), { + purrr::map_dfr( c("test", "source"), - ~ get_parse_data(.x, pkgdir(), exported_functions()) + ~ get_parse_data(.x, pkgarchive, selected_pkg,exported_functions()) ) }) @@ -96,26 +97,36 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c observeEvent(input$exported_function, { req(input$exported_function) test_files(get_files(input$exported_function, "test", parse_data())) - updateSelectInput(session, "test_files", choices = test_files(), - selected = if (!rlang::is_empty(test_files())) test_files()[1] else NULL) + updateSelectInput(session, "test_files", choices = basename(test_files()), + selected = if (!rlang::is_empty(test_files())) basename(test_files())[1] else NULL) source_files(get_files(input$exported_function, "source", parse_data())) - updateSelectInput(session, "source_files", choices = source_files(), - selected = if (!rlang::is_empty(source_files())) source_files()[1] else NULL) + updateSelectInput(session, "source_files", choices = basename(source_files()), + selected = if (!rlang::is_empty(source_files())) basename(source_files())[1] else NULL) - man_files(get_files(input$exported_function, "man", pkgdir())) - updateSelectInput(session, "man_files", choices = man_files(), - selected = if (!rlang::is_empty(man_files())) man_files()[1] else NULL) + man_files(get_files(input$exported_function, "man", pkgarchive,selected_pkg)) + updateSelectInput(session, "man_files", choices = basename(man_files()), + selected = if (!rlang::is_empty(man_files())) basename(man_files())[1] else NULL) }) test_code <- reactive({ if (rlang::is_empty(test_files())) return(HTML("No files to display")) req(input$test_files) - fp <- if (file.exists(file.path(pkgdir(), "tests", "testthat.R"))) file.path(pkgdir(), "tests", "testthat", input$test_files) else file.path(pkgdir(), "tests", input$test_files) - lines <- readLines(fp) + if (file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat.R") %in% pkgarchive()$path ) + { + fp <- file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat",input$test_files)} + else + { + fp <- file.path(glue::glue("{selected_pkg$name()}"),"tests",input$test_files) + } + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = fp) + lines <- readLines(con) + close(con) func_list <- c(input$exported_function, paste0("`", input$exported_function, "`")) highlight_index <- parse_data() %>% - filter(file == input$test_files & func %in% func_list) %>% + filter(stringr::str_ends(file,input$test_files) & func %in% func_list) %>% pull(line) renderCode(lines, highlight_index) }) %>% @@ -124,10 +135,15 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c source_code <- reactive({ if (rlang::is_empty(source_files())) return(HTML("No files to display")) req(input$source_files) - lines <- readLines(file.path(pkgdir(), "R", input$source_files)) + fp <- file.path(glue::glue("{selected_pkg$name()}"),"R", input$source_files) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = fp) + lines <- readLines(con) + close(con) func_list <- c(input$exported_function, paste0("`", input$exported_function, "`")) highlight_index <- parse_data() %>% - filter(file == input$source_files & func %in% func_list) %>% + filter(stringr::str_ends(file,input$source_files) & func %in% func_list) %>% pull(line) renderCode(lines, highlight_index) }) %>% @@ -137,7 +153,13 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c if (rlang::is_empty(man_files())) return(HTML("No files to display")) req(input$man_files) out_dir <- tempdir() - tools::Rd2HTML(file.path(pkgdir(), "man", input$man_files), package = c(selected_pkg$name(), selected_pkg$version()), out = file.path(out_dir, "man.html")) + fp <- file.path(glue::glue("{selected_pkg$name()}"), "man", input$man_files) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = fp) + Rdfile <-tools::parse_Rd(con) + close(con) + tools::Rd2HTML(Rdfile, package = c(selected_pkg$name(), selected_pkg$version()), out = file.path(out_dir, "man.html")) includeHTML(file.path(out_dir, "man.html")) }) %>% bindEvent(input$man_files, input$exported_function, ignoreNULL = FALSE) diff --git a/R/mod_code_explorer_utils.R b/R/mod_code_explorer_utils.R index f45d3e706..87c0a071a 100644 --- a/R/mod_code_explorer_utils.R +++ b/R/mod_code_explorer_utils.R @@ -2,14 +2,18 @@ #' #' Scrapes NAMESPACE for exported functions and returns them as a list #' -#' @param pkgdir The package directory to evaluate +#' @param pkgArchive The package directory to evaluate #' #' @return A character vector of the function names #' #' @noRd -get_exported_functions <- function(pkgdir) { - nsFile <- parse(file.path(pkgdir, "NAMESPACE"), keep.source = FALSE, srcfile = NULL) +get_exported_functions <- function(pkgArchive,selected_pkg ) { + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = glue::glue("{selected_pkg$name()}/NAMESPACE")) + nsFile <- parse(con,keep.source = TRUE) nsexp <- character(); nsimp <- character() + close(con) for (e in nsFile) { switch (as.character(e[[1L]]), export = { @@ -28,7 +32,7 @@ get_exported_functions <- function(pkgdir) { #' Parses the files to determine which contain the function(s) of interest #' #' @param type The type of files to parse -#' @param pkgdir The package directory +#' @param pkgArchive The package directory #' @param funcnames The list of functions to evaluate #' #' @return A `tibble` object containing the type of file, file name, function, @@ -37,17 +41,25 @@ get_exported_functions <- function(pkgdir) { #' @noRd #' #' @importFrom utils getParseData -get_parse_data <- function(type = c("test", "source"), pkgdir, funcnames = NULL) { +get_parse_data <- function(type = c("test", "source"), pkgarchive ,selected_pkg, funcnames = NULL) { + type <- match.arg(type) dirpath <- switch (type, - test = if (file.exists(file.path(pkgdir, "tests", "testthat.R"))) file.path(pkgdir, "tests", "testthat") else file.path(pkgdir, "tests"), - source = file.path(pkgdir, "R") + test = if (file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat.R") %in% pkgarchive()$path ){ + file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat") } + else { file.path(glue::glue("{selected_pkg$name()}"),"tests") } + , + source = file.path(glue::glue("{selected_pkg$name()}"),"R") ) - filenames <- list.files(dirpath, ".+\\.[R|r]$") + filenames <- na.omit((str_extract(pkgarchive()$path,paste0(dirpath,".+\\.[R|r]$")))) dplyr::bind_rows(lapply(filenames, function(filename) { - d <- parse(file.path(dirpath, filename), keep.source = TRUE) %>% + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = filename) + d <- parse( text =readLines(con)) %>% utils::getParseData() %>% dplyr::filter(token %in% c("SYMBOL_FUNCTION_CALL", "SYMBOL", "SPECIAL", "STR_CONST")) + close(con) d <- d %>% dplyr::mutate( type = type, @@ -91,6 +103,7 @@ get_test_files <- function(funcname, parse_data) { #' #' @noRd get_source_files <- function(funcname, parse_data) { + #browser() func_list <- c(funcname, paste0("`", funcname, "`")) parse_data %>% dplyr::filter(type == "source", @@ -104,17 +117,22 @@ get_source_files <- function(funcname, parse_data) { #' Returns the man files from the package directory corresponding to the function of interest #' #' @param funcname The name of the function to evaluate -#' @param pkgdir The package directory +#' @param pkgArchive The package directory #' #' @noRd -get_man_files <- function(funcname, pkgdir) { - man_files <- list.files(file.path(pkgdir, "man"), ".+\\.Rd$") +get_man_files <- function(funcname, pkgarchive,selected_pkg ) { + man_files <- na.omit((str_extract(pkgarchive()$path, + paste(glue::glue("{selected_pkg$name()}"),"man",".+\\.Rd$",sep ="/")))) funcname_regex <- gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", funcname) %>% gsub(pattern = "`", replacement = "`?") %>% gsub(pattern = "\\%", replacement = "\\\\\\\\\\%") i <- sapply(man_files, function(f) { - s <- readLines(file.path(pkgdir, "man", f)) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = f) + s <- readLines(con) + close(con) any(grepl(sprintf("name\\{%s\\}|alias\\{%s\\}", funcname_regex, funcname_regex), s)) }) man_files[i] diff --git a/R/mod_pkg_explorer.R b/R/mod_pkg_explorer.R index e5b62ad21..a3d95180f 100644 --- a/R/mod_pkg_explorer.R +++ b/R/mod_pkg_explorer.R @@ -18,12 +18,13 @@ mod_pkg_explorer_ui <- function(id){ #' @importFrom shinyAce updateAceEditor #' @importFrom utils untar #' @importFrom shinyTree shinyTree renderTree updateTree get_selected +#' @importFrom archive archive_read archive #' #' @noRd mod_pkg_explorer_server <- function(id, selected_pkg, accepted_extensions = c("r", "rmd", "rd", "txt", "md","csv", "tsv", "json", "xml", "yaml", "yml", "dcf", "html", "js", "css", "c", "cpp", "h", "java", "scala", "py", "perl", "sh", "sql"), accepted_filenames = c("DESCRIPTION", "NAMESPACE", "LICENSE", "LICENSE.note", "NEWS", "README", "CHANGES", "MD5"), - pkgdir = reactiveVal(), + pkgarchive = reactiveVal(), creating_dir = reactiveVal(TRUE), user, credentials) { moduleServer( id, function(input, output, session){ @@ -31,7 +32,6 @@ mod_pkg_explorer_server <- function(id, selected_pkg, output$pkg_explorer_ui <- renderUI({ - # Lets the user know that a package needs to be selected. if(identical(selected_pkg$name(), character(0))) { showHelperMessage() @@ -84,8 +84,13 @@ mod_pkg_explorer_server <- function(id, selected_pkg, bindEvent(selected_pkg$name(), creating_dir()) nodes <- reactive({ - req(pkgdir()) - s <- make_nodes(list.files(pkgdir(), recursive = TRUE)) + req(pkgarchive()) + s <- pkgarchive() %>% + filter(size > 0) %>% + filter(grepl("/",path)) %>% + dplyr::pull(path) %>% + make_nodes() %>% + .[[1]] if(!is.null(s[["DESCRIPTION"]])){ attr(s[["DESCRIPTION"]],"stselected") = TRUE } @@ -93,9 +98,10 @@ mod_pkg_explorer_server <- function(id, selected_pkg, f <- names(head(purrr::keep(s, \(x) !is.null(attr(x, "sttype"))), 1)) attr(s[[f]],"stselected") = TRUE } + s }) %>% - bindEvent(pkgdir(), selected_pkg$name()) + bindEvent(pkgarchive (), selected_pkg$name()) output$dirtree <- shinyTree::renderTree(nodes()) @@ -117,7 +123,11 @@ mod_pkg_explorer_server <- function(id, selected_pkg, filename <- basename(filepath) e <- tolower(tools::file_ext(filepath)) if (e %in% accepted_extensions || filename %in% accepted_filenames) { - s <- readLines(file.path(pkgdir(), filepath)) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = glue::glue("{selected_pkg$name()}/{filepath}")) + s <- readLines(con) + close(con) s <- paste(s, collapse = "\n") } else { s <- "file format not supported" From 55f7a6e040f406cf05e0cd57a3b7fb8d2ef16c6a Mon Sep 17 00:00:00 2001 From: narayanan-iyer-pfizer <114721252+narayanan-iyer-pfizer@users.noreply.github.com> Date: Wed, 14 Feb 2024 00:09:07 +0530 Subject: [PATCH 03/12] refactor code by using archive library to read package tarballs in memory --- DESCRIPTION | 5 ++-- NAMESPACE | 2 ++ NEWS.md | 1 + R/app_server.R | 19 +++--------- R/mod_code_explorer.R | 58 +++++++++++++++++++++++++------------ R/mod_code_explorer_utils.R | 44 +++++++++++++++++++--------- R/mod_pkg_explorer.R | 22 ++++++++++---- 7 files changed, 97 insertions(+), 54 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c907ebf78..2ebaf0648 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: riskassessment Title: A web app designed to interface with the `riskmetric` package -Version: 3.0.0.9012 +Version: 3.0.0.9013 Authors@R: c( person("Aaron", "Clark", role = c("aut", "cre"), email = "aaron.clark@biogen.com"), person("Robert", "Krajcik", role = "aut", email = "robert.krajcik@biogen.com"), @@ -68,7 +68,8 @@ Imports: shinyWidgets, stringr, shinyAce, - sortable + sortable, + archive Suggests: chromote (>= 0.1.1.9001), fontawesome, diff --git a/NAMESPACE b/NAMESPACE index a73fff296..8bbcf33e8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,8 @@ importFrom(DT,selectRows) importFrom(DT,styleEqual) importFrom(RSQLite,SQLite) importFrom(RSQLite,sqliteCopyDatabase) +importFrom(archive,archive) +importFrom(archive,archive_read) importFrom(bslib,bs_theme) importFrom(cranlogs,cran_downloads) importFrom(desc,desc_fields) diff --git a/NEWS.md b/NEWS.md index 65f680987..13323c7ed 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,7 @@ * Added dependencies/reverse dependencies card hyperlink (#597) * Added non-shinymanager deployment option (#700) * Added Package Dependencies to Reports (#721) +* Shorten waiting time in code explorer/package explorer by reading tarballs in memory(#707) # riskassessment 3.0.0 diff --git a/R/app_server.R b/R/app_server.R index c72116914..3e9c08151 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -245,35 +245,24 @@ app_server <- function(input, output, session) { }) create_src_dir <- eventReactive(input$tabs, input$tabs == "Source Explorer") - pkgdir <- reactiveVal() + pkgarchive <- reactiveVal() observe({ req(selected_pkg$name() != "-") req(create_src_dir()) req(file.exists(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")))) - - src_dir <- file.path("source", selected_pkg$name()) - if (dir.exists(src_dir)) { - pkgdir(src_dir) - } else { - withProgress( - utils::untar(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), exdir = "source"), - message = glue::glue("Unpacking {selected_pkg$name()}_{selected_pkg$version()}.tar.gz"), - value = 1 - ) - pkgdir(src_dir) - } + pkgarchive(archive::archive(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")))) }) %>% bindEvent(selected_pkg$name(), create_src_dir()) mod_pkg_explorer_server("pkg_explorer", selected_pkg, - pkgdir = pkgdir, + pkgarchive = pkgarchive, creating_dir = create_src_dir, user = user, credentials = credential_config) mod_code_explorer_server("code_explorer", selected_pkg, - pkgdir = pkgdir, + pkgarchive = pkgarchive, creating_dir = create_src_dir, user = user, credentials = credential_config) diff --git a/R/mod_code_explorer.R b/R/mod_code_explorer.R index 571cd005b..1009bb1a9 100644 --- a/R/mod_code_explorer.R +++ b/R/mod_code_explorer.R @@ -11,14 +11,14 @@ mod_code_explorer_ui <- function(id){ ns <- NS(id) uiOutput(ns("func_explorer_ui")) } - #' code_explorer Server Functions #' #' @noRd #' #' @importFrom tools Rd2HTML #' @importFrom purrr map_dfr -mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), creating_dir = reactiveVal(TRUE), user, credentials){ +#' @importFrom archive archive_read archive +mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(), creating_dir = reactiveVal(TRUE), user, credentials){ moduleServer( id, function(input, output, session){ ns <- session$ns @@ -79,14 +79,15 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c } }) - exported_functions <- eventReactive(pkgdir(), { - get_exported_functions(pkgdir()) + exported_functions <- eventReactive(pkgarchive(), { + get_exported_functions(pkgarchive,selected_pkg) }) parse_data <- eventReactive(exported_functions(), { + purrr::map_dfr( c("test", "source"), - ~ get_parse_data(.x, pkgdir(), exported_functions()) + ~ get_parse_data(.x, pkgarchive, selected_pkg,exported_functions()) ) }) @@ -96,26 +97,36 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c observeEvent(input$exported_function, { req(input$exported_function) test_files(get_files(input$exported_function, "test", parse_data())) - updateSelectInput(session, "test_files", choices = test_files(), - selected = if (!rlang::is_empty(test_files())) test_files()[1] else NULL) + updateSelectInput(session, "test_files", choices = basename(test_files()), + selected = if (!rlang::is_empty(test_files())) basename(test_files())[1] else NULL) source_files(get_files(input$exported_function, "source", parse_data())) - updateSelectInput(session, "source_files", choices = source_files(), - selected = if (!rlang::is_empty(source_files())) source_files()[1] else NULL) + updateSelectInput(session, "source_files", choices = basename(source_files()), + selected = if (!rlang::is_empty(source_files())) basename(source_files())[1] else NULL) - man_files(get_files(input$exported_function, "man", pkgdir())) - updateSelectInput(session, "man_files", choices = man_files(), - selected = if (!rlang::is_empty(man_files())) man_files()[1] else NULL) + man_files(get_files(input$exported_function, "man", pkgarchive,selected_pkg)) + updateSelectInput(session, "man_files", choices = basename(man_files()), + selected = if (!rlang::is_empty(man_files())) basename(man_files())[1] else NULL) }) test_code <- reactive({ if (rlang::is_empty(test_files())) return(HTML("No files to display")) req(input$test_files) - fp <- if (file.exists(file.path(pkgdir(), "tests", "testthat.R"))) file.path(pkgdir(), "tests", "testthat", input$test_files) else file.path(pkgdir(), "tests", input$test_files) - lines <- readLines(fp) + if (file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat.R") %in% pkgarchive()$path ) + { + fp <- file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat",input$test_files)} + else + { + fp <- file.path(glue::glue("{selected_pkg$name()}"),"tests",input$test_files) + } + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = fp) + lines <- readLines(con) + close(con) func_list <- c(input$exported_function, paste0("`", input$exported_function, "`")) highlight_index <- parse_data() %>% - filter(file == input$test_files & func %in% func_list) %>% + filter(stringr::str_ends(file,input$test_files) & func %in% func_list) %>% pull(line) renderCode(lines, highlight_index) }) %>% @@ -124,10 +135,15 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c source_code <- reactive({ if (rlang::is_empty(source_files())) return(HTML("No files to display")) req(input$source_files) - lines <- readLines(file.path(pkgdir(), "R", input$source_files)) + fp <- file.path(glue::glue("{selected_pkg$name()}"),"R", input$source_files) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = fp) + lines <- readLines(con) + close(con) func_list <- c(input$exported_function, paste0("`", input$exported_function, "`")) highlight_index <- parse_data() %>% - filter(file == input$source_files & func %in% func_list) %>% + filter(stringr::str_ends(file,input$source_files) & func %in% func_list) %>% pull(line) renderCode(lines, highlight_index) }) %>% @@ -137,7 +153,13 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c if (rlang::is_empty(man_files())) return(HTML("No files to display")) req(input$man_files) out_dir <- tempdir() - tools::Rd2HTML(file.path(pkgdir(), "man", input$man_files), package = c(selected_pkg$name(), selected_pkg$version()), out = file.path(out_dir, "man.html")) + fp <- file.path(glue::glue("{selected_pkg$name()}"), "man", input$man_files) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = fp) + Rdfile <-tools::parse_Rd(con) + close(con) + tools::Rd2HTML(Rdfile, package = c(selected_pkg$name(), selected_pkg$version()), out = file.path(out_dir, "man.html")) includeHTML(file.path(out_dir, "man.html")) }) %>% bindEvent(input$man_files, input$exported_function, ignoreNULL = FALSE) diff --git a/R/mod_code_explorer_utils.R b/R/mod_code_explorer_utils.R index f45d3e706..87c0a071a 100644 --- a/R/mod_code_explorer_utils.R +++ b/R/mod_code_explorer_utils.R @@ -2,14 +2,18 @@ #' #' Scrapes NAMESPACE for exported functions and returns them as a list #' -#' @param pkgdir The package directory to evaluate +#' @param pkgArchive The package directory to evaluate #' #' @return A character vector of the function names #' #' @noRd -get_exported_functions <- function(pkgdir) { - nsFile <- parse(file.path(pkgdir, "NAMESPACE"), keep.source = FALSE, srcfile = NULL) +get_exported_functions <- function(pkgArchive,selected_pkg ) { + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = glue::glue("{selected_pkg$name()}/NAMESPACE")) + nsFile <- parse(con,keep.source = TRUE) nsexp <- character(); nsimp <- character() + close(con) for (e in nsFile) { switch (as.character(e[[1L]]), export = { @@ -28,7 +32,7 @@ get_exported_functions <- function(pkgdir) { #' Parses the files to determine which contain the function(s) of interest #' #' @param type The type of files to parse -#' @param pkgdir The package directory +#' @param pkgArchive The package directory #' @param funcnames The list of functions to evaluate #' #' @return A `tibble` object containing the type of file, file name, function, @@ -37,17 +41,25 @@ get_exported_functions <- function(pkgdir) { #' @noRd #' #' @importFrom utils getParseData -get_parse_data <- function(type = c("test", "source"), pkgdir, funcnames = NULL) { +get_parse_data <- function(type = c("test", "source"), pkgarchive ,selected_pkg, funcnames = NULL) { + type <- match.arg(type) dirpath <- switch (type, - test = if (file.exists(file.path(pkgdir, "tests", "testthat.R"))) file.path(pkgdir, "tests", "testthat") else file.path(pkgdir, "tests"), - source = file.path(pkgdir, "R") + test = if (file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat.R") %in% pkgarchive()$path ){ + file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat") } + else { file.path(glue::glue("{selected_pkg$name()}"),"tests") } + , + source = file.path(glue::glue("{selected_pkg$name()}"),"R") ) - filenames <- list.files(dirpath, ".+\\.[R|r]$") + filenames <- na.omit((str_extract(pkgarchive()$path,paste0(dirpath,".+\\.[R|r]$")))) dplyr::bind_rows(lapply(filenames, function(filename) { - d <- parse(file.path(dirpath, filename), keep.source = TRUE) %>% + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = filename) + d <- parse( text =readLines(con)) %>% utils::getParseData() %>% dplyr::filter(token %in% c("SYMBOL_FUNCTION_CALL", "SYMBOL", "SPECIAL", "STR_CONST")) + close(con) d <- d %>% dplyr::mutate( type = type, @@ -91,6 +103,7 @@ get_test_files <- function(funcname, parse_data) { #' #' @noRd get_source_files <- function(funcname, parse_data) { + #browser() func_list <- c(funcname, paste0("`", funcname, "`")) parse_data %>% dplyr::filter(type == "source", @@ -104,17 +117,22 @@ get_source_files <- function(funcname, parse_data) { #' Returns the man files from the package directory corresponding to the function of interest #' #' @param funcname The name of the function to evaluate -#' @param pkgdir The package directory +#' @param pkgArchive The package directory #' #' @noRd -get_man_files <- function(funcname, pkgdir) { - man_files <- list.files(file.path(pkgdir, "man"), ".+\\.Rd$") +get_man_files <- function(funcname, pkgarchive,selected_pkg ) { + man_files <- na.omit((str_extract(pkgarchive()$path, + paste(glue::glue("{selected_pkg$name()}"),"man",".+\\.Rd$",sep ="/")))) funcname_regex <- gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", funcname) %>% gsub(pattern = "`", replacement = "`?") %>% gsub(pattern = "\\%", replacement = "\\\\\\\\\\%") i <- sapply(man_files, function(f) { - s <- readLines(file.path(pkgdir, "man", f)) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = f) + s <- readLines(con) + close(con) any(grepl(sprintf("name\\{%s\\}|alias\\{%s\\}", funcname_regex, funcname_regex), s)) }) man_files[i] diff --git a/R/mod_pkg_explorer.R b/R/mod_pkg_explorer.R index 050f7f73e..efb66a636 100644 --- a/R/mod_pkg_explorer.R +++ b/R/mod_pkg_explorer.R @@ -18,12 +18,13 @@ mod_pkg_explorer_ui <- function(id){ #' @importFrom shinyAce updateAceEditor #' @importFrom utils untar #' @importFrom shinyTree shinyTree renderTree updateTree get_selected +#' @importFrom archive archive_read archive #' #' @noRd mod_pkg_explorer_server <- function(id, selected_pkg, accepted_extensions = c("r", "rmd", "rd", "txt", "md","csv", "tsv", "json", "xml", "yaml", "yml", "dcf", "html", "js", "css", "c", "cpp", "h", "java", "scala", "py", "perl", "sh", "sql"), accepted_filenames = c("DESCRIPTION", "NAMESPACE", "LICENSE", "LICENSE.note", "NEWS", "README", "CHANGES", "MD5"), - pkgdir = reactiveVal(), + pkgarchive = reactiveVal(), creating_dir = reactiveVal(TRUE), user, credentials) { moduleServer( id, function(input, output, session){ @@ -31,7 +32,6 @@ mod_pkg_explorer_server <- function(id, selected_pkg, output$pkg_explorer_ui <- renderUI({ - # Lets the user know that a package needs to be selected. if(identical(selected_pkg$name(), character(0))) { showHelperMessage() @@ -84,8 +84,13 @@ mod_pkg_explorer_server <- function(id, selected_pkg, bindEvent(selected_pkg$name(), creating_dir()) nodes <- reactive({ - req(pkgdir()) - s <- make_nodes(list.files(pkgdir(), recursive = TRUE)) + req(pkgarchive()) + s <- pkgarchive() %>% + filter(size > 0) %>% + filter(grepl("/",path)) %>% + dplyr::pull(path) %>% + make_nodes() %>% + .[[1]] if(!is.null(s[["DESCRIPTION"]])){ attr(s[["DESCRIPTION"]],"stselected") = TRUE } @@ -93,9 +98,10 @@ mod_pkg_explorer_server <- function(id, selected_pkg, f <- names(head(purrr::keep(s, \(x) !is.null(attr(x, "sttype"))), 1)) attr(s[[f]],"stselected") = TRUE } + s }) %>% - bindEvent(pkgdir(), selected_pkg$name()) + bindEvent(pkgarchive (), selected_pkg$name()) output$dirtree <- shinyTree::renderTree(nodes()) @@ -117,7 +123,11 @@ mod_pkg_explorer_server <- function(id, selected_pkg, filename <- basename(filepath) e <- tolower(tools::file_ext(filepath)) if (e %in% accepted_extensions || filename %in% accepted_filenames) { - s <- readLines(file.path(pkgdir(), filepath)) + con <- archive::archive_read(file.path("tarballs", + glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + file = glue::glue("{selected_pkg$name()}/{filepath}")) + s <- readLines(con) + close(con) s <- paste(s, collapse = "\n") } else { s <- "file format not supported" From a4f87b0487afff663bb65577ac277a6e0bfdca97 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <85879620+Jeff-Thompson12@users.noreply.github.com> Date: Tue, 5 Mar 2024 11:14:39 -0500 Subject: [PATCH 04/12] Keep source when parsing --- R/mod_code_explorer_utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/mod_code_explorer_utils.R b/R/mod_code_explorer_utils.R index 87c0a071a..ce1d9484d 100644 --- a/R/mod_code_explorer_utils.R +++ b/R/mod_code_explorer_utils.R @@ -56,7 +56,7 @@ get_parse_data <- function(type = c("test", "source"), pkgarchive ,selected_pkg con <- archive::archive_read(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), file = filename) - d <- parse( text =readLines(con)) %>% + d <- parse(text = readLines(con), keep.source = TRUE) %>% utils::getParseData() %>% dplyr::filter(token %in% c("SYMBOL_FUNCTION_CALL", "SYMBOL", "SPECIAL", "STR_CONST")) close(con) From 2ccaf2f60071ccabd067fa6122bb4593930d1591 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <85879620+Jeff-Thompson12@users.noreply.github.com> Date: Tue, 5 Mar 2024 11:15:51 -0500 Subject: [PATCH 05/12] Change `pkgdir` to `pkgarchive` --- tests/testthat/test-apps/explorer-app/app.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-apps/explorer-app/app.R b/tests/testthat/test-apps/explorer-app/app.R index 4f24e157c..7b112d6c4 100644 --- a/tests/testthat/test-apps/explorer-app/app.R +++ b/tests/testthat/test-apps/explorer-app/app.R @@ -19,7 +19,7 @@ server <- function(input, output, server) { shinyOptions(golem_options = list(assessment_db_name = "dplyr.sqlite")) selected_pkg <- list(name = reactiveVal("dplyr"), version = reactiveVal("1.1.2")) - pkgdir <- reactiveVal(file.path("source", "dplyr")) + pkgarchive <- reactiveVal(archive::archive(file.path("tarballs", "dplyr_1.1.2.tar.gz"))) user <- reactiveValues( name = "tester", role = "admin" @@ -27,12 +27,12 @@ server <- function(input, output, server) { credential_config <- riskassessment:::get_db_config("credentials") riskassessment:::mod_pkg_explorer_server("src_explorer", selected_pkg, - pkgdir = pkgdir, + pkgarchive = pkgarchive, user = user, credentials = credential_config) riskassessment:::mod_code_explorer_server("fn_explorer", selected_pkg, - pkgdir = pkgdir, + pkgarchive = pkgarchive, user = user, credentials = credential_config) } From 9ba9e0fda3971323ce0e6e1b05a47d50457e6a39 Mon Sep 17 00:00:00 2001 From: narayanan-iyer-pfizer <114721252+narayanan-iyer-pfizer@users.noreply.github.com> Date: Thu, 7 Mar 2024 17:05:01 +0530 Subject: [PATCH 06/12] update to sort on lowercase --- R/mod_pkg_explorer.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/mod_pkg_explorer.R b/R/mod_pkg_explorer.R index efb66a636..908f7d287 100644 --- a/R/mod_pkg_explorer.R +++ b/R/mod_pkg_explorer.R @@ -85,7 +85,10 @@ mod_pkg_explorer_server <- function(id, selected_pkg, nodes <- reactive({ req(pkgarchive()) + # browser() s <- pkgarchive() %>% + mutate(lowercase = tolower(path)) %>% + arrange(lowercase) %>% filter(size > 0) %>% filter(grepl("/",path)) %>% dplyr::pull(path) %>% From 76857dfce61df37a6ecb9f95b67f20699b9f5260 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <85879620+Jeff-Thompson12@users.noreply.github.com> Date: Thu, 7 Mar 2024 09:42:21 -0500 Subject: [PATCH 07/12] Move ordering for pkgArchive to app_server.R --- R/app_server.R | 3 ++- R/mod_pkg_explorer.R | 3 --- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 3e9c08151..f492d3a7c 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -250,7 +250,8 @@ app_server <- function(input, output, session) { req(selected_pkg$name() != "-") req(create_src_dir()) req(file.exists(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")))) - pkgarchive(archive::archive(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")))) + pkgarchive(archive::archive(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz"))) %>% + dplyr::arrange(tolower(path))) }) %>% bindEvent(selected_pkg$name(), create_src_dir()) diff --git a/R/mod_pkg_explorer.R b/R/mod_pkg_explorer.R index 908f7d287..efb66a636 100644 --- a/R/mod_pkg_explorer.R +++ b/R/mod_pkg_explorer.R @@ -85,10 +85,7 @@ mod_pkg_explorer_server <- function(id, selected_pkg, nodes <- reactive({ req(pkgarchive()) - # browser() s <- pkgarchive() %>% - mutate(lowercase = tolower(path)) %>% - arrange(lowercase) %>% filter(size > 0) %>% filter(grepl("/",path)) %>% dplyr::pull(path) %>% From 9ec1e4b3c3c9e085c2adeac21a406a6530015ac2 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <85879620+Jeff-Thompson12@users.noreply.github.com> Date: Thu, 7 Mar 2024 09:42:51 -0500 Subject: [PATCH 08/12] Update testing app with ordering --- tests/testthat/test-apps/explorer-app/app.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-apps/explorer-app/app.R b/tests/testthat/test-apps/explorer-app/app.R index 7b112d6c4..edbfdcbee 100644 --- a/tests/testthat/test-apps/explorer-app/app.R +++ b/tests/testthat/test-apps/explorer-app/app.R @@ -19,7 +19,8 @@ server <- function(input, output, server) { shinyOptions(golem_options = list(assessment_db_name = "dplyr.sqlite")) selected_pkg <- list(name = reactiveVal("dplyr"), version = reactiveVal("1.1.2")) - pkgarchive <- reactiveVal(archive::archive(file.path("tarballs", "dplyr_1.1.2.tar.gz"))) + pkgarchive <- reactiveVal(archive::archive(file.path("tarballs", "dplyr_1.1.2.tar.gz")) |> + dplyr::arrange(tolower(path))) user <- reactiveValues( name = "tester", role = "admin" From b83434ed5067e0f18bf9141fe5c8a829ee6a340d Mon Sep 17 00:00:00 2001 From: Jeff Thompson <85879620+Jeff-Thompson12@users.noreply.github.com> Date: Thu, 7 Mar 2024 09:43:24 -0500 Subject: [PATCH 09/12] Repair tests --- tests/testthat/_snaps/pkg_explorer/001.json | 256 ++++++++++---------- tests/testthat/test-code_explorer.R | 3 +- 2 files changed, 129 insertions(+), 130 deletions(-) diff --git a/tests/testthat/_snaps/pkg_explorer/001.json b/tests/testthat/_snaps/pkg_explorer/001.json index 999fc88e6..7dfbf89ce 100644 --- a/tests/testthat/_snaps/pkg_explorer/001.json +++ b/tests/testthat/_snaps/pkg_explorer/001.json @@ -1,123 +1,6 @@ { "input": { "src_explorer-dirtree": { - "DESCRIPTION": 0, - "LICENSE": 0, - "MD5": 0, - "NAMESPACE": 0, - "NEWS.md": 0, - "R": { - "across.R": 0, - "all-equal.R": 0, - "arrange.R": 0, - "bind-cols.R": 0, - "bind-rows.R": 0, - "by.R": 0, - "case-match.R": 0, - "case-when.R": 0, - "coalesce.R": 0, - "colwise-arrange.R": 0, - "colwise-distinct.R": 0, - "colwise-filter.R": 0, - "colwise-funs.R": 0, - "colwise-group-by.R": 0, - "colwise-mutate.R": 0, - "colwise-select.R": 0, - "colwise.R": 0, - "compat-dbplyr.R": 0, - "compat-name-repair.R": 0, - "compute-collect.R": 0, - "conditions.R": 0, - "consecutive-id.R": 0, - "context.R": 0, - "copy-to.R": 0, - "count-tally.R": 0, - "data-bands.R": 0, - "data-mask.R": 0, - "data-starwars.R": 0, - "data-storms.R": 0, - "dbplyr.R": 0, - "defunct.R": 0, - "deprec-combine.R": 0, - "deprec-context.R": 0, - "deprec-dbi.R": 0, - "deprec-do.R": 0, - "deprec-funs.R": 0, - "deprec-lazyeval.R": 0, - "deprec-src-local.R": 0, - "deprec-tibble.R": 0, - "desc.R": 0, - "distinct.R": 0, - "doc-methods.R": 0, - "doc-params.R": 0, - "dplyr.R": 0, - "error.R": 0, - "explain.R": 0, - "filter.R": 0, - "funs.R": 0, - "generics.R": 0, - "group-by.R": 0, - "group-data.R": 0, - "group-map.R": 0, - "group-nest.R": 0, - "group-split.R": 0, - "group-trim.R": 0, - "grouped-df.R": 0, - "groups-with.R": 0, - "if-else.R": 0, - "import-standalone-lazyeval.R": 0, - "import-standalone-obj-type.R": 0, - "import-standalone-purrr.R": 0, - "import-standalone-types-check.R": 0, - "join-by.R": 0, - "join-cols.R": 0, - "join-common-by.R": 0, - "join-cross.R": 0, - "join-rows.R": 0, - "join.R": 0, - "lead-lag.R": 0, - "locale.R": 0, - "mutate.R": 0, - "n-distinct.R": 0, - "na-if.R": 0, - "near.R": 0, - "nest-by.R": 0, - "nth-value.R": 0, - "order-by.R": 0, - "pick.R": 0, - "progress.R": 0, - "pull.R": 0, - "rank.R": 0, - "recode.R": 0, - "reexport-magrittr.R": 0, - "reexport-pillar.R": 0, - "reexport-tibble.R": 0, - "reframe.R": 0, - "relocate.R": 0, - "rename.R": 0, - "rows.R": 0, - "rowwise.R": 0, - "sample.R": 0, - "select-helpers.R": 0, - "select.R": 0, - "sets.R": 0, - "slice.R": 0, - "src-dbi.R": 0, - "src.R": 0, - "summarise.R": 0, - "tbl.R": 0, - "top-n.R": 0, - "transmute.R": 0, - "ts.R": 0, - "utils-format.R": 0, - "utils-tidy-eval.R": 0, - "utils.R": 0, - "vctrs.R": 0, - "vec-case-match.R": 0, - "vec-case-when.R": 0, - "zzz.R": 0 - }, - "README.md": 0, "build": { "dplyr.pdf": 0, "vignette.rds": 0 @@ -129,37 +12,39 @@ "starwars.rda": 0, "storms.rda": 0 }, + "DESCRIPTION": 0, "inst": { "doc": { + "base.html": 0, "base.R": 0, "base.Rmd": 0, - "base.html": 0, + "colwise.html": 0, "colwise.R": 0, "colwise.Rmd": 0, - "colwise.html": 0, + "dplyr.html": 0, "dplyr.R": 0, "dplyr.Rmd": 0, - "dplyr.html": 0, + "grouping.html": 0, "grouping.R": 0, "grouping.Rmd": 0, - "grouping.html": 0, + "in-packages.html": 0, "in-packages.R": 0, "in-packages.Rmd": 0, - "in-packages.html": 0, + "programming.html": 0, "programming.R": 0, "programming.Rmd": 0, - "programming.html": 0, + "rowwise.html": 0, "rowwise.R": 0, "rowwise.Rmd": 0, - "rowwise.html": 0, + "two-table.html": 0, "two-table.R": 0, "two-table.Rmd": 0, - "two-table.html": 0, + "window-functions.html": 0, "window-functions.R": 0, - "window-functions.Rmd": 0, - "window-functions.html": 0 + "window-functions.Rmd": 0 } }, + "LICENSE": 0, "man": { "across.Rd": 0, "add_rownames.Rd": 0, @@ -295,6 +180,121 @@ "with_groups.Rd": 0, "with_order.Rd": 0 }, + "MD5": 0, + "NAMESPACE": 0, + "NEWS.md": 0, + "R": { + "across.R": 0, + "all-equal.R": 0, + "arrange.R": 0, + "bind-cols.R": 0, + "bind-rows.R": 0, + "by.R": 0, + "case-match.R": 0, + "case-when.R": 0, + "coalesce.R": 0, + "colwise-arrange.R": 0, + "colwise-distinct.R": 0, + "colwise-filter.R": 0, + "colwise-funs.R": 0, + "colwise-group-by.R": 0, + "colwise-mutate.R": 0, + "colwise-select.R": 0, + "colwise.R": 0, + "compat-dbplyr.R": 0, + "compat-name-repair.R": 0, + "compute-collect.R": 0, + "conditions.R": 0, + "consecutive-id.R": 0, + "context.R": 0, + "copy-to.R": 0, + "count-tally.R": 0, + "data-bands.R": 0, + "data-mask.R": 0, + "data-starwars.R": 0, + "data-storms.R": 0, + "dbplyr.R": 0, + "defunct.R": 0, + "deprec-combine.R": 0, + "deprec-context.R": 0, + "deprec-dbi.R": 0, + "deprec-do.R": 0, + "deprec-funs.R": 0, + "deprec-lazyeval.R": 0, + "deprec-src-local.R": 0, + "deprec-tibble.R": 0, + "desc.R": 0, + "distinct.R": 0, + "doc-methods.R": 0, + "doc-params.R": 0, + "dplyr.R": 0, + "error.R": 0, + "explain.R": 0, + "filter.R": 0, + "funs.R": 0, + "generics.R": 0, + "group-by.R": 0, + "group-data.R": 0, + "group-map.R": 0, + "group-nest.R": 0, + "group-split.R": 0, + "group-trim.R": 0, + "grouped-df.R": 0, + "groups-with.R": 0, + "if-else.R": 0, + "import-standalone-lazyeval.R": 0, + "import-standalone-obj-type.R": 0, + "import-standalone-purrr.R": 0, + "import-standalone-types-check.R": 0, + "join-by.R": 0, + "join-cols.R": 0, + "join-common-by.R": 0, + "join-cross.R": 0, + "join-rows.R": 0, + "join.R": 0, + "lead-lag.R": 0, + "locale.R": 0, + "mutate.R": 0, + "n-distinct.R": 0, + "na-if.R": 0, + "near.R": 0, + "nest-by.R": 0, + "nth-value.R": 0, + "order-by.R": 0, + "pick.R": 0, + "progress.R": 0, + "pull.R": 0, + "rank.R": 0, + "recode.R": 0, + "reexport-magrittr.R": 0, + "reexport-pillar.R": 0, + "reexport-tibble.R": 0, + "reframe.R": 0, + "relocate.R": 0, + "rename.R": 0, + "rows.R": 0, + "rowwise.R": 0, + "sample.R": 0, + "select-helpers.R": 0, + "select.R": 0, + "sets.R": 0, + "slice.R": 0, + "src-dbi.R": 0, + "src.R": 0, + "summarise.R": 0, + "tbl.R": 0, + "top-n.R": 0, + "transmute.R": 0, + "ts.R": 0, + "utils-format.R": 0, + "utils-tidy-eval.R": 0, + "utils.R": 0, + "vctrs.R": 0, + "vec-case-match.R": 0, + "vec-case-when.R": 0, + "zzz.R": 0 + }, + "README.md": 0, "src": { "chop.cpp": 0, "dplyr.h": 0, @@ -468,8 +468,8 @@ "vignettes": { "base.Rmd": 0, "colwise.Rmd": 0, - "compatibility.R": 0, "compatibility.html": 0, + "compatibility.R": 0, "dplyr.Rmd": 0, "grouping.Rmd": 0, "in-packages.Rmd": 0, diff --git a/tests/testthat/test-code_explorer.R b/tests/testthat/test-code_explorer.R index 84d128e56..6eb11cf17 100644 --- a/tests/testthat/test-code_explorer.R +++ b/tests/testthat/test-code_explorer.R @@ -34,8 +34,7 @@ test_that("pkg_explorer works", { app <- shinytest2::AppDriver$new(test_path("test-apps", "explorer-app")) app$set_inputs(tabs = "fn_expl_tab") - app$wait_for_idle() - + expect_equal( app$get_values(input = paste("fn_explorer", c("exported_function", "file_type"), sep = "-"))$input, list(`fn_explorer-exported_function` = ".data", `fn_explorer-file_type` = "test") From 9ce15351d55e56f60ac079b42c56d3a8b0d0b041 Mon Sep 17 00:00:00 2001 From: narayanan-iyer-pfizer <114721252+narayanan-iyer-pfizer@users.noreply.github.com> Date: Mon, 11 Mar 2024 15:29:54 +0530 Subject: [PATCH 10/12] add cosmetic changes and remove reactive variables from static functions calls --- NEWS.md | 2 +- R/mod_code_explorer.R | 16 ++++++++-------- R/mod_code_explorer_utils.R | 33 +++++++++++++++++---------------- R/mod_pkg_explorer.R | 2 +- 4 files changed, 27 insertions(+), 26 deletions(-) diff --git a/NEWS.md b/NEWS.md index 13323c7ed..9abcac519 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,7 +11,7 @@ * Added dependencies/reverse dependencies card hyperlink (#597) * Added non-shinymanager deployment option (#700) * Added Package Dependencies to Reports (#721) -* Shorten waiting time in code explorer/package explorer by reading tarballs in memory(#707) +* Shorten waiting time in code explorer/package explorer by reading tarballs in memory (#707) # riskassessment 3.0.0 diff --git a/R/mod_code_explorer.R b/R/mod_code_explorer.R index 1009bb1a9..5066762b9 100644 --- a/R/mod_code_explorer.R +++ b/R/mod_code_explorer.R @@ -80,14 +80,14 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal( }) exported_functions <- eventReactive(pkgarchive(), { - get_exported_functions(pkgarchive,selected_pkg) + get_exported_functions(pkg_name = selected_pkg$name(), pkg_version = selected_pkg$version()) }) parse_data <- eventReactive(exported_functions(), { purrr::map_dfr( c("test", "source"), - ~ get_parse_data(.x, pkgarchive, selected_pkg,exported_functions()) + ~ get_parse_data(.x, pkgarchive(), pkg_name = selected_pkg$name(), pkg_version = selected_pkg$version(), exported_functions()) ) }) @@ -104,7 +104,7 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal( updateSelectInput(session, "source_files", choices = basename(source_files()), selected = if (!rlang::is_empty(source_files())) basename(source_files())[1] else NULL) - man_files(get_files(input$exported_function, "man", pkgarchive,selected_pkg)) + man_files(get_files(input$exported_function, "man", pkgarchive(), pkg_name = selected_pkg$name(), pkg_version = selected_pkg$version())) updateSelectInput(session, "man_files", choices = basename(man_files()), selected = if (!rlang::is_empty(man_files())) basename(man_files())[1] else NULL) }) @@ -114,10 +114,10 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal( req(input$test_files) if (file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat.R") %in% pkgarchive()$path ) { - fp <- file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat",input$test_files)} + fp <- file.path(glue::glue("{selected_pkg$name()}"), "tests", "testthat", input$test_files)} else { - fp <- file.path(glue::glue("{selected_pkg$name()}"),"tests",input$test_files) + fp <- file.path(glue::glue("{selected_pkg$name()}"), "tests", input$test_files) } con <- archive::archive_read(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), @@ -126,7 +126,7 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal( close(con) func_list <- c(input$exported_function, paste0("`", input$exported_function, "`")) highlight_index <- parse_data() %>% - filter(stringr::str_ends(file,input$test_files) & func %in% func_list) %>% + filter(stringr::str_ends(file, input$test_files) & func %in% func_list) %>% pull(line) renderCode(lines, highlight_index) }) %>% @@ -135,7 +135,7 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal( source_code <- reactive({ if (rlang::is_empty(source_files())) return(HTML("No files to display")) req(input$source_files) - fp <- file.path(glue::glue("{selected_pkg$name()}"),"R", input$source_files) + fp <- file.path(glue::glue("{selected_pkg$name()}"), "R", input$source_files) con <- archive::archive_read(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), file = fp) @@ -143,7 +143,7 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal( close(con) func_list <- c(input$exported_function, paste0("`", input$exported_function, "`")) highlight_index <- parse_data() %>% - filter(stringr::str_ends(file,input$source_files) & func %in% func_list) %>% + filter(stringr::str_ends(file, input$source_files) & func %in% func_list) %>% pull(line) renderCode(lines, highlight_index) }) %>% diff --git a/R/mod_code_explorer_utils.R b/R/mod_code_explorer_utils.R index ce1d9484d..f0cbcd6bf 100644 --- a/R/mod_code_explorer_utils.R +++ b/R/mod_code_explorer_utils.R @@ -7,11 +7,12 @@ #' @return A character vector of the function names #' #' @noRd -get_exported_functions <- function(pkgArchive,selected_pkg ) { +get_exported_functions <- function(pkg_name, pkg_version) { + con <- archive::archive_read(file.path("tarballs", - glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), - file = glue::glue("{selected_pkg$name()}/NAMESPACE")) - nsFile <- parse(con,keep.source = TRUE) + glue::glue("{pkg_name}_{pkg_version}.tar.gz")), + file = glue::glue("{pkg_name}/NAMESPACE")) + nsFile <- parse(con, keep.source = TRUE) nsexp <- character(); nsimp <- character() close(con) for (e in nsFile) { @@ -41,20 +42,20 @@ get_exported_functions <- function(pkgArchive,selected_pkg ) { #' @noRd #' #' @importFrom utils getParseData -get_parse_data <- function(type = c("test", "source"), pkgarchive ,selected_pkg, funcnames = NULL) { +get_parse_data <- function(type = c("test", "source"), pkgarchive, pkg_name, pkg_version, funcnames = NULL) { type <- match.arg(type) dirpath <- switch (type, - test = if (file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat.R") %in% pkgarchive()$path ){ - file.path(glue::glue("{selected_pkg$name()}"),"tests", "testthat") } - else { file.path(glue::glue("{selected_pkg$name()}"),"tests") } + test = if (file.path(glue::glue("{pkg_name}"), "tests", "testthat.R") %in% pkgarchive$path ){ + file.path(glue::glue("{pkg_name}"), "tests", "testthat") } + else { file.path(glue::glue("{pkg_name}"),"tests") } , - source = file.path(glue::glue("{selected_pkg$name()}"),"R") + source = file.path(glue::glue("{pkg_name}"), "R") ) - filenames <- na.omit((str_extract(pkgarchive()$path,paste0(dirpath,".+\\.[R|r]$")))) + filenames <- na.omit((str_extract(pkgarchive$path,paste0(dirpath, ".+\\.[R|r]$")))) dplyr::bind_rows(lapply(filenames, function(filename) { con <- archive::archive_read(file.path("tarballs", - glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + glue::glue("{pkg_name}_{pkg_version}.tar.gz")), file = filename) d <- parse(text = readLines(con), keep.source = TRUE) %>% utils::getParseData() %>% @@ -103,7 +104,6 @@ get_test_files <- function(funcname, parse_data) { #' #' @noRd get_source_files <- function(funcname, parse_data) { - #browser() func_list <- c(funcname, paste0("`", funcname, "`")) parse_data %>% dplyr::filter(type == "source", @@ -120,16 +120,17 @@ get_source_files <- function(funcname, parse_data) { #' @param pkgArchive The package directory #' #' @noRd -get_man_files <- function(funcname, pkgarchive,selected_pkg ) { - man_files <- na.omit((str_extract(pkgarchive()$path, - paste(glue::glue("{selected_pkg$name()}"),"man",".+\\.Rd$",sep ="/")))) +get_man_files <- function(funcname, pkgarchive, pkg_name, pkg_version) { + + man_files <- na.omit((str_extract(pkgarchive$path, + paste(glue::glue("{pkg_name}"), "man", ".+\\.Rd$", sep ="/")))) funcname_regex <- gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", funcname) %>% gsub(pattern = "`", replacement = "`?") %>% gsub(pattern = "\\%", replacement = "\\\\\\\\\\%") i <- sapply(man_files, function(f) { con <- archive::archive_read(file.path("tarballs", - glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), + glue::glue("{pkg_name}_{pkg_version}.tar.gz")), file = f) s <- readLines(con) close(con) diff --git a/R/mod_pkg_explorer.R b/R/mod_pkg_explorer.R index efb66a636..0fa0eb518 100644 --- a/R/mod_pkg_explorer.R +++ b/R/mod_pkg_explorer.R @@ -87,7 +87,7 @@ mod_pkg_explorer_server <- function(id, selected_pkg, req(pkgarchive()) s <- pkgarchive() %>% filter(size > 0) %>% - filter(grepl("/",path)) %>% + filter(grepl("/", path)) %>% dplyr::pull(path) %>% make_nodes() %>% .[[1]] From 1a9412346cfb86c1a47f6df7d1ae3ffd6b2669c0 Mon Sep 17 00:00:00 2001 From: narayanan-iyer-pfizer <114721252+narayanan-iyer-pfizer@users.noreply.github.com> Date: Tue, 12 Mar 2024 16:19:12 +0530 Subject: [PATCH 11/12] refactor to avoid writing to disc --- R/mod_code_explorer.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/mod_code_explorer.R b/R/mod_code_explorer.R index 5066762b9..ada247886 100644 --- a/R/mod_code_explorer.R +++ b/R/mod_code_explorer.R @@ -158,9 +158,9 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal( glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), file = fp) Rdfile <-tools::parse_Rd(con) - close(con) - tools::Rd2HTML(Rdfile, package = c(selected_pkg$name(), selected_pkg$version()), out = file.path(out_dir, "man.html")) - includeHTML(file.path(out_dir, "man.html")) + HTML(paste0(capture.output(tools::Rd2HTML(Rdfile, + package = c(selected_pkg$name(), + selected_pkg$version()), out = "")),collapse = "\n")) }) %>% bindEvent(input$man_files, input$exported_function, ignoreNULL = FALSE) From 4ec3b60ce2135aea94e893d0ffe978e667da28a2 Mon Sep 17 00:00:00 2001 From: narayanan-iyer-pfizer <114721252+narayanan-iyer-pfizer@users.noreply.github.com> Date: Tue, 12 Mar 2024 16:19:12 +0530 Subject: [PATCH 12/12] refactor to avoid writing to disc --- R/mod_code_explorer.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/mod_code_explorer.R b/R/mod_code_explorer.R index 5066762b9..646adac08 100644 --- a/R/mod_code_explorer.R +++ b/R/mod_code_explorer.R @@ -152,15 +152,15 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal( man_page <- reactive({ if (rlang::is_empty(man_files())) return(HTML("No files to display")) req(input$man_files) - out_dir <- tempdir() fp <- file.path(glue::glue("{selected_pkg$name()}"), "man", input$man_files) con <- archive::archive_read(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")), file = fp) Rdfile <-tools::parse_Rd(con) close(con) - tools::Rd2HTML(Rdfile, package = c(selected_pkg$name(), selected_pkg$version()), out = file.path(out_dir, "man.html")) - includeHTML(file.path(out_dir, "man.html")) + HTML(paste0(capture.output(tools::Rd2HTML(Rdfile, + package = c(selected_pkg$name(), + selected_pkg$version()), out = "")), collapse = "\n")) }) %>% bindEvent(input$man_files, input$exported_function, ignoreNULL = FALSE)