Merge pull request #734 from pharmaR/rk-721-pkgdeps_report

Add Package Dependencies to Reports, Part I
pharmaR · Jan 17, 2024 · 8e5f638 · 8e5f638
2 parents ec5965b + 87c0ba4
commit 8e5f638
Show file tree

Hide file tree

Showing 21 changed files with 474 additions and 90 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -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,6 +10,7 @@
 * Only run configuration checkers when configuring the database
 * Added dependencies/reverse dependencies card hyperlink (#597)
 * Added non-shinymanager deployment option (#700)
+* Added Package Dependencies to Reports (#721)
 
 # 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)
@@ -94,9 +90,9 @@ packageDependenciesServer <- function(id, selected_pkg, user, parent) {
       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 +128,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 +158,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 +296,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 +321,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 +374,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 +393,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
@@ -129,7 +129,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]))
         }
@@ -349,7 +349,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)) 

diff --git a/R/utils_get_db.R b/R/utils_get_db.R
@@ -214,6 +214,31 @@ get_metric_data <- function(pkg_name, metric_class = 'maintenance', db_name = go
     )
 }
 
+#' The 'Get Dependencies Metrics Data' function
+#' 
+#' Pull the depenencies data for a specific package id, and create 
+#' necessary columns for Cards UI
+#' 
+#' @param pkg_name character name of package
+#' @param db_name character name (and file path) of the database
+#' 
+#' @import dplyr
+#' @importFrom stringr str_replace
+#' 
+#' @returns a data frame with package, type, and name
+#' @noRd
+get_depends_data <- function(pkg_name, db_name = golem::get_golem_options('assessment_db_name')){
+
+pkgref <- get_assess_blob(pkg_name, db_name)
+
+if(suppressWarnings(is.null(pkgref$dependencies[[1]]))) {
+  dplyr::tibble(package = character(0), type = character(0), name = character(0))
+  } else {
+    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]]*)|[.])")) 
+  }
+}
 
 #' The 'Get Community Data' function
 #' 

diff --git a/data-raw/internal-data.R b/data-raw/internal-data.R
@@ -93,7 +93,7 @@ metric_lst <- c("1"='has_vignettes', "2"='has_news', "3"='news_current', "4"='ha
 
 rpt_choices <- c("Report Author", "Report Date", "Risk Score", "Overall Comment", "Package Summary",
                  "Maintenance Metrics", "Maintenance Comments", "Community Usage Metrics", "Community Usage Comments",
-                 "Source Explorer Comments", "Function Explorer Comments")
+                 "Package Dependencies", "Source Explorer Comments", "Function Explorer Comments")
 
 usethis::use_data(
   # app_version, 

diff --git a/inst/report_downloads/header.docx b/inst/report_downloads/header.docx
diff --git a/inst/report_downloads/header.tex b/inst/report_downloads/header.tex
@@ -1,6 +1,8 @@
 \usepackage{graphicx}
 \usepackage{fancyhdr}
 \usepackage{unicode-math}
+\usepackage{booktabs}
+\usepackage{tabularx}
 \fancypagestyle{plain}{\pagestyle{fancy}}
 \fancyhf{}% Clear header/footer
 \setlength{\headheight}{15pt}
-Original file line number
+Diff line change
@@ Expand Up / @@ -47,6 +47,7 @@ Imports: @@
         desc,
         dplyr,
         DT,
+        flextable,
         formattable,
         glue,
         golem (>= 0.3.2),
@@ Expand Down @@