diff --git a/DESCRIPTION b/DESCRIPTION index 9e8e5936e..594b92bc0 100644 --- 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 index d902838a7..a73fff296 100644 --- 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 index 33beb9873..65f680987 100644 --- 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 index 30eb53690..c72116914 100644 --- 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 index 05555476e..8c8e126a5 100644 --- 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 index d1a65a84c..6ab9467aa 100644 --- 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 index 2d658178f..7d40c52ba 100644 --- 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 index 04397a5ee..65dbfa6df 100644 --- 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 index 4cf531d96..0516aa4e8 100644 --- 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 index 3cd5b4b0b..fc293647d 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/utils_build_cards.R b/R/utils_build_cards.R index 650aede48..bf8252596 100644 --- 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 index 1446a9ff6..37a6e0801 100644 --- 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 index ab38bcf2a..86c1239d0 100644 --- 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 index 0b6cd4398..f1c6744a2 100644 Binary files a/inst/report_downloads/header.docx and b/inst/report_downloads/header.docx differ diff --git a/inst/report_downloads/header.tex b/inst/report_downloads/header.tex index 1e050a72f..09ffb6873 100644 --- 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} diff --git a/inst/report_downloads/reportDocx.Rmd b/inst/report_downloads/reportDocx.Rmd index 3e61a0f3d..8252754ca 100644 --- a/inst/report_downloads/reportDocx.Rmd +++ b/inst/report_downloads/reportDocx.Rmd @@ -27,6 +27,8 @@ params: com_metrics: NA com_metrics_raw: NA downloads_plot_data: NA + dep_cards: NA + dep_table: NA metric_tbl: NA --- @@ -40,6 +42,7 @@ params: ```{r setup, include=FALSE} library(knitr) +library(flextable) library(shiny) library(ggplot2) library(plotly) @@ -69,19 +72,19 @@ outputComments <- function(pkg_name, comments, none_txt = "No comments"){
```{r general_pkg_info} -h5('General Information') +h2('General Information') tagList( - strong('Package:'), br(), getElement(params$pkg, 'name'), br(), br(), - strong('Version:'), br(), getElement(params$pkg, 'version'), br(), br(), + strong('Package:'), getElement(params$pkg, 'name'), br(), br(), + strong('Version:'), getElement(params$pkg, 'version'), br(), br(), strong('Title:'), br(), getElement(params$pkg, 'title'), br(), br(), strong('Description:'), br(), getElement(params$pkg, 'description'), br(), br(), strong('Author:'), br(), getElement(params$pkg, 'author'), br(), br(), strong('Maintainer:'), br(), getElement(params$pkg, 'maintainer'), br(), br(), strong('License:'), br(), getElement(params$pkg, 'license'), br(), br(), - strong('Published:'), br(), getElement(params$pkg, 'published'), br(), br(), - strong(code('{riskmetric}'), 'Assessment Date:'), br(), getElement(params$pkg, 'date_added'), br(), br(), - if('Risk Score' %in% params$report_includes) tagList(strong('Risk Score:'), br(), getElement(params$pkg, 'score'), br(), br()) else "", - strong('Package Decision:'), br(), ifelse(is.na(params$pkg[['decision']]), 'Pending', params$pkg[['decision']]) + strong('Published:'), getElement(params$pkg, 'published'), br(), br(), + strong(code('{riskmetric}'), 'Assessment Date:'), getElement(params$pkg, 'date_added'), br(), br(), + if('Risk Score' %in% params$report_includes) tagList(strong('Risk Score:'), getElement(params$pkg, 'score'), br(), br()) else "", br(), + strong('Package Decision:'), ifelse(is.na(params$pkg[['decision']]), 'Pending', params$pkg[['decision']]) ) ``` @@ -128,6 +131,8 @@ tagList(br(), h2('Maintenance Metrics')) if('Maintenance Metrics' %in% params$report_includes){ params$maint_metrics %>% dplyr::mutate( + score = na_if(score, "NA"), + score = na_if(score, "NULL"), `Metric Name` = title, `Metric Description` = desc, `Metric Value` = dplyr::case_when( @@ -135,19 +140,21 @@ if('Maintenance Metrics' %in% params$report_includes){ !(name %in% c('has_bug_reports_url', 'news_current')) ~ value, value %in% c("TRUE","1") ~ 'Yes', TRUE ~ 'No'), - `Metric Score` = dplyr::case_when(toupper(score) %in% c("NA", "NULL") ~ "NA", + `Metric Score *` = dplyr::case_when(toupper(score) %in% c("NA", "NULL") ~ NA_character_, # flip the label display of the score to mimic the package score... round(as.numeric(score), 2) == 0 ~ "1.0", round(as.numeric(score), 2) == 1 ~ "0.0", TRUE ~ as.character(round(1 - as.numeric(score), 2)) ) ) %>% - dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`, `Metric Score`) %>% - knitr::kable(format = 'pandoc') + dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`, `Metric Score *`) %>% + flextable::flextable(cwidth = c(1.5, 2.0, 2.0, 1.25)) %>% + flextable::set_table_properties(align = "left") %>% + flextable::colformat_char(na_str = "NA") } ``` -`r if ('Maintenance Metrics' %in% params$report_includes) {"* Metrics whose score is NA will not impact the package {riskmetric} score"}` +`r if ('Maintenance Metrics' %in% params$report_includes) {"\\* Metrics whose score is NA will not impact the package {riskmetric} score"}` ```{r maintenance_metrics_comments} if('Maintenance Comments' %in% params$report_includes){ @@ -179,23 +186,27 @@ if (!cm_ind) { if('Community Usage Metrics' %in% params$report_includes){ params$com_metrics %>% dplyr::mutate( + score = na_if(score, "NA"), + score = na_if(score, "NULL"), `Metric Name` = title, `Metric Description` = desc, `Metric Value` = ifelse(value %in% c("pkg_metric_error", "NA", NA), "Not found", value), - `Metric Score` = dplyr::case_when(toupper(score) %in% c("NA", "NULL") ~ "NA", + `Metric Score *` = dplyr::case_when(toupper(score) %in% c("NA", "NULL") ~ NA_character_, # flip the label display of the score to mimic the package score... round(as.numeric(score), 2) == 0 ~ "1.0", round(as.numeric(score), 2) == 1 ~ "0.0", TRUE ~ as.character(round(1 - as.numeric(score), 2)) ) ) %>% - dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`, `Metric Score`) %>% - knitr::kable(format = 'pandoc') + dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`, `Metric Score *`) %>% + flextable::flextable(cwidth = c(1.5, 2.0, 2.0, 1.25)) %>% + flextable::set_table_properties(align = "left") %>% + flextable::colformat_char(na_str = "NA") } } ``` -`r if ('Community Usage Metrics' %in% params$report_includes) {"* Metrics whose score is NA will not impact the package {riskmetric} score"}` +`r if ('Community Usage Metrics' %in% params$report_includes) {"\\* Metrics whose score is NA will not impact the package {riskmetric} score"}` ```{r community_metrics_plot_title, eval=cm_ind} if('Community Usage Metrics' %in% params$report_includes){ @@ -243,6 +254,46 @@ if('Community Usage Comments' %in% params$report_includes){ } ``` +```{r package_dependencies_header} + if('Package Dependencies' %in% params$report_includes) { + tagList(br(), h2("Package Dependencies"), br()) + } else "" +``` + +```{r package_dependencies_cards} + if('Package Dependencies' %in% params$report_includes) { + cards <- params$dep_cards %>% + dplyr::mutate( + score = na_if(score, "NA"), + score = na_if(score, "NULL"), + `Metric Name` = title, + `Metric Description` = desc, + `Metric Value` = ifelse(value %in% c("pkg_metric_error", "NA", NA), "Not found", value), + `Metric Score *` = dplyr::case_when(toupper(score) %in% c("NA", "NULL") ~ NA_character_, + # flip the label display of the score to mimic the package score... + round(as.numeric(score), 2) == 0 ~ "1.0", + round(as.numeric(score), 2) == 1 ~ "0.0", + TRUE ~ as.character(round(1 - as.numeric(score), 2)) + ) + ) %>% + dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`, `Metric Score *`) + + flextable::flextable(cards, cwidth = c(1.5, 2.0, 2.0, 1.25)) %>% + flextable::set_table_properties(align = "left") %>% + flextable::colformat_char(na_str = "NA") + } else "" +``` + +`r if ('Package Dependencies' %in% params$report_includes) {"\\* Metrics whose score is NA will not impact the package {riskmetric} score"}` + +```{r package_dependencies_table} + if('Package Dependencies' %in% params$report_includes) { + flextable::flextable(params$dep_table, cwidth = c(1.5, 1.25, 1.25, 1.25)) %>% + flextable::set_table_properties(align = "left") + } else "" +``` + + ```{r source_explorer_metrics} if(any(c('Source Explorer Comments') %in% params$report_includes)) { diff --git a/inst/report_downloads/reportHtml.Rmd b/inst/report_downloads/reportHtml.Rmd index ab17a2a0c..53d0a71c3 100644 --- a/inst/report_downloads/reportHtml.Rmd +++ b/inst/report_downloads/reportHtml.Rmd @@ -30,6 +30,8 @@ params: com_metrics: NA com_metrics_raw: NA downloads_plot_data: NA + dep_cards: NA + dep_table: NA metric_tbl: NA --- @@ -368,6 +370,28 @@ tagList( ``` +```{r package_dependencies} +tagList( + if('Package Dependencies' %in% params$report_includes) { + tagList( + br(), + hr(), + br(), + h5("Package Dependencies", style = "text-align: center;"), + br(), + createGrid(metrics = params$dep_cards), + br(), + DT::datatable(params$dep_table, + options = list(dom = "t", searching = FALSE, pageLength = -1, + lengthChange = FALSE, info = FALSE, + columnDefs = list(list(className = 'dt-center', targets = 2)))) + ) + + } else "" +) +``` + + ```{r source_explorer} tagList( if(any(c('Source Explorer Comments') %in% params$report_includes)) { @@ -429,7 +453,7 @@ tagList( strong('{riskassessment} App Version:'), br(), getElement(params, 'app_version'), br(), br(), strong('{riskmetric} Version:'), br(), getElement(params, 'riskmetric_version'), br(), br(), strong('Generated on:'), br(), format(Sys.time(), usetz = TRUE), br(), br(), - if('Risk Score' %in% params$report_includes) strong('Metric Weights:') else "" + if('Risk Score' %in% params$report_includes) tagList(hr(),br(),strong('Metric Weights:')) else "" ) if('Risk Score' %in% params$report_includes) { diff --git a/inst/report_downloads/reportPdf.Rmd b/inst/report_downloads/reportPdf.Rmd index 444f5ff56..bb7f7f075 100644 --- a/inst/report_downloads/reportPdf.Rmd +++ b/inst/report_downloads/reportPdf.Rmd @@ -3,6 +3,7 @@ title: "R Package Risk Assessment" subtitle: "Report for Package: `r params$pkg[['name']]`" author: " `r if('Report Author' %in% params$report_includes) paste0('Author (Role): ', params$user_name, ' (', params$user_role, ')') else ''`" date: " `r if('Report Date' %in% params$report_includes) paste0('Report Date: ', format(Sys.time(), '%B %d, %Y')) else ''`" +geometry: "left=.5in,right=.5in,top=1.5in,bottom=1in" output: pdf_document: latex_engine: xelatex @@ -29,6 +30,8 @@ params: com_metrics: NA com_metrics_raw: NA downloads_plot_data: NA + dep_cards: NA + dep_table: NA metric_tbl: NA --- @@ -44,10 +47,13 @@ library(shiny) library(ggplot2) library(plotly) +options(tinytex.verbose = TRUE) knitr::opts_chunk$set(echo = F, fig.width = 5.5, fig.height = 3.4) cm_ind <- nrow(params$com_metrics) != 0 ``` + +`r {"\\setlength{\\headheight}{53.61403pt}\\addtolength{\\topmargin}{-38.61403pt}"}` ```{r functions, include=FALSE, message=FALSE, warning=FALSE} outputComments <- function(pkg_name, comments, none_txt = "No comments"){ @@ -67,7 +73,6 @@ outputComments <- function(pkg_name, comments, none_txt = "No comments"){ } ``` -
```{r general_pkg_info} tagList( @@ -100,6 +105,7 @@ if('Overall Comment' %in% params$report_includes){ } ``` + ```{r pkg_summary} if('Package Summary' %in% params$report_includes){ tagList( @@ -115,7 +121,7 @@ if('Package Summary' %in% params$report_includes){ } ``` -`r if(any(c('Maintenance Metrics', 'Maintenance Comments') %in% params$report_includes)) {"\\newpage"}` +`r if(any(c('Maintenance Metrics', 'Maintenance Comments') %in% params$report_includes)) {"\\newpage "}` ```{r maintenance_metrics} if(any(c('Maintenance Metrics', 'Maintenance Comments') %in% params$report_includes)) { @@ -124,33 +130,40 @@ if(any(c('Maintenance Metrics', 'Maintenance Comments') %in% params$report_inclu ``` -```{r maintenance_metrics_table, warning=FALSE, message=FALSE, error=FALSE, results='HIDE', echo=FALSE} +```{r maintenance_metrics_table, warning=FALSE, message=FALSE, error=FALSE, results='markdown', echo=FALSE} if('Maintenance Metrics' %in% params$report_includes){ - # maint_out_tab <- - params$maint_metrics %>% - dplyr::mutate( - `Metric Name` = title, - `Metric Description` = desc, - `Metric Value` = dplyr::case_when( - value %in% c("pkg_metric_error", "NA", NA) ~ "Not found", - # name %in% c('has_website', 'has_source_control') & nchar(value) > 5 ~ 'Yes', - # stringr::str_wrap(sub("\\s+$", "", gsub('(.{20})', '\\1 ', value)), 20), # text-wrap - value %in% c("TRUE","1") ~ 'Yes', - !(name %in% c('has_bug_reports_url', 'news_current')) ~ value, - TRUE ~ 'No' - ), - `Metric Score` = dplyr::case_when(toupper(score) %in% c("NA", "NULL") ~ "NA", - # flip the label display of the score to mimic the package score... - round(as.numeric(score), 2) == 0 ~ "1.0", - round(as.numeric(score), 2) == 1 ~ "0.0", - TRUE ~ as.character(round(1 - as.numeric(score), 2)) - ) - ) %>% - dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`, `Metric Score`) %>% - knitr::kable(format = 'pandoc') +params$maint_metrics %>% + dplyr::mutate( + `Metric Name` = title, + `Metric Description` = desc, + `Metric Value` = dplyr::case_when( + value %in% c("pkg_metric_error", "NA", NA) ~ "Not found", + value %in% c("TRUE","1") ~ 'Yes', + !(name %in% c('has_bug_reports_url', 'news_current')) ~ value, + TRUE ~ 'No' + ), + score = na_if(score, "NA"), + score = na_if(score, "NULL"), + `Metric Score *` = dplyr::case_when(toupper(score) %in% c("NA", "NULL") ~ NA_character_, + # flip the label display of the score to mimic the package score... + round(as.numeric(score), 2) == 0 ~ "1.0", + round(as.numeric(score), 2) == 1 ~ "0.0", + TRUE ~ as.character(round(1 - as.numeric(score), 2)) + ) + ) %>% + # add a space after the .com + dplyr::mutate(`Metric Value` = stringr::str_replace(`Metric Value`, stringr::regex("^(.+\\.com\\/)"), "\\1 ")) %>% + dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`, `Metric Score *`) %>% + kableExtra::kbl(format = 'latex', booktabs = T, linesep = "") %>% + kableExtra::kable_styling("basic", latex_options = "hold_position", full_width = F, position = 'left') %>% + kableExtra::column_spec(1, width = "1.0in") %>% + kableExtra::column_spec(2, width = "1.75in", latex_valign = "p") %>% + kableExtra::column_spec(3, width = "2.0in", latex_valign = "p") %>% + kableExtra::column_spec(4, width = "1.0in") } ``` -`r if ('Maintenance Metrics' %in% params$report_includes) {"* Metrics whose score is NA will not impact the package {riskmetric} score"}` + +`r if ('Maintenance Metrics' %in% params$report_includes) {"\\* Metrics whose score is NA will not impact the package {riskmetric} score"}` ```{r maintenance_metrics_comments} if('Maintenance Comments' %in% params$report_includes){ @@ -165,7 +178,7 @@ if('Maintenance Comments' %in% params$report_includes){ ``` -`r if(any(c('Community Usage Metrics', 'Community Usage Comments') %in% params$report_includes)) {"\\newpage"}` +`r if(any(c('Community Usage Metrics', 'Community Usage Comments') %in% params$report_includes)) {"\\newpage "}` ```{r community_metrics, warning=FALSE, message=FALSE} if(any(c('Community Usage Metrics', 'Community Usage Comments') %in% params$report_includes)) { @@ -174,7 +187,7 @@ if(any(c('Community Usage Metrics', 'Community Usage Comments') %in% params$repo ``` -```{r community_metrics_table, warning=FALSE, message=FALSE, error=FALSE, results='HIDE', echo=FALSE} +```{r community_metrics_table, warning=FALSE, message=FALSE, error=FALSE, results='markdown', echo=FALSE} if (!cm_ind) { h6(glue::glue("Community Usage Metrics not avaiable for {params$pkg$name}"), style = "text-align: center; color: gray; padding-top: 50px;") @@ -182,22 +195,26 @@ if (!cm_ind) { if('Community Usage Metrics' %in% params$report_includes){ params$com_metrics %>% dplyr::mutate( + score = na_if(score, "NA"), + score = na_if(score, "NULL"), `Metric Name` = title, `Metric Description` = desc, `Metric Value` = ifelse(value %in% c("pkg_metric_error", "NA", NA), "Not found", value), - `Metric Score` = dplyr::case_when(toupper(score) %in% c("NA", "NULL") ~ "NA", + `Metric Score *` = dplyr::case_when(toupper(score) %in% c("NA", "NULL") ~ NA_character_, # flip the label display of the score to mimic the package score... round(as.numeric(score), 2) == 0 ~ "1.0", round(as.numeric(score), 2) == 1 ~ "0.0", TRUE ~ as.character(round(1 - as.numeric(score), 2)) ) ) %>% - dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`, `Metric Score`) %>% - knitr::kable(format = 'pandoc') + dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`, `Metric Score *`) %>% + kableExtra::kbl(format = 'latex', booktabs = T, linesep = "") %>% + kableExtra::kable_styling("basic", latex_options = "hold_position", full_width = F, position = 'left') } } ``` -`r if ('Community Usage Metrics' %in% params$report_includes) {"* Metrics whose score is NA will not impact the package {riskmetric} score"}` + +`r if ('Community Usage Metrics' %in% params$report_includes) {"\\* Metrics whose score is NA will not impact the package {riskmetric} score"}` ```{r community_metrics_plot_title, eval=cm_ind} @@ -246,9 +263,50 @@ if('Community Usage Comments' %in% params$report_includes){ } ``` +`r if('Package Dependencies' %in% params$report_includes) {"\\newpage "}` +```{r package_dependencies_header} + if('Package Dependencies' %in% params$report_includes) { + tagList(br(), h2("Package Dependencies"), br()) + } else "" +``` -`r if(any(c('Source Explorer Comments') %in% params$report_includes)) {"\\newpage"}` +```{r package_dependencies_cards} + if('Package Dependencies' %in% params$report_includes) { + cards <- params$dep_cards %>% + dplyr::mutate( + score = na_if(score, "NA"), + score = na_if(score, "NULL"), + `Metric Name` = title, + `Metric Description` = desc, + `Metric Value` = ifelse(value %in% c("pkg_metric_error", "NA", NA), "Not found", value), + `Metric Score *` = dplyr::case_when(toupper(score) %in% c("NA", "NULL") ~ "NA", + # flip the label display of the score to mimic the package score... + round(as.numeric(score), 2) == 0 ~ "1.0", + round(as.numeric(score), 2) == 1 ~ "0.0", + TRUE ~ as.character(round(1 - as.numeric(score), 2)) + ) + ) %>% + dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`, `Metric Score *`) + + kableExtra::kbl(cards, format = 'latex', booktabs = T, linesep = "") %>% + kableExtra::kable_styling("basic", latex_options = "hold_position", full_width = F, position = 'left') %>% + kableExtra::column_spec(3, width = "1.5in", latex_valign = "p") + + } else "" +``` + +`r if ('Package Dependencies' %in% params$report_includes) {"\\* Metrics whose score is NA will not impact the package {riskmetric} score"}` + +```{r package_dependencies_table} + if('Package Dependencies' %in% params$report_includes) { + params$dep_table %>% + kableExtra::kbl(format = 'latex', booktabs = T, linesep = "") %>% + kableExtra::kable_styling("basic", latex_options = "hold_position", full_width = F, position = 'left') + } else "" +``` + +`r if(any(c('Source Explorer Comments') %in% params$report_includes)) {"\\newpage "}` ```{r source_explorer} if(any(c('Source Explorer Comments') %in% params$report_includes)) { @@ -272,9 +330,7 @@ if('Source Explorer Comments' %in% params$report_includes){ } ``` - - -`r if(any(c('Function Explorer Comments') %in% params$report_includes)) {"\\newpage"}` +`r if(any(c('Function Explorer Comments') %in% params$report_includes)) {"\\newpage "}` ```{r function_explorer} if(any(c('Function Explorer Comments') %in% params$report_includes)) { @@ -298,13 +354,13 @@ if('Function Explorer Comments' %in% params$report_includes){ } ``` -\newpage +`r {"\\newpage "}` ```{r about_report_title} tagList(br(), h2('About The Report')) ``` -```{r about_report} +```{r about_report, warning=FALSE} tagList( strong('{riskassessment} App Version:'), br(), getElement(params, 'app_version'), br(), br(), @@ -314,11 +370,9 @@ tagList( ) if('Risk Score' %in% params$report_includes) { - tab_out <- params$metric_weights %>% - knitr::kable(align = c('l','c'), format = 'latex', booktabs = TRUE) - - if (!requireNamespace("kableExtra", quietly = TRUE)) tab_out else tab_out %>% kableExtra::kable_styling(position = "left") + kableExtra::kbl(booktabs = TRUE, linesep = "", format = "latex", align = c('l','c'), centering = F) %>% + kableExtra::kable_styling(position = "left") } ``` diff --git a/renv.lock b/renv.lock index 0eae2064a..f81d2c6cf 100644 --- a/renv.lock +++ b/renv.lock @@ -8,6 +8,9 @@ } ] }, + "Bioconductor": { + "Version": "3.16" + }, "Packages": { "AsioHeaders": { "Package": "AsioHeaders", @@ -670,6 +673,21 @@ ], "Hash": "6aa54f69598c32177e920eb3402e8293" }, + "crul": { + "Package": "crul", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "curl", + "httpcode", + "jsonlite", + "mime", + "urltools" + ], + "Hash": "1eb00a531331c91d970f3af74b75321f" + }, "curl": { "Package": "curl", "Version": "5.0.1", @@ -914,6 +932,50 @@ "Repository": "RSPM", "Hash": "f7736a18de97dea803bde0a2daaafb27" }, + "flextable": { + "Package": "flextable", + "Version": "0.9.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "data.table", + "gdtools", + "grDevices", + "graphics", + "grid", + "htmltools", + "knitr", + "officer", + "ragg", + "rlang", + "rmarkdown", + "stats", + "utils", + "uuid", + "xml2" + ], + "Hash": "58659ef4f0801843693d59ff4bbc120f" + }, + "fontBitstreamVera": { + "Package": "fontBitstreamVera", + "Version": "0.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "f6068021eff4aba735a9b2353516636c" + }, + "fontLiberation": { + "Package": "fontLiberation", + "Version": "0.1.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "f918c5e723f86f409912104d5b7a71d6" + }, "fontawesome": { "Package": "fontawesome", "Version": "0.5.1", @@ -926,6 +988,18 @@ ], "Hash": "1e22b8cabbad1eae951a75e9f8b52378" }, + "fontquiver": { + "Package": "fontquiver", + "Version": "0.2.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "fontBitstreamVera", + "fontLiberation" + ], + "Hash": "fc0f4226379e451057d55419fd31761e" + }, "forcats": { "Package": "forcats", "Version": "1.0.0", @@ -990,6 +1064,23 @@ ], "Hash": "fc0b272e5847c58cd5da9b20eedbd026" }, + "gdtools": { + "Package": "gdtools", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "Rcpp", + "curl", + "fontquiver", + "gfonts", + "htmltools", + "systemfonts", + "tools" + ], + "Hash": "98158453e15bbd2486fac8454f4b4409" + }, "generics": { "Package": "generics", "Version": "0.1.3", @@ -1016,6 +1107,23 @@ ], "Hash": "b544c397820e05a97d391b2d614a921a" }, + "gfonts": { + "Package": "gfonts", + "Version": "0.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "crayon", + "crul", + "glue", + "htmltools", + "jsonlite", + "shiny", + "utils" + ], + "Hash": "a535d76cf92645364997a8751396d63b" + }, "ggplot2": { "Package": "ggplot2", "Version": "3.4.2", @@ -1285,6 +1393,13 @@ ], "Hash": "a865aa85bcb2697f47505bfd70422471" }, + "httpcode": { + "Package": "httpcode", + "Version": "0.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "13641a1c6d2cc98801b76764078e17ea" + }, "httpuv": { "Package": "httpuv", "Version": "1.6.11", @@ -1668,6 +1783,25 @@ ], "Hash": "0984ce8da8da9ead8643c5cbbb60f83e" }, + "officer": { + "Package": "officer", + "Version": "0.6.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R6", + "grDevices", + "graphics", + "openssl", + "ragg", + "stats", + "utils", + "uuid", + "xml2", + "zip" + ], + "Hash": "d570077027cfedcf743d86838ffbd885" + }, "openssl": { "Package": "openssl", "Version": "2.1.0", @@ -2174,8 +2308,8 @@ "Source": "GitHub", "RemoteType": "github", "RemoteHost": "api.github.com", - "RemoteRepo": "riskmetric", "RemoteUsername": "pharmaR", + "RemoteRepo": "riskmetric", "RemoteRef": "HEAD", "RemoteSha": "3905c66d15dde5b6e3d021aa2bec52d883462bd9", "Requirements": [ diff --git a/tests/testthat/test-apps/downloadHandler-app/app.R b/tests/testthat/test-apps/downloadHandler-app/app.R index 9d34723c1..3f9680f25 100644 --- a/tests/testthat/test-apps/downloadHandler-app/app.R +++ b/tests/testthat/test-apps/downloadHandler-app/app.R @@ -35,6 +35,13 @@ server <- function(input, output, session) { class = "data.frame", row.names = c(NA, -12L))) + + session$userData$repo_pkgs <- reactiveVal() + + session$userData$loaded2_db <- reactive({ + riskassessment:::dbSelect("select name, version, score from package") + }) + riskassessment:::mod_downloadHandler_server("downloadHandler_1", pkg, user, metric_weights) riskassessment:::mod_downloadHandler_server("downloadHandler_2", pkgs, user, metric_weights) } diff --git a/tests/testthat/test-reportPreview.R b/tests/testthat/test-reportPreview.R index 8c0a8b58f..3e3d4ddbe 100644 --- a/tests/testthat/test-reportPreview.R +++ b/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, Dependencies, NEWS current, Maintainer, Bugs Closure Rate, Test Coverage, 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, Dependencies, NEWS current, Maintainer, Bugs Closure Rate, Test Coverage, First Version Release*, Reverse Dependencies, Latest Version Release*, Monthly downloads trend*, Package Downloads, Dependencies Uploaded*, Type Summary*, Base R Summary*" expect_equal(maint_info, str_expect) app$stop()