merge with dev, resolve NEWS.md conflict

pharmaR · Jan 17, 2024 · a92d9b5 · a92d9b5
2 parents 566b205 + 4cfdbfb
commit a92d9b5
Show file tree

Hide file tree

Showing 22 changed files with 485 additions and 96 deletions.
diff --git 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.9010
+Version: 3.0.0.9011
 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"),
@@ -33,7 +33,7 @@ Description: A shiny application that allows users to define a list of R
     decisions' can be made at the package level manually or through pre-defined
     automation rules.
 License: MIT + file LICENSE
-URL: https://github.com/pharmaR/riskassessment
+URL: https://github.com/pharmaR/riskassessment, https://pharmar.github.io/riskassessment/
 BugReports: https://github.com/pharmaR/riskassessment/issues
 Encoding: UTF-8
 LazyData: true
@@ -47,6 +47,7 @@ Imports:
     desc,
     dplyr,
     DT,
+    flextable,
     formattable,
     glue,
     golem (>= 0.3.2),

diff --git a/NAMESPACE b/NAMESPACE
@@ -31,6 +31,9 @@ importFrom(desc,desc_fields)
 importFrom(desc,desc_get_field)
 importFrom(desc,desc_get_list)
 importFrom(dplyr,case_when)
+importFrom(flextable,colformat_char)
+importFrom(flextable,flextable)
+importFrom(flextable,set_table_properties)
 importFrom(formattable,as.datatable)
 importFrom(formattable,csscolor)
 importFrom(formattable,formattable)

diff --git a/NEWS.md b/NEWS.md
@@ -10,7 +10,8 @@
 * Only run configuration checkers when configuring the database
 * Added dependencies/reverse dependencies card hyperlink (#597)
 * Added non-shinymanager deployment option (#700)
-* Added dependency rules to config file (#598)
+* Added Package Dependencies to Reports (#721)
+* Added dependency assessment rules in the config file (#598)
 
 # riskassessment 3.0.0
 

diff --git a/R/app_server.R b/R/app_server.R
@@ -240,6 +240,10 @@ app_server <- function(input, output, session) {
     get_comm_data(selected_pkg$name())
   })
 
+  session$userData$loaded2_db <- eventReactive({uploaded_pkgs(); changes()}, {
+    dbSelect("SELECT name, version, score FROM package")
+  })
+
   create_src_dir <- eventReactive(input$tabs, input$tabs == "Source Explorer")
   pkgdir <- reactiveVal()
   observe({
@@ -288,6 +292,12 @@ app_server <- function(input, output, session) {
                                            community_usage_metrics,
                                            user,
                                            credential_config)
+
+  # Load server for the package dependencies tab.
+  dependencies_data <- packageDependenciesServer('packageDependencies',
+                                                  selected_pkg,
+                                                  user,
+                                                  parent = session)
 
   # Load server of the report preview tab.
   reportPreviewServer(id = "reportPreview",
@@ -304,12 +314,7 @@ app_server <- function(input, output, session) {
                       app_version = golem::get_golem_options('app_version'),
                       metric_weights = metric_weights)
 
-  # Load server for the package dependencies tab.
-  dependencies_data <- packageDependenciesServer('packageDependencies',
-                                               selected_pkg,
-                                               user,
-                                               parent = session)
-
+
   output$auth_output <- renderPrint({
     reactiveValuesToList(res_auth)
   })

diff --git a/R/mod_databaseView.R b/R/mod_databaseView.R
@@ -301,7 +301,8 @@ databaseViewServer <- function(id, user, uploaded_pkgs, metric_weights, changes,
 
     # return vector of elements to include in the report
     report_includes <- mod_downloadHandler_include_server("downloadHandler")
-    
+
     mod_downloadHandler_server("downloadHandler", pkgs, user, metric_weights)
+
   })
 }
diff --git a/R/mod_downloadHandler.R b/R/mod_downloadHandler.R
@@ -99,6 +99,8 @@ mod_downloadHandler_include_server <- function(id) {
 }
 
 #' downloadHandler Server Functions
+#' 
+#' @importFrom flextable flextable set_table_properties colformat_char
 #'
 #' @noRd 
 mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){
@@ -130,6 +132,14 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){
 
         req(n_pkgs > 0)
 
+        if (!isTruthy(session$userData$repo_pkgs())) {
+          if (isTRUE(getOption("shiny.testmode"))) {
+            session$userData$repo_pkgs(purrr::map_dfr(test_pkg_refs, ~ as.data.frame(.x, col.names = c("Package", "Version", "Source"))))
+          } else {
+            session$userData$repo_pkgs(as.data.frame(utils::available.packages()[,1:2]))
+          }
+        }
+
         shiny::withProgress(
           message = glue::glue('Downloading {ifelse(n_pkgs > 1, paste0(n_pkgs, " "), "")}Report{ifelse(n_pkgs > 1, "s", paste0(": ", pkgs()))}'),
           value = 0,
@@ -257,7 +267,18 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){
               downloads_plot <- build_comm_plotly(comm_data)
               metric_tbl <- dbSelect("select * from metric", db_name = golem::get_golem_options('assessment_db_name'))
 
-
+              dep_metrics <- eventReactive(this_pkg, {
+                get_depends_data(this_pkg, db_name = golem::get_golem_options("assessment_db_name"))
+              })
+
+              dep_cards <- build_dep_cards(data = dep_metrics(), loaded = session$userData$loaded2_db()$name, toggled = 0L)
+
+              dep_table <- purrr::map_df(dep_metrics()$name, ~get_versnScore(.x, session$userData$loaded2_db(), session$userData$repo_pkgs())) %>%
+                  right_join(dep_metrics(), by = "name") %>%
+                  select(package, type, version, score) %>%
+                  arrange(package, type) %>%
+                  distinct()
+
               # Render the report, passing parameters to the rmd file.
               rmarkdown::render(
                 input = Report,
@@ -280,6 +301,8 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){
                               com_metrics = comm_cards,
                               com_metrics_raw = comm_data,
                               downloads_plot_data = downloads_plot,
+                              dep_cards = dep_cards,
+                              dep_table = dep_table,
                               metric_tbl = metric_tbl
                 )
               )

diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R
@@ -31,10 +31,6 @@ packageDependenciesServer <- function(id, selected_pkg, user, parent) {
   moduleServer(id, function(input, output, session) {
     ns <- session$ns
 
-    loaded2_db <- eventReactive(selected_pkg$name(), {
-      dbSelect("SELECT name, version, score FROM package")
-    })
-
     tabready <- reactiveVal(value = NULL)
     depends  <- reactiveVal(value = NULL)
     suggests <- reactiveVal(value = NULL)
@@ -68,7 +64,9 @@ packageDependenciesServer <- function(id, selected_pkg, user, parent) {
       req(pkgref())
       tryCatch(
         expr = {
-          depends(pkgref()$dependencies[[1]] %>% dplyr::as_tibble())
+          depends(pkgref()$dependencies[[1]] %>% dplyr::as_tibble() %>% 
+                    mutate(package = stringr::str_replace(package, "\n", " ")) %>%
+                    mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])")))
         },
         error = function(e) {
           msg <- paste("Detailed dependency information is not available for package", selected_pkg$name())
@@ -79,7 +77,9 @@ packageDependenciesServer <- function(id, selected_pkg, user, parent) {
       )
       tryCatch(
         expr = {
-          suggests(pkgref()$suggests[[1]] %>% dplyr::as_tibble())
+          suggests(pkgref()$suggests[[1]] %>% dplyr::as_tibble()%>% 
+                     mutate(package = stringr::str_replace(package, "\n", " ")) %>%
+                     mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])")))
         },
         error = function(e) {
           msg <- paste("Detailed suggests information is not available for package", selected_pkg$name())
@@ -89,14 +89,14 @@ packageDependenciesServer <- function(id, selected_pkg, user, parent) {
         }
       )
       # this is so the dependencies is also a 0x2 tibble like suggests
-      if (rlang::is_empty(pkgref()$dependencies[[1]])) depends(dplyr::tibble(package = character(0), type = character(0)))
+      if (rlang::is_empty(pkgref()$dependencies[[1]])) depends(dplyr::tibble(package = character(0), type = character(0), name = character(0)))
 
       revdeps(pkgref()$reverse_dependencies[[1]] %>% as.vector())
       # send either depends() or both to build_dep_cards(), depending on toggled()
       if (toggled() == 0L) {
-        cards(build_dep_cards(data = depends(), loaded = loaded2_db()$name, toggled = 0L))
+        cards(build_dep_cards(data = depends(), loaded = session$userData$loaded2_db()$name, toggled = 0L))
       } else {
-        cards(build_dep_cards(data = dplyr::bind_rows(depends(), suggests()), loaded = loaded2_db()$name, toggled = 1L))
+        cards(build_dep_cards(data = dplyr::bind_rows(depends(), suggests()), loaded = session$userData$loaded2_db()$name, toggled = 1L))
       }
     })
 
@@ -132,13 +132,13 @@ packageDependenciesServer <- function(id, selected_pkg, user, parent) {
 
       if (!isTruthy(session$userData$repo_pkgs())) {
         if (isTRUE(getOption("shiny.testmode"))) {
-          session$userData$repo_pkgs(purrr::map_dfr(test_pkg_refs, ~ as.data.frame(.x)))
+          session$userData$repo_pkgs(purrr::map_dfr(test_pkg_refs, ~ as.data.frame(.x, col.names = c("Package", "Version", "Source"))))
         } else {
           session$userData$repo_pkgs(as.data.frame(utils::available.packages()[,1:2]))
         }
       }
-        
-      purrr::map_df(pkginfo$name, ~get_versnScore(.x, loaded2_db(), session$userData$repo_pkgs())) %>% 
+
+      purrr::map_df(pkginfo$name, ~get_versnScore(.x, session$userData$loaded2_db(), session$userData$repo_pkgs())) %>% 
         right_join(pkginfo, by = "name") %>% 
         select(package, type, name, version, score) %>%
         arrange(name, type) %>% 
@@ -162,7 +162,7 @@ packageDependenciesServer <- function(id, selected_pkg, user, parent) {
       ) %>% # remove action button if there is nothing to review
         mutate(Actions = if_else(identical(package, character(0)) | name %in% c(rownames(installed.packages(priority = "base"))), "", Actions)) %>% 
         # if package name not yet loaded, switch the actionbutton to fa-upload
-        mutate(Actions = if_else(!name %in% loaded2_db()$name, gsub("fas fa-arrow-right fa-regular", "fas fa-upload fa-solid", Actions), Actions))
+        mutate(Actions = if_else(!name %in% session$userData$loaded2_db()$name, gsub("fas fa-arrow-right fa-regular", "fas fa-upload fa-solid", Actions), Actions))
     })
 
     # Create metric grid card.
@@ -300,7 +300,7 @@ packageDependenciesServer <- function(id, selected_pkg, user, parent) {
        pkg_name <- pkg_df()[selectedRow, 3] %>% pull()
        pkgname("-")
 
-       if (!pkg_name %in% loaded2_db()$name) {
+       if (!pkg_name %in% session$userData$loaded2_db()$name) {
          pkgname(pkg_name)
          shiny::showModal(modalDialog(
            size = "l",
@@ -325,7 +325,7 @@ packageDependenciesServer <- function(id, selected_pkg, user, parent) {
          updateSelectizeInput(
            session = parent,
            inputId = "sidebar-select_pkg",
-           choices = c("-", loaded2_db()$name),
+           choices = c("-", session$userData$loaded2_db()$name),
            selected = pkg_name
          )
        }
@@ -378,7 +378,7 @@ packageDependenciesServer <- function(id, selected_pkg, user, parent) {
     })
 
     observeEvent(input$update_all_packages, {
-      req(pkg_df(), loaded2_db(), pkg_updates)
+      req(pkg_df(), session$userData$loaded2_db(), pkg_updates)
       rev_pkg(0L)
 
       pkgname(pkg_updates$pkgs_update$name)
@@ -397,7 +397,7 @@ packageDependenciesServer <- function(id, selected_pkg, user, parent) {
     })
 
     observeEvent(input$incl_suggests, {
-      req(pkg_df(), loaded2_db())
+      req(pkg_df(), session$userData$loaded2_db())
       if(input$incl_suggests == TRUE | toggled() == 1L) toggled(1L - isolate(toggled()))
     })
 

diff --git a/R/mod_reportPreview.R b/R/mod_reportPreview.R
@@ -35,10 +35,10 @@ reportPreviewUI <- function(id) {
 #' @importFrom shinyjs enable disable show hide disabled
 #' @keywords internal
 #' 
-reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
+reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, 
                                 com_metrics_raw, mm_comments, cm_comments, #se_comments,
-                                downloads_plot_data, user, credentials, app_version,
-                                metric_weights) {
+                                downloads_plot_data, user, credentials, 
+                                app_version, metric_weights) {
   if (missing(credentials))
     credentials <- get_credential_config()
 
@@ -172,6 +172,33 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
                 )
               } else "",
 
+              if('Package Dependencies' %in% report_includes()) {
+                tagList(
+                  br(), br(),
+                  hr(),
+                  fluidRow(
+                    column(width = 12,
+                           h5("Package Dependencies",
+                              style = "text-align: center; padding-bottom: 50px;"),
+                             metricGridUI(session$ns('dep_metricGrid'))
+                    )
+                  ),
+                  br(), br(),
+                  fluidRow(
+                    column(width = 12,
+                           DT::renderDataTable({
+                             req(selected_pkg$name())
+
+                             dep_table()
+
+                           }, options = list(dom = "t", searching = FALSE, pageLength = -1, lengthChange = FALSE,
+                                             info = FALSE,
+                                             columnDefs = list(list(className = 'dt-center', targets = 2))
+                           )
+                           )
+                    ))
+                )
+              } else "",
 
               if(any(c('Source Explorer Comments') %in% report_includes())) {
                 tagList(
@@ -402,6 +429,38 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
     # Community usage metrics cards.
     metricGridServer("cm_metricGrid", metrics = com_metrics)
 
+    observe({
+      if (!isTruthy(session$userData$repo_pkgs())) {
+        if (isTRUE(getOption("shiny.testmode"))) {
+          session$userData$repo_pkgs(purrr::map_dfr(test_pkg_refs, ~ as.data.frame(.x, col.names = c("Package", "Version", "Source"))))
+        } else {
+          session$userData$repo_pkgs(as.data.frame(utils::available.packages()[,1:2]))
+        }
+      }
+    })
+
+    dep_metrics <- eventReactive(selected_pkg$name(), {
+      get_depends_data(selected_pkg$name())
+    })
+
+    dep_cards <- eventReactive(dep_metrics(), {
+      req(dep_metrics())
+      build_dep_cards(data = dep_metrics(), loaded = session$userData$loaded2_db()$name, toggled = 0L)
+    })
+
+    # Package Dependencies metrics cards.
+    metricGridServer("dep_metricGrid", metrics = dep_cards)
+
+    dep_table <- eventReactive(dep_metrics(), {
+      req(dep_metrics())
+
+      purrr::map_df(dep_metrics()$name, ~get_versnScore(.x, session$userData$loaded2_db(), session$userData$repo_pkgs())) %>%
+      right_join(dep_metrics(), by = "name") %>%
+      select(package, type, version, score) %>%
+      arrange(package, type) %>%
+      distinct()
+    })
+
     output$communityMetrics_ui <- renderUI({
       req(selected_pkg$name())
 

diff --git a/R/mod_uploadPackage.R b/R/mod_uploadPackage.R
@@ -142,7 +142,7 @@ uploadPackageServer <- function(id, user, auto_list, credentials, parent) {
     observeEvent(input$load_repo_pkgs, {
       if (!isTruthy(session$userData$repo_pkgs())) {
         if (isTRUE(getOption("shiny.testmode"))) {
-          session$userData$repo_pkgs(purrr::map_dfr(test_pkg_refs, ~ as.data.frame(.x)))
+          session$userData$repo_pkgs(purrr::map_dfr(test_pkg_refs, ~ as.data.frame(.x, col.names = c("Package", "Version", "Source"))))
         } else {
           session$userData$repo_pkgs(as.data.frame(utils::available.packages()[,1:2]))
         }
@@ -362,7 +362,7 @@ uploadPackageServer <- function(id, user, auto_list, credentials, parent) {
 
       if (!isTruthy(session$userData$repo_pkgs())) {
         if (isTRUE(getOption("shiny.testmode"))) {
-          session$userData$repo_pkgs(purrr::map_dfr(test_pkg_refs, ~ as.data.frame(.x)))
+          session$userData$repo_pkgs(purrr::map_dfr(test_pkg_refs, ~ as.data.frame(.x, col.names = c("Package", "Version", "Source"))))
         } else {
           session$userData$repo_pkgs(as.data.frame(utils::available.packages()[,1:2]))
         }

diff --git a/R/sysdata.rda b/R/sysdata.rda
diff --git a/R/utils_build_cards.R b/R/utils_build_cards.R
@@ -242,8 +242,6 @@ build_dep_cards <- function(data, loaded, toggled){
   )
 
   deps <- data %>% 
-    mutate(package = stringr::str_replace(package, "\n", "")) %>% 
-    mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])")) %>% 
     mutate(base = if_else(name %in% c(rownames(installed.packages(priority = "base"))), "Base", "Tidyverse")) %>% 
     mutate(base = factor(base, levels = c("Base", "Tidyverse"), labels = c("Base", "Tidyverse"))) %>% 
     mutate(upld = if_else(name %in% loaded, 1, 0))