Merge pull request #590 from pharmaR/rk-573-riskmetric_cards

Rk 573 riskmetric cards

NEWS.md

@@ -9,6 +9,7 @@
 * Prominently display the date a package was added (#486)
 * Fix issue where the repository being used to gather information was inconsistent
 * Added Package Dependencies page to "Package Metrics" tab, and two new cards to Maintenance Metrics page (#261)
+* Identify non-riskmetric cards (#573)
 
 ### Squashed Bugs
 * Fixed busted button introduced with #547 (#592)

R/mod_downloadHandler.R

@@ -235,6 +235,8 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){
               comm_data <- get_comm_data(this_pkg)
               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'))
+
 
               # Render the report, passing parameters to the rmd file.
               rmarkdown::render(
@@ -256,7 +258,8 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){
                               maint_metrics = mm_data,
                               com_metrics = comm_cards,
                               com_metrics_raw = comm_data,
-                              downloads_plot_data = downloads_plot
+                              downloads_plot_data = downloads_plot,
+                              metric_tbl = metric_tbl
                 )
               )
               fs <- c(fs, path)  # Save all the reports/

R/mod_metricBox.R

@@ -18,10 +18,11 @@ metricBoxUI <- function(id) {
 #' @param succ_icon icon used if is_true.
 #' @param unsucc_icon icon used if not is_true.
 #' @param icon_class string type of icon
+#' @param type string to color the icon ("information" or "danger")
 #'
 #'
 #' @import dplyr
-#' @importFrom stringr str_sub
+#' @importFrom stringr str_sub str_extract
 #' @importFrom glue glue
 #' @keywords internal
 #'
@@ -30,6 +31,9 @@ metricBoxServer <- function(id, title, desc, value,
                             succ_icon = "check", unsucc_icon = "times",
                             icon_class = "text-success", type = "information") {
   moduleServer(id, function(input, output, session) {
+
+    metric <- dbSelect("select * from metric", db_name = golem::get_golem_options('assessment_db_name'))
+
     # Render metric.
     output$metricBox_ui <- renderUI({
       req(title, desc)
@@ -63,6 +67,11 @@ metricBoxServer <- function(id, title, desc, value,
         icon_class <- "text-info"
       }
 
+      # add asterisk to title if it is not in the metric table
+      # skip databaseView cards
+      title = if_else(stringr::str_extract(session$ns(id), "\\w+") != "databaseView" 
+                      & !title %in% metric$long_name, paste0(title, "*"), title)
+
       # define some styles prior to building card
       card_style <- "max-width: 400px; max-height: 250px; padding-left: 5%; padding-right: 5%;" # overflow-y: scroll;
       auto_font_out <- auto_font(value,

R/mod_metricGrid.R

@@ -17,20 +17,24 @@ metricGridUI <- function(id) {
 #' @keywords internal
 #' 
 #' @import dplyr
+#' @importFrom stringr str_extract
 metricGridServer <- function(id, metrics) {
   moduleServer(id, function(input, output, session) {
 
+    metric <- dbSelect("select * from metric", db_name = golem::get_golem_options('assessment_db_name'))
 
     output$grid <- renderUI({
       req(nrow(metrics()) > 1) # need at least two cards to make a metric grid UI
-      
+
       columns <- 3
-      rows <- ceiling(nrow(metrics()) / columns)
       column_vector_grid_split <- split(seq_len(nrow(metrics())), rep(1:columns, length.out = nrow(metrics())))
 
       fluidRow(style = "padding-right: 10px", class = "card-group",
                map(column_vector_grid_split, 
-                   ~ column(width= 4,map(.x,~ metricBoxUI(session$ns(metrics()$name[.x])))))
+                   ~ column(width= 4,map(.x,~ metricBoxUI(session$ns(metrics()$name[.x]))))),
+      if(any(!(metrics()$title %in% metric$long_name)) & stringr::str_extract(session$ns(id), "\\w+") != "databaseView") {
+        tags$em("* Provided for additional context. Not a {riskmetric} assessment, so this measure will not impact the risk score.")
+      } 
       )
     })
 

R/utils.R

@@ -646,16 +646,15 @@ build_comm_plotly <- function(data = NULL, pkg_name = NULL) {
   default_range <- c(
     max(downloads_data$day_month_year) - 45 - (365 * 2),
     max(downloads_data$day_month_year) + 15)
-
-
 
   # plot
   plot <- plotly::plot_ly(
     downloads_data,
     x = ~day_month_year,
     y = ~downloads,
     name = "# Downloads", type = 'scatter', 
-    mode = 'lines+markers', line = list(color = '#1F9BCF'),
+    mode = 'lines+markers', 
+    line = list(color = '#1F9BCF'),
     marker = list(color = '#1F9BCF'),
     hoverinfo = "text",
     text = ~glue::glue(

inst/report_downloads/reportDocx.Rmd

@@ -26,6 +26,7 @@ params:
   com_metrics: NA
   com_metrics_raw: NA
   downloads_plot_data: NA
+  metric_tbl: NA
 ---
 
 <!-- ![](raa-image.png){style="position:float-right; width:63px; height:52px;"} -->

inst/report_downloads/reportHtml.Rmd

@@ -29,6 +29,7 @@ params:
   com_metrics: NA
   com_metrics_raw: NA
   downloads_plot_data: NA
+  metric_tbl: NA
 ---
 
 <style type="text/css">
@@ -52,13 +53,15 @@ knitr::opts_chunk$set(echo = F, fig.width = 5.5, fig.height = 3.4)
 
 
 ```{r functions, echo=FALSE, include=FALSE, message=FALSE, warning=FALSE}
+
 createCard <- function(title, desc, value, is_perc = FALSE, is_url = FALSE,
                        succ_icon = "check",  unsucc_icon = "times",
                        icon_class = "text-success"){
+  
   # A str length of 41 chars tends to wrap to two rows and look quite nice
   val_max_nchar <- 31
   is_true <- !(value %in% c(0, "pkg_metric_error", "NA", "", 'FALSE'))
-
+  
   if(value %in% c("pkg_metric_error", "NA"))
     value <- "Not found"
   else if(is_perc)
@@ -83,6 +86,11 @@ createCard <- function(title, desc, value, is_perc = FALSE, is_url = FALSE,
     icon_name <- "percent"
     icon_class <- "text-info"
   }
+  
+  # add asterisk to title if it is not in the metric table
+  # There are no databaseView cards here.
+  title = if_else(!title %in% metric_tbl$long_name, paste0(title, "*"), title)
+  
 # overflow-y: scroll;
   card_style <- "max-width: 400px; max-height: 250px; padding-left: 5%; padding-right: 5%;" 
   auto_font_out <- auto_font(value, txt_max = val_max_nchar,
@@ -108,7 +116,7 @@ createCard <- function(title, desc, value, is_perc = FALSE, is_url = FALSE,
 createGrid <- function(metrics){
 
   col_width <- 3
-
+  
   fluidRow(style = "padding-right: 10px", class = "card-group",
            column(width = 4, {
              lapply(X = seq(1, nrow(metrics), col_width), function(i){
@@ -148,8 +156,11 @@ createGrid <- function(metrics){
                           succ_icon = metrics$succ_icon[i],
                           icon_class = metrics$icon_class[i])
              })
-           })
-  )
+           }),
+        if(any(!(metrics$title %in% metric_tbl$long_name))) {
+        tags$em("* Provided for additional context. Not a {riskmetric} assessment, so this measure will not impact the risk score.")
+        }
+    )
 }
 ```
 

inst/report_downloads/reportPdf.Rmd

@@ -28,6 +28,7 @@ params:
   com_metrics: NA
   com_metrics_raw: NA
   downloads_plot_data: NA
+  metric_tbl: NA
 ---
 
 <style type="text/css">

inst/sql_queries/initialize_metric_table.sql

@@ -14,4 +14,4 @@ VALUES
 ('dependencies',        'Dependencies',      'Number of Package Dependencies',   0, 0, 'maintenance', 1),  
 ('reverse_dependencies','Reverse Dependencies', 'Number of Reverse Dependencies', 0, 0, 'community', 1),
 ('covr_coverage',       'Test Coverage',     '% of objects tested',     1, 0, 'maintenance', 1),
-('downloads_1yr',       'Downloads',         'Number of package downloads in the last year', 0, 0, 'community', 1);
+('downloads_1yr', 'Package Downloads', 'Number of downloads in last 12 months', 0, 0, 'community', 1);

tests/testthat/test-reportPreview.R

@@ -61,7 +61,7 @@ test_that("Reactivity of reportPreview", {
     rvest::html_text() %>% 
     paste(collapse = ", ")
 
-  str_expect <- "Vignettes, Report Bugs, Source Control, License, NEWS file, Website, Documentation, Test Coverage, NEWS current, Maintainer, Bugs Closure Rate, First Version Release, Reverse Dependencies, Latest Version Release, Monthly downloads trend, Package Downloads"
+  str_expect <- "Vignettes, Report Bugs, Source Control, License, NEWS file, Website, Documentation, Test Coverage, NEWS current, Maintainer, Bugs Closure Rate, First Version Release*, Reverse Dependencies*, Latest Version Release*, Monthly downloads trend*, Package Downloads*"
   expect_equal(maint_info, str_expect)
 
   app$stop()