Add Package Dependencies to Reports

NEWS.md

@@ -6,6 +6,7 @@
 * Added tests for the code and function explorers
 * Added repo specification to configuration file (#701)
 * Fix typo in Privileges table (#719)
+* Added Package Dependencies to Reports (#721)
 
 # riskassessment 3.0.0
 

R/app_server.R

@@ -199,7 +199,7 @@ app_server <- function(input, output, session) {
   # Load server of the database view module.
   #parentSession <- .subset2(session, "parent")
   databaseViewServer("databaseView", user, uploaded_pkgs,
-                     metric_weights = metric_weights, changes, parent = session)
+                     metric_weights = metric_weights, dep_metrics, loaded2_db, changes, parent = session)
 
   # Gather maintenance metrics information.
   maint_metrics <- reactive({
@@ -218,6 +218,38 @@ app_server <- function(input, output, session) {
     get_comm_data(selected_pkg$name())
   })
 
+  loaded2_db <- eventReactive(selected_pkg$name(), {
+    req(selected_pkg$name())
+    req(selected_pkg$name() != "-")
+
+    dbSelect("SELECT name, version, score FROM package")
+  })
+
+  # Get Package Dependency metrics.
+  dep_metrics  <- reactiveVal()
+
+  pkgref <- eventReactive(selected_pkg$name(), {
+    req(selected_pkg$name())
+    req(selected_pkg$name() != "-")
+
+    get_assess_blob(selected_pkg$name())
+  })
+
+  observeEvent(pkgref(), {
+    req(pkgref())
+    tryCatch(
+      expr = {
+        dep_metrics(pkgref()$dependencies[[1]] %>% dplyr::as_tibble())
+      },
+      error = function(e) {
+        msg <- paste("Detailed dependency information is not available for package", selected_pkg$name())
+        rlang::warn(msg)
+        rlang::warn(paste("info:", e))
+        dep_metrics(dplyr::tibble(package = character(0), type = character(0), name = character(0)))
+      }
+    )
+  })
+
   create_src_dir <- eventReactive(input$tabs, input$tabs == "Source Explorer")
   pkgdir <- reactiveVal()
   observe({
@@ -266,6 +298,13 @@ 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,
+                                                  loaded2_db,
+                                                  user,
+                                                  parent = session)
 
   # Load server of the report preview tab.
   reportPreviewServer(id = "reportPreview",
@@ -277,17 +316,14 @@ app_server <- function(input, output, session) {
                       cm_comments = community_data$comments,
                       # se_comments = src_explorer_data$comments, # not an arg
                       downloads_plot_data = community_data$downloads_plot_data,
+                      dep_metrics =  dep_metrics,
+                      loaded2_db,
                       user = user,
                       credential_config,
                       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)
   })

R/mod_databaseView.R

@@ -98,6 +98,8 @@ databaseViewUI <- function(id) {
 #' @param user a user name
 #' @param uploaded_pkgs a vector of uploaded package names
 #' @param metric_weights a reactive data.frame holding metric weights
+#' @param dep_metrics placeholder
+#' @param loaded2_db placeholder
 #' @param changes a reactive value integer count
 #' @param parent the parent (calling module) session information
 #'
@@ -112,7 +114,7 @@ databaseViewUI <- function(id) {
 #' @importFrom formattable formattable as.datatable formatter style csscolor
 #'   icontext
 #' @keywords internal
-databaseViewServer <- function(id, user, uploaded_pkgs, metric_weights, changes, parent) {
+databaseViewServer <- function(id, user, uploaded_pkgs, metric_weights, dep_metrics, loaded2_db, changes, parent) {
   moduleServer(id, function(input, output, session) {
 
     ns = session$ns
@@ -302,6 +304,7 @@ 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)
+    mod_downloadHandler_server("downloadHandler", pkgs, user, metric_weights, dep_metrics, loaded2_db)
+
   })
 }

R/mod_downloadHandler.R

@@ -101,7 +101,7 @@ mod_downloadHandler_include_server <- function(id) {
 #' downloadHandler Server Functions
 #'
 #' @noRd 
-mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){
+mod_downloadHandler_server <- function(id, pkgs, user, metric_weights, dep_metrics, loaded2_db){
   moduleServer( id, function(input, output, session){
     ns <- session$ns
 
@@ -256,8 +256,20 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){
               comm_cards <- build_comm_cards(comm_data)
               downloads_plot <- build_comm_plotly(comm_data)
               metric_tbl <- dbSelect("select * from metric", db_name = golem::get_golem_options('assessment_db_name'))
-
-
+              dep_cards <- build_dep_cards(data = dep_metrics(), loaded = loaded2_db()$name, toggled = 0L)
+
+              pkginfo <- dep_metrics() %>% 
+                  mutate(package = stringr::str_replace(package, "\n", " ")) %>%
+                  mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])"))
+
+              repo_pkgs <- as.data.frame(utils::available.packages()[,1:2])
+
+              dep_table <- purrr::map_df(pkginfo$name, ~get_versnScore(.x, loaded2_db(), repo_pkgs)) %>%
+                  right_join(pkginfo, by = "name") %>%
+                  select(package, type, name, version, score) %>%
+                  arrange(name, type) %>%
+                  distinct()
+
               # Render the report, passing parameters to the rmd file.
               rmarkdown::render(
                 input = Report,
@@ -280,6 +292,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
                 )
               )

R/mod_packageDependencies.R

@@ -11,6 +11,7 @@ packageDependenciesUI <- function(id) {
 #'
 #' @param id a module id name
 #' @param selected_pkg placeholder
+#' @param loaded2_db placeholder
 #' @param user placeholder
 #' @param parent the parent (calling module) session information
 #'
@@ -27,14 +28,10 @@ packageDependenciesUI <- function(id) {
 #'
 #' @keywords internal
 #'
-packageDependenciesServer <- function(id, selected_pkg, user, parent) {
+packageDependenciesServer <- function(id, selected_pkg, loaded2_db, 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)

R/mod_reportPreview.R

@@ -20,6 +20,8 @@ reportPreviewUI <- function(id) {
 #' @param mm_comments placeholder
 #' @param cm_comments placeholder
 #' @param downloads_plot_data placeholder
+#' @param dep_metrics placeholder
+#' @param loaded2_db placeholder
 #' @param user placeholder
 #' @param app_version placeholder
 #' @param metric_weights placeholder
@@ -35,10 +37,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, dep_metrics, loaded2_db, user, credentials, 
+                                app_version, metric_weights) {
   if (missing(credentials))
     credentials <- get_db_config("credentials")
 
@@ -172,6 +174,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 = 8,
+                           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 +431,28 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
     # Community usage metrics cards.
     metricGridServer("cm_metricGrid", metrics = com_metrics)
 
+    dep_cards <- eventReactive(dep_metrics(), {
+      req(dep_metrics())
+      build_dep_cards(data = dep_metrics(), loaded = loaded2_db()$name, toggled = 0L)
+    })
+
+    # Package Dependencies metrics cards.
+    metricGridServer("dep_metricGrid", metrics = dep_cards)
+
+    dep_table <- eventReactive(dep_metrics(), {
+      req(dep_metrics())
+      pkginfo <- dep_metrics() %>% 
+        mutate(package = stringr::str_replace(package, "\n", " ")) %>%
+        mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])"))
+
+      repo_pkgs <- as.data.frame(utils::available.packages()[,1:2])
+      purrr::map_df(pkginfo$name, ~get_versnScore(.x, loaded2_db(), repo_pkgs)) %>%
+      right_join(pkginfo, by = "name") %>%
+      select(package, type, name, version, score) %>%
+      arrange(name, type) %>%
+      distinct()
+    })
+
     output$communityMetrics_ui <- renderUI({
       req(selected_pkg$name())
 
@@ -456,7 +507,7 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
 
       tagList(
         h5(code('{riskmetric}'), 'Assessment Date:'), selected_pkg$date_added(),
-        if('Risk Score' %in% report_includes()) tagList(h5('Risk Score:'), selected_pkg$score()) else "",
+        if('Risk Score' %in% report_includes()) tagList(hr(), br(), h5('Risk Score:'), selected_pkg$score()) else "",
         h5('Package Decision:'),ifelse(is.na(selected_pkg$decision()), 'Pending',selected_pkg$decision())
       )
     })
@@ -485,6 +536,6 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
     )
 
     # Call download handler server
-    mod_downloadHandler_server("downloadHandler", selected_pkg$name, user, metric_weights)
+    mod_downloadHandler_server("downloadHandler", selected_pkg$name, user, metric_weights, dep_metrics, loaded2_db)
   })
 }

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, 

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}