diff --git a/.Rbuildignore b/.Rbuildignore index 23020a243..402ecbd92 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,12 +1,22 @@ +^renv$ +^renv\.lock$ ^.*\.Rproj$ ^\.Rproj\.user$ ^data-raw$ dev_history.R ^dev$ $run_dev.* -$credentials.* -$database.* ^README\.Rmd$ ^\.github$ +^LICENSE\.md$ +^.open$ +^docs$ +^loggit.json$ ^app\.R$ ^rsconnect$ +^((?!/).)*sqlite$ +^auto_decisions\.json$ + +_\.new\.png$ +^_pkgdown\.yml$ +^pkgdown$ diff --git a/.Rprofile b/.Rprofile new file mode 100644 index 000000000..81b960f5c --- /dev/null +++ b/.Rprofile @@ -0,0 +1 @@ +source("renv/activate.R") diff --git a/.github/workflows/R-CMD-check-dev.yaml b/.github/workflows/R-CMD-check-dev.yaml new file mode 100644 index 000000000..8b7397514 --- /dev/null +++ b/.github/workflows/R-CMD-check-dev.yaml @@ -0,0 +1,56 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/master/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [dev] + pull_request: + branches: [dev] + +name: R-CMD-check + +jobs: + R-CMD-check: + runs-on: ${{ matrix.config.os }} + + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + + strategy: + fail-fast: false + matrix: + config: + # - {os: macOS-latest, r: 'release'} + # - {os: windows-latest, r: 'release'} + # - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} + - {os: ubuntu-latest, r: 'release'} + # - {os: ubuntu-latest, r: 'oldrel-1'} + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + + steps: + - name: Install Linux system dependencies + if: runner.os == 'Linux' + shell: bash + run: | + sudo apt-get install -y libcurl4-openssl-dev + sudo apt-get install -y libharfbuzz-dev + sudo apt-get install -y libfribidi-dev + + - uses: actions/checkout@v3 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + - uses: r-lib/actions/setup-renv@v2 + with: + r-version: ${{ matrix.config.r }} + http-user-agent: ${{ matrix.config.http-user-agent }} + use-public-rspm: true + extra-packages: rcmdcheck + + - name: Install riskassessment + shell: bash + run: R CMD INSTALL --preclean . + + - uses: r-lib/actions/check-r-package@v2 diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check-master.yaml similarity index 67% rename from .github/workflows/R-CMD-check.yaml rename to .github/workflows/R-CMD-check-master.yaml index 1d181c04e..1665c3b38 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check-master.yaml @@ -2,9 +2,9 @@ # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: - branches: [main, master, dev] + branches: [main, master] pull_request: - branches: [main, master, dev] + branches: [main, master] name: R-CMD-check @@ -29,18 +29,28 @@ jobs: R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v2 + - name: Install Linux system dependencies + if: runner.os == 'Linux' + shell: bash + run: | + sudo apt-get install -y libcurl4-openssl-dev + sudo apt-get install -y libharfbuzz-dev + sudo apt-get install -y libfribidi-dev + + - uses: actions/checkout@v3 - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r@v2 + - uses: r-lib/actions/setup-renv@v2 with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - - - uses: r-lib/actions/setup-r-dependencies@v2 - with: extra-packages: rcmdcheck + - name: Install riskassessment + shell: bash + run: R CMD INSTALL --preclean . + - uses: r-lib/actions/check-r-package@v2 diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 9afb87c7e..d62ccb505 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -28,7 +28,7 @@ jobs: with: use-public-rspm: true - - uses: r-lib/actions/setup-r-dependencies@v2 + - uses: r-lib/actions/setup-renv@v2 with: extra-packages: any::pkgdown, local::. needs: website @@ -37,6 +37,10 @@ jobs: run: install.packages("remotes") ; remotes::install_version("pkgdown", version = "2.0.3", repos = "cran.rstudio.com", dependencies = FALSE) shell: Rscript {0} + - name: Install riskassessment + shell: bash + run: R CMD INSTALL --preclean . + - name: Build site run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) shell: Rscript {0} diff --git a/.github/workflows/render-readme.yml b/.github/workflows/render-readme.yml new file mode 100644 index 000000000..1a111d9b2 --- /dev/null +++ b/.github/workflows/render-readme.yml @@ -0,0 +1,40 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help + +# this is set to re-render whenever README.Rmd is changed on a given branch +# the file is rendered and committed to the same branch +# adapted from: https://github.com/r-lib/actions/tree/v2/examples#render-rmarkdown +on: + push: + paths: ['README.Rmd'] + +name: render-readme + +jobs: + render-rmarkdown: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - name: Checkout repo + uses: actions/checkout@v3 + with: + fetch-depth: 0 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + + # install packages needed + - name: install required packages + run: Rscript -e 'install.packages(c("rmarkdown"))' + + - name: Render Rmarkdown files and Commit Results + run: | + Rscript -e 'rmarkdown::render("README.Rmd", output_format = "github_document")' + git config --local user.name "$GITHUB_ACTOR" + git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" + git add README.md || echo "WARN: README.md was not updated" + git add man/figures/README-* || echo "No figure updates were found" + git commit -m 'Re-build Rmarkdown files' || echo "No changes to commit" + git push origin || echo "No changes to commit" diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 000000000..7b9ac25fe --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,36 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/master/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + branches: [main, master, dev] + +name: test-coverage + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v2 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-renv@v2 + with: + extra-packages: covr + + - name: Install riskassessment + shell: bash + run: R CMD INSTALL --preclean . + + - name: Test coverage + run: covr::codecov() + shell: Rscript {0} diff --git a/.gitignore b/.gitignore index 2bd2e859b..177df5826 100644 --- a/.gitignore +++ b/.gitignore @@ -1,8 +1,14 @@ rsconnect/ -*.sqlite +/*.sqlite .Rproj.user .Rhistory .RData .Ruserdata loggit.json .DS_Store +inst/doc +# {shinytest2}: Ignore new debug snapshots for `$expect_values()` +*_.new.png +auto_decisions.json +^docs$ +docs/ diff --git a/DESCRIPTION b/DESCRIPTION index 5c9eac66a..2dfcf3c66 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,15 +1,21 @@ Package: riskassessment Title: A web app designed to interface with the `riskmetric` package -Version: 0.0.1 -Authors@R: as.person(c( - "Aaron Clark [aut, cre]", - "Robert Krajcik [aut]", - "Jeff Thompson [aut]", - "Marly Gotti [aut]", - "Maya Gans [aut]", - "Aravind Reddy Kallem [aut]", - "Fission Labs India Pvt Ltd [aut]" - )) +Version: 0.1.0 +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"), + person("Jeff", "Thompson", role = "aut", email = "jeff.thompson51317@gmail.com"), + person("Lars", "Andersen", role = "aut", email = "lars.andersen@boehringer-ingelheim.com"), + person("Andrew", "Borgman", role = "aut", email = "andrew.borgman@biogen.com"), + person("Munshi Imran", "Hossain", role = "ctb"), + person("Scott", "Schumacker", role = "ctb", email = "scottschu97@gmail.com"), + person("Marly", "Gotti", role = "aut", email = "marly.cormar@biogen.com"), + person("Maya", "Gans", role = "aut", email = "maya.gans@biogen.com"), + person("Aravind Reddy", "Kallem", role = "aut"), + person(family = "Fission Labs India Pvt Ltd", role = "aut"), + person(family = "PSI special interest group Application and Implementation of Methodologies in Statistics", role = c("cph", "fnd")), + person(family = "R Validation Hub", role = c("cph", "fnd")) + ) Description: The `riskassessment` application allows users to define a list of R packages to assess against metrics engineered by the `riskmetric` package. In general, those metrics evaluate package development best practices, code @@ -22,33 +28,27 @@ Description: The `riskassessment` application allows users to define a list of R authentication wall where roles are assigned to various users and 'final decisions' can be made at the package level. License: MIT + file LICENSE -URL: https://github.com/pharmaR/risk_assessment -BugReports: https://github.com/pharmaR/risk_assessment/issues +URL: https://github.com/pharmaR/riskassessment +BugReports: https://github.com/pharmaR/riskassessment/issues Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.2 +RoxygenNote: 7.2.0 Imports: bslib (>= 0.3.0), config (>= 0.3.1), cranlogs, - crayon, DBI, - desc, dplyr, DT, - forcats, formattable, glue, golem (>= 0.3.2), - keyring, + jsonlite, loggit, lubridate, - magrittr, - pkgload, plotly, purrr, - readr (>= 2.0.1), rintrojs, riskmetric (>= 0.1.1), rlang, @@ -57,19 +57,21 @@ Imports: rvest, shiny (>= 1.7.1), shinydashboard, - shinyhelper, shinyjs, shinymanager, shinyWidgets, - stringr, - tibble, - tidyr, - waiter + stringr Suggests: + fontawesome, + knitr, + pkgload, rstudioapi, + shinytest2, spelling, - testthat (>= 3.0.0) + testthat (>= 3.0.0), + tinytex Config/testthat/edition: 3 Language: en-US Depends: R (>= 2.10) +VignetteBuilder: knitr diff --git a/LICENSE b/LICENSE new file mode 100644 index 000000000..023027355 --- /dev/null +++ b/LICENSE @@ -0,0 +1,4 @@ +YEAR: 2020 +COPYRIGHT HOLDER: + - PSI special interest group Application and Implementation of Methodologies in Statistics + - R Validation Hub \ No newline at end of file diff --git a/NAMESPACE b/NAMESPACE index c3747f3dd..90819890d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,12 +1,13 @@ # Generated by roxygen2: do not edit by hand -export("%>%") export(app_theme) +export(build_comm_plotly) +export(generate_comm_data) export(initialize_raa) export(run_app) export(showComments) import(dplyr) -import(shiny) +import(shiny, except = c(dataTableOutput, renderDataTable)) importFrom(DBI,dbClearResult) importFrom(DBI,dbConnect) importFrom(DBI,dbDisconnect) @@ -34,8 +35,10 @@ importFrom(golem,activate_js) importFrom(golem,add_resource_path) importFrom(golem,bundle_resources) importFrom(golem,favicon) +importFrom(golem,get_golem_options) importFrom(golem,with_golem_options) -importFrom(keyring,key_get) +importFrom(jsonlite,read_json) +importFrom(jsonlite,write_json) importFrom(loggit,loggit) importFrom(loggit,set_logfile) importFrom(lubridate,NA_Date_) @@ -45,7 +48,6 @@ importFrom(lubridate,make_date) importFrom(lubridate,month) importFrom(lubridate,year) importFrom(lubridate,years) -importFrom(magrittr,"%>%") importFrom(plotly,add_annotations) importFrom(plotly,add_segments) importFrom(plotly,config) @@ -53,9 +55,8 @@ importFrom(plotly,layout) importFrom(plotly,plot_ly) importFrom(plotly,plotlyOutput) importFrom(plotly,renderPlotly) +importFrom(purrr,compact) importFrom(purrr,map) -importFrom(readr,read_csv) -importFrom(readr,read_file) importFrom(rintrojs,introjs) importFrom(rintrojs,introjsUI) importFrom(riskmetric,pkg_assess) @@ -68,6 +69,7 @@ importFrom(rvest,html_table) importFrom(rvest,html_text) importFrom(rvest,read_html) importFrom(shiny,shinyApp) +importFrom(shinyWidgets,tooltipOptions) importFrom(shinydashboard,box) importFrom(shinyjs,delay) importFrom(shinyjs,disable) @@ -78,6 +80,7 @@ importFrom(shinyjs,runjs) importFrom(shinyjs,show) importFrom(shinyjs,useShinyjs) importFrom(shinymanager,check_credentials) +importFrom(shinymanager,create_db) importFrom(shinymanager,fab_button) importFrom(shinymanager,read_db_decrypt) importFrom(shinymanager,secure_app) @@ -88,7 +91,10 @@ importFrom(stringr,str_remove_all) importFrom(stringr,str_replace) importFrom(stringr,str_replace_all) importFrom(stringr,str_sub) -importFrom(tibble,add_row) -importFrom(tidyr,pivot_wider) -importFrom(tidyr,tibble) -importFrom(waiter,use_waitress) +importFrom(utils,available.packages) +importFrom(utils,head) +importFrom(utils,installed.packages) +importFrom(utils,packageVersion) +importFrom(utils,read.csv) +importFrom(utils,write.csv) +importFrom(utils,zip) diff --git a/NEWS.md b/NEWS.md index ddad4bb56..b123f59c1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,52 @@ +# riskassessment 0.1.0 + +### All New Features +* Allowed users to type in package names to be assessed in the app, instead of uploading CSV file. Also allow point-and-click deletion of packages. +* Added decision automation capabilities where the user can set decision rules for uploaded packages to be auto-assigned. + +### Enhancements +* Added "PDF report" download option (#280) +* Added risk score to the Report Preview tab and downloaded reports (#264). +* Exported `generate_comm_data()` to help users build the community usage data needed run `build_comm_plotly()` (also exported) to produce the "downloads by month"" plot as seen on the Community Usage tab of the application. (#266). + +### For deployment +* Created a argument for `run_app()` called `login_note` which allows users deploying the app to add custom log-in notes on the authentication screen. By default, it displays a note about how to use default usernames and passwords to gain entry for the first time. +* Engineered a new argument to `run_app()` called `app_version` which allows users deploying the application to publish their own custom text string in the app's authentication screen and any downloaded reports. By default, it will display the installed version. + +### Docs +* Updated `README` to include more description, 'Usage' info, including how to install & run the app for the first time. Last, included links to the demo app & a short video walk-through. Very brief notes were included regarding deployment environments. +* Added several vignettes to documentation site, including: + * "Get started with `riskassessment`" vignette + * "Administrative Tools and Options" vignette +* Designed hex logo +* updated documentation to reflect new repo name 'riskassessment' without the '_' to separate the two words. +* suggest installation of `riskmetric` from GitHub, and not CRAN (for now) + +### Squashed Bugs +* Fixed bug causing Community Usage metrics to fail on Mac computers +* Fixed bug causing the report to fail when no Community Metrics were available for a package. +* Add founders/copyright holders to `DESCRIPTION` file +* Fixed bug where `Assessment Criteria` tables were failing to render. +* Improved metric 'card' aesthetics in order to remove scroll bars (#198). +* Added console warnings, log-in note, and modals to warn user there is a bug with {fontawesome} v0.4.0. For more info, the bug status can be tracked [here](https://github.com/rstudio/fontawesome/issues/99). +* Fixed summary of community usage data when there was more than one package version released in the same month +* Fixed bug where the logging file was not being set +* Fixed package delete button shadow; fix introjs for admin/non-admin roles +* Fixed display of 'Report Bugs' metric to align with current `riskmetric` presentation as 0 or 1 + +### For Devs +* Some general re-organizing of the package's infrastructure to make testing and development easier. +* Added unit tests to attain test coverage >85% (#295). +* Added `renv` and a `renv.lock` file as well as corresponding vignette for developers/contributors to align on. +* Reduce number of package dependencies from 33 to 26 +* Changed risk-based color gradient to use colorblind-friendly color palette (#324). +* Adopt (temporary) CRAN-first data collection method for pkg info via `riskmetric::pkg_ref()` + + # riskassessment 0.0.1 -* Initiated simple `app.R` for easier deployment using `runURL("https://github.com/pharmaR/risk_assessment/archive/master.zip")` and `shiny::runGitHub('risk_assessment', 'pharmaR')` + +* Initiated simple `app.R` for easier deployment using `runURL("https://github.com/pharmaR/riskassessment/archive/master.zip")` and `shiny::runGitHub('riskassessment', 'pharmaR')` + # riskassessment 0.0.0.9000 diff --git a/R/_disable_autoload.R b/R/_disable_autoload.R deleted file mode 100644 index a8c9436ac..000000000 --- a/R/_disable_autoload.R +++ /dev/null @@ -1,3 +0,0 @@ -# Disabling shiny autoload - -# See ?shiny::loadSupport for more information diff --git a/R/app_server.R b/R/app_server.R index 9597358bb..f0c6799ce 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -2,10 +2,9 @@ #' #' @param input,output,session Internal parameters for {shiny}. #' DO NOT REMOVE. -#' @import shiny +#' #' @importFrom shinyjs show hide delay runjs #' @importFrom shinymanager secure_server check_credentials -#' @importFrom keyring key_get #' @importFrom loggit loggit #' @noRd app_server <- function(input, output, session) { @@ -13,19 +12,32 @@ app_server <- function(input, output, session) { user <- reactiveValues() user$metrics_reweighted <- 0 - # check_credentials directly on sqlite db - res_auth <- shinymanager::secure_server( - check_credentials = shinymanager::check_credentials( - credentials_name, - passphrase = passphrase + + # this skips authentication if the application is running in test mode + if (isTRUE(getOption("shiny.testmode"))) { + # mock what is returned by shinymanager::secure_server + res_auth <- reactiveValues() + res_auth[["admin"]] <- !isTRUE(golem::get_golem_options('nonadmin')) + res_auth[["user"]] <- "test_user" + + } else { + # check_credentials directly on sqlite db + res_auth <- shinymanager::secure_server( + check_credentials = shinymanager::check_credentials( + golem::get_golem_options('credentials_db_name'), + passphrase = passphrase + ) ) - ) + } + observeEvent(res_auth$user, { if (res_auth$admin == TRUE) { appendTab("apptabs", tabPanel( - title = div(id = "admin-mode-tab", icon("gears"), "Administrative Tools"), + title = "Administrative Tools", + icon = icon("gears"), + value = "admin-mode-tab", h2("Administrative Tools & Options", align = "center", `padding-bottom`="20px"), br(), tabsetPanel( @@ -102,10 +114,10 @@ app_server <- function(input, output, session) { }) # Load server of the reweightView module. - metric_weights <- reweightViewServer("reweightInfo", user) + metric_weights <- reweightViewServer("reweightInfo", user, uploaded_pkgs$auto_decision) # Load server of the uploadPackage module. - uploaded_pkgs <- uploadPackageServer("upload_package") + uploaded_pkgs <- uploadPackageServer("upload_package", user) # Load server of the sidebar module. selected_pkg <- sidebarServer("sidebar", user, uploaded_pkgs$names) @@ -163,7 +175,7 @@ app_server <- function(input, output, session) { cm_comments = community_data$comments, downloads_plot_data = community_data$downloads_plot_data, user = user, - app_version = app_version, + app_version = golem::get_golem_options('app_version'), metric_weights = metric_weights) output$auth_output <- renderPrint({ diff --git a/R/app_ui.R b/R/app_ui.R index 31af21054..c328395dc 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -2,7 +2,8 @@ #' #' @param request Internal parameter for `{shiny}`. #' DO NOT REMOVE. -#' @import shiny +#' @rawNamespace import(shiny, except = c(dataTableOutput, renderDataTable)) +#' @importFrom utils head installed.packages packageVersion write.csv zip #' @importFrom shinymanager secure_app #' #' @noRd @@ -10,20 +11,19 @@ app_ui <- function(request) { # Your application UI logic ui <- fluidPage( - theme = app_theme, # defined in data-raw/interanl-data.R + theme = app_theme(), # defined in data-raw/interanl-data.R - # not needed any more. Automatically bundled below - # includeCSS(path = file.path('www', 'css', 'main.css')), - # includeCSS(path = file.path('www', 'css', 'community_metrics.css')), + div(id = "raa-logo", img(src="www/raa-image.png")), tabsetPanel( id = "apptabs", tabPanel( title = "Risk Assessment", icon = icon("clipboard-list"), + value = "risk-assessment-tab", titlePanel( - windowTitle = "Risk Assessment - v0.0.1", + windowTitle = "riskassessment app", title = div(id = "page-title", "R Package Risk Assessment App") ), @@ -63,23 +63,26 @@ app_ui <- function(request) { ), tabPanel( - title = div(id = "database-tab", icon("database"), "Database"), - databaseViewUI("databaseView") + title = "Database", + icon = icon("database"), + databaseViewUI("databaseView"), + value = "database-tab" ), tabPanel( - title = div(id = "assessment-criteria-tab", icon("circle-info"), "Assessment Criteria"), + title = "Assessment Criteria", + icon = icon("circle-info"), assessmentInfoUI("assessmentInfo"), + value = "assessment-criteria-tab" ) ), wellPanel( id = "footer", "Checkout the app's code!", - tags$a(href = "https://github.com/pharmaR/risk_assessment", + tags$a(href = "https://github.com/pharmaR/riskassessment", icon("github-alt"), target = "_blank") ) - ) tagList( @@ -94,11 +97,10 @@ app_ui <- function(request) { #' This function is internally used to add external #' resources inside the Shiny application. #' -#' @import shiny +#' #' @importFrom golem add_resource_path activate_js favicon bundle_resources #' @importFrom rintrojs introjsUI #' @importFrom shinyjs useShinyjs -#' @importFrom waiter use_waitress #' @importFrom golem add_resource_path activate_js favicon bundle_resources #' @noRd golem_add_external_resources <- function() { @@ -116,6 +118,5 @@ golem_add_external_resources <- function() { # Add here other external resources rintrojs::introjsUI(), shinyjs::useShinyjs(), - waiter::use_waitress(), ) } diff --git a/R/databaseView.R b/R/databaseView.R deleted file mode 100644 index 3e12c892e..000000000 --- a/R/databaseView.R +++ /dev/null @@ -1,264 +0,0 @@ -# Global Risk color palettes. -# https://www.rapidtables.com/web/color/html-color-codes.html -low_risk_color <- "#228B22" # forest green -med_risk_color <- "#d1b000" # dark gold -high_risk_color <- "#B22222" # firebrick -setColorPalette <- colorRampPalette(c(low_risk_color, med_risk_color, high_risk_color)) - -#' UI for 'Database View' module -#' -#' @param id a module id name -#' -#' @import shiny -#' @importFrom shinydashboard box -#' @importFrom DT dataTableOutput -#' -databaseViewUI <- function(id) { - fluidPage( - fluidRow( - column( - width = 8, offset = 2, align = "center", - br(), - h4("Database Overview"), - hr(), - tags$section( - br(), br(), - shinydashboard::box(width = 12, - title = h5("Uploaded Packages", style = "margin-top: 5px"), - DT::dataTableOutput(NS(id, "packages_table")), - br(), - fluidRow( - column( - width = 6, - style = "margin: auto;", - downloadButton(NS(id, "download_reports"), "Download Report(s)")), - column( - width = 6, - selectInput(NS(id, "report_formats"), "Select Format", c("html", "docx")) - ) - ))) - )) - ) -} - -#' Server logic for 'Database View' module -#' -#' @param id a module id name -#' @param user a user name -#' @param uploaded_pkgs a vector of uploaded package names -#' @param metric_weights a reactive data.frame holding metric weights -#' -#' @import shiny -#' @import dplyr -#' @importFrom lubridate as_datetime -#' @importFrom stringr str_replace_all str_replace -#' @importFrom shinyjs enable disable -#' @importFrom rmarkdown render -#' @importFrom glue glue -#' @importFrom DT renderDataTable formatStyle -#' @importFrom formattable formattable as.datatable formatter style csscolor -#' icontext -#' -databaseViewServer <- function(id, user, uploaded_pkgs, metric_weights, changes) { - moduleServer(id, function(input, output, session) { - - # Update table_data if a package has been uploaded - table_data <- eventReactive({uploaded_pkgs(); changes()}, { - - db_pkg_overview <- dbSelect( - 'SELECT pi.name, pi.version, pi.score, pi.decision, c.last_comment - FROM package as pi - LEFT JOIN ( - SELECT id, max(added_on) as last_comment FROM comments GROUP BY id) - AS c ON c.id = pi.name - ORDER BY 1 DESC' - ) - - db_pkg_overview %>% - dplyr::mutate(last_comment = as.character(lubridate::as_datetime(last_comment))) %>% - dplyr::mutate(last_comment = ifelse(is.na(last_comment), "-", last_comment)) %>% - dplyr::mutate(decision = ifelse(decision != "", paste(decision, "Risk"), "-")) %>% - dplyr::mutate(was_decision_made = ifelse(decision != "-", TRUE, FALSE)) %>% - dplyr::select(name, version, score, was_decision_made, decision, last_comment) - }) - - # Create table for the db dashboard. - output$packages_table <- DT::renderDataTable({ - - formattable::as.datatable( - formattable::formattable( - table_data(), - list( - score = formattable::formatter( - "span", - style = x ~ formattable::style(display = "block", - "border-radius" = "4px", - "padding-right" = "4px", - "font-weight" = "bold", - "color" = "white", - "order" = x, - "background-color" = formattable::csscolor( - setColorPalette(100)[round(as.numeric(x)*100)]))), - decision = formattable::formatter( - "span", - style = x ~ formattable::style(display = "block", - "border-radius" = "4px", - "padding-right" = "4px", - "font-weight" = "bold", - "color" = "white", - "background-color" = - ifelse(x == "High Risk", high_risk_color, - ifelse(x == "Medium Risk", med_risk_color, - ifelse(x == "Low Risk", low_risk_color, "transparent"))))), - was_decision_made = formattable::formatter("span", - style = x ~ formattable::style(color = ifelse(x, "#0668A3", "gray")), - x ~ formattable::icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No"))) - )), - selection = list(mode = 'multiple'), - colnames = c("Package", "Version", "Score", "Decision Made?", "Decision", "Last Comment"), - rownames = FALSE, - options = list( - searching = FALSE, - lengthChange = FALSE, - #dom = 'Blftpr', - pageLength = 15, - lengthMenu = list(c(15, 60, 120, -1), c('15', '60', '120', "All")), - columnDefs = list(list(className = 'dt-center', targets = "_all")) - ) - ) %>% - DT::formatStyle(names(table_data()), textAlign = 'center') - }) - - # Enable the download button when a package is selected. - observe({ - if(!is.null(input$packages_table_rows_selected)) { - shinyjs::enable("download_reports") - } else { - shinyjs::disable("download_reports") - } - }) - - output$download_reports <- downloadHandler( - filename = function() { - selected_pkgs <- table_data() %>% - dplyr::slice(input$packages_table_rows_selected) - n_pkgs <- nrow(selected_pkgs) - - if (n_pkgs > 1) { - report_datetime <- stringr::str_replace_all(stringr::str_replace(Sys.time(), " ", "_"), ":", "-") - glue::glue('RiskAssessment-Report-{report_datetime}.zip') - } else { - glue::glue('{selected_pkgs$name}_{selected_pkgs$version}_Risk_Assessment.', - "{switch(input$report_formats, docx = 'docx', html = 'html')}") - } - }, - content = function(file) { - - selected_pkgs <- table_data() %>% - dplyr::slice(input$packages_table_rows_selected) - n_pkgs <- nrow(selected_pkgs) - - req(n_pkgs > 0) - - shiny::withProgress( - message = glue::glue('Downloading {n_pkgs} Report{ifelse(n_pkgs > 1, "s", "")}'), - value = 0, - max = n_pkgs + 2, # Tell the progress bar the total number of events. - { - shiny::incProgress(1) - - my_tempdir <- tempdir() - if (input$report_formats == "html") { - Report <- file.path(my_tempdir, "reportHtml.Rmd") - file.copy(file.path('inst/app/www', 'reportHtml.Rmd'), Report, overwrite = TRUE) - } else { - # docx - Report <- file.path(my_tempdir, "reportDocx.Rmd") - if (!dir.exists(file.path(my_tempdir, "images"))) - dir.create(file.path(my_tempdir, "images")) - file.copy(file.path('inst/app/www', 'ReportDocx.Rmd'), - Report, - overwrite = TRUE) - file.copy(file.path('inst/app/www', 'read_html.lua'), - file.path(my_tempdir, "read_html.lua"), overwrite = TRUE) - file.copy(file.path('inst/app/www', 'images', 'user-tie.png'), - file.path(my_tempdir, "images", "user-tie.png"), - overwrite = TRUE) - file.copy(file.path('inst/app/www', 'images', 'user-shield.png'), - file.path(my_tempdir, "images", "user-shield.png"), - overwrite = TRUE) - file.copy(file.path('inst/app/www', 'images', 'calendar-alt.png'), - file.path(my_tempdir, "images", "calendar-alt.png"), - overwrite = TRUE) - } - - fs <- c() - for (i in 1:n_pkgs) { - # Grab package name and version, then create filename and path. - # this_pkg <- "stringr" # for testing - this_pkg <- selected_pkgs$name[i] # from DT table - this_ver <- selected_pkgs$version[i] - file_named <- glue::glue('{this_pkg}_{this_ver}_Risk_Assessment.{input$report_formats}') - path <- if (n_pkgs > 1) { - file.path(my_tempdir, file_named) - } else { - file - } - - - selected_pkg <- get_pkg_info(this_pkg) - this_pack <- list( - id = selected_pkg$id, - name = selected_pkg$name, - version = selected_pkg$version, - title = selected_pkg$title, - decision = selected_pkg$decision, - description = selected_pkg$description, - author = selected_pkg$author, - maintainer = selected_pkg$maintainer, - license = selected_pkg$license, - published = selected_pkg$published - ) - - # gather comments data - overall_comments <- get_overall_comments(this_pkg) - mm_comments <- get_mm_comments(this_pkg) - cm_comments <- get_cm_comments(this_pkg) - - # gather maint metrics & community metric data - mm_data <- get_mm_data(this_pack$id) - comm_data <- get_comm_data(this_pkg) - comm_cards <- build_comm_cards(comm_data) - downloads_plot <- build_comm_plotly(comm_data) - - # Render the report, passing parameters to the rmd file. - rmarkdown::render( - input = Report, - output_file = path, - clean = FALSE, - params = list(pkg = this_pack, - riskmetric_version = paste0(packageVersion("riskmetric")), - app_version = app_version, - metric_weights = metric_weights(), - user_name = user$name, - user_role = user$role, - overall_comments = overall_comments, - mm_comments = mm_comments, - cm_comments = cm_comments, - maint_metrics = mm_data, - com_metrics = comm_cards, - com_metrics_raw = comm_data, - downloads_plot_data = downloads_plot - ) - ) - fs <- c(fs, path) # Save all the reports/ - shiny::incProgress(1) # Increment progress bar. - } - # Zip all the files up. -j retains just the files in zip file. - if (n_pkgs > 1) zip(zipfile = file, files = fs, extras = "-j") - shiny::incProgress(1) # Increment progress bar. - }) - } - ) - }) -} diff --git a/R/fct_helpers.R b/R/fct_helpers.R deleted file mode 100644 index 8960113e1..000000000 --- a/R/fct_helpers.R +++ /dev/null @@ -1,44 +0,0 @@ -#' showHelperMessage -#' -#' Displays a helper message. By default, it informs the user that he should -#' select a package. -#' -#' @param message a string -#' -#' @import shiny -showHelperMessage <- function(message = "Please select a package"){ - h6(message, - style = - "text-align: center; - color: gray; - padding-top: 50px;") -} - -#' showComments -#' -#' Displays formatted comments -#' -#' @param pkg_name a string -#' @param pkg_name a data.frame -#' -#' @import shiny -#' @export -showComments <- function(pkg_name, comments){ - if (length(pkg_name) == 0) - return("") - - ifelse( - length(comments$user_name) == 0, - "No comments", - paste0( - "
", - icon("user-tie"), " ", "user: ", comments$user_name, ", ", - icon("user-shield"), " ", "role: ", comments$user_role, ", ", - icon("calendar-days"), " ", "date: ", comments$added_on, - br(), br(), - comments$comment, - "
", - collapse = "" - ) - ) -} diff --git a/R/global.R b/R/global.R index cb1b45bad..9211cb88b 100644 --- a/R/global.R +++ b/R/global.R @@ -1,7 +1,7 @@ #' The `riskassessment` package #' -#' The Risk Assessment App is an interactive web application serving as a front +#' The `riskassessment` App is an interactive web application serving as a front #' end application for the `riskmetric` R package. `riskmetric` is a framework #' to quantify risk by assessing a number of metrics meant to evaluate #' development best practices, code documentation, community engagement, and @@ -10,7 +10,15 @@ #' #' @keywords internal #' -#' @import shiny +#' #' @import dplyr #' "_PACKAGE" + +# avoid "no visible binding for global variable" messages from check() +utils::globalVariables(c('.', + 'Author', 'day_month_year', 'decision', 'description', 'description', 'downloads', + 'have_changed', 'Last modified', 'last_comment', 'License', 'll', 'long_name', 'Maintainer', + 'must_change', 'name', 'Name', 'new_weight', 'package', 'Published', + 'score', 'Version', 'was_decision_made', 'weight', 'X1', 'X2', 'ea_v') +) diff --git a/R/addComment.R b/R/mod_addComment.R similarity index 95% rename from R/addComment.R rename to R/mod_addComment.R index bd7b0ef03..0bfc2a617 100644 --- a/R/addComment.R +++ b/R/mod_addComment.R @@ -4,8 +4,7 @@ #' as the user inserts more comments. #' #' @param id a module id name -#' -#' @import shiny +#' @keywords internal #' addCommentUI <- function(id) { fluidRow( @@ -23,12 +22,13 @@ addCommentUI <- function(id) { #' @param metric_abrv placeholder #' @param user_name placeholder #' @param user_role placeholder -#' @param pkg_name placeholder +#' @param pkg_name string name of the package +#' #' -#' @import shiny #' @import dplyr #' @importFrom glue glue #' @importFrom stringr str_replace_all +#' @keywords internal #' addCommentServer <- function(id, metric_abrv, user_name, user_role, pkg_name) { moduleServer(id, function(input, output, session) { @@ -77,4 +77,4 @@ addCommentServer <- function(id, metric_abrv, user_name, user_role, pkg_name) { reactive(input$add_comment) }) -} \ No newline at end of file +} diff --git a/R/assessmentInfo.R b/R/mod_assessmentInfo.R similarity index 73% rename from R/assessmentInfo.R rename to R/mod_assessmentInfo.R index baedb0ea9..50d2a160d 100644 --- a/R/assessmentInfo.R +++ b/R/mod_assessmentInfo.R @@ -2,9 +2,10 @@ #' #' @param id a module id name #' -#' @import shiny #' @importFrom DT dataTableOutput #' +#' @keywords internal +#' assessmentInfoUI <- function(id) { fluidPage( fluidRow( @@ -51,9 +52,10 @@ assessmentInfoUI <- function(id) { #' @param metric_weights placeholder #' #' @import dplyr -#' @importFrom readr read_file read_csv #' @importFrom DT renderDataTable formatStyle datatable -#' @importFrom formattable as.datatable +#' @importFrom formattable as.datatable +#' +#' @keywords internal #' assessmentInfoServer <- function(id, metric_weights) { moduleServer(id, function(input, output, session) { @@ -87,7 +89,19 @@ assessmentInfoServer <- function(id, metric_weights) { # Render table for Maintenance Metrics. - output$maintenance_table <- DT::renderDataTable(maintenance_metrics_tbl) + output$maintenance_table <- DT::renderDataTable( + DT::datatable( + maintenance_metrics_tbl, + escape = FALSE, + class = "cell-border", + selection = 'none', + options = list( + sScrollX = "100%", + aLengthMenu = list(c(5, 10, 20, 100,-1), list('5', '10', '20', '100', 'All')), + iDisplayLength = 15 + ) + ) + ) # Display the Community Usage Metrics text content. @@ -95,7 +109,19 @@ assessmentInfoServer <- function(id, metric_weights) { # Render table for Community Usage Metrics. - output$community_usage_table <- DT::renderDataTable(community_usage_tbl) + output$community_usage_table <- DT::renderDataTable( + DT::datatable( + community_usage_tbl, + escape = FALSE, + class = "cell-border", + selection = 'none', + options = list( + sScrollX = "100%", + aLengthMenu = list(c(5, 10, 20, 100,-1), list('5', '10', '20', '100', 'All')), + iDisplayLength = 15 + ) + ) + ) # Display the Testing Metrics text content. @@ -103,6 +129,18 @@ assessmentInfoServer <- function(id, metric_weights) { # Render table for Testing Metrics. - output$testing_table <- DT::renderDataTable(testing_tbl) + output$testing_table <- DT::renderDataTable( + DT::datatable( + testing_tbl, + escape = FALSE, + class = "cell-border", + selection = 'none', + options = list( + sScrollX = "100%", + aLengthMenu = list(c(5, 10, 20, 100,-1), list('5', '10', '20', '100', 'All')), + iDisplayLength = 15 + ) + ) + ) }) } diff --git a/R/communityMetrics.R b/R/mod_communityMetrics.R similarity index 91% rename from R/communityMetrics.R rename to R/mod_communityMetrics.R index 701422820..e69fc2038 100644 --- a/R/communityMetrics.R +++ b/R/mod_communityMetrics.R @@ -3,7 +3,8 @@ #' #' @param id a module id name #' -#' @import shiny +#' @keywords internal +#' communityMetricsUI <- function(id) { uiOutput(NS(id, 'communityMetrics_ui')) } @@ -15,11 +16,13 @@ communityMetricsUI <- function(id) { #' @param community_metrics placeholder #' @param user placeholder #' -#' @import shiny +#' #' @import dplyr #' @importFrom glue glue #' @importFrom plotly plotlyOutput renderPlotly #' +#' @keywords internal +#' communityMetricsServer <- function(id, selected_pkg, community_metrics, user) { moduleServer(id, function(input, output, session) { @@ -42,7 +45,6 @@ communityMetricsServer <- function(id, selected_pkg, community_metrics, user) { introJSUI(NS(id, 'introJS')), h4("Community Usage Metrics", style = "text-align: center;"), br(), br(), - # TODO: change this for a grid. div(id = "cum_infoboxes", metricGridUI(NS(id, 'metricGrid'))), br(), br(), div(id = "cum_plot", fluidRow( @@ -57,14 +59,21 @@ communityMetricsServer <- function(id, selected_pkg, community_metrics, user) { } }) + cum_text <- reactive({ + if(user$role == "admin") { + apptab_steps <- bind_rows(apptab_admn, apptab_steps) + } + cum_steps %>% + bind_rows(apptab_steps) + }) + # IntroJS. - introJSServer(id = "introJS", text = cum_steps) + introJSServer(id = "introJS", text = cum_text()) # Community cards (saved to share with report preview): the # time since first release, the time since latest release, # and the number of downloads since last year. cards <- eventReactive(community_metrics(), { - req(nrow(community_metrics()) > 0) build_comm_cards(community_metrics()) }) diff --git a/R/mod_databaseView.R b/R/mod_databaseView.R new file mode 100644 index 000000000..be2a53850 --- /dev/null +++ b/R/mod_databaseView.R @@ -0,0 +1,159 @@ +# Global Risk color palettes. +# run locally and paste hex codes +# colorspace::darken(viridisLite::turbo(11, begin = 0.4, end = .8225), .25) +low_risk_color <- "#06B756FF" # 1st +med_risk_color <- "#A99D04FF" # 6th +high_risk_color <- "#A63E24FF" # 11th +setColorPalette <- colorRampPalette( + c("#06B756FF","#2FBC06FF","#67BA04FF","#81B50AFF","#96AB0AFF","#A99D04FF", + "#B78D07FF","#BE7900FF","#BE6200FF","#B24F22FF","#A63E24FF")) + + +#' UI for 'Database View' module +#' +#' @param id a module id name +#' +#' +#' @importFrom shinydashboard box +#' @importFrom DT dataTableOutput +#' +#' @keywords internal +databaseViewUI <- function(id) { + fluidPage( + fluidRow( + column( + width = 8, offset = 2, align = "center", + br(), + h4("Database Overview"), + hr(), + tags$section( + br(), br(), + shinydashboard::box(width = 12, + title = h5("Uploaded Packages", style = "margin-top: 5px"), + DT::dataTableOutput(NS(id, "packages_table")), + br(), + fluidRow( + column( + width = 6, + style = "margin: auto;", + mod_downloadHandler_button_ui(NS(id, "downloadHandler"), multiple = TRUE)), + column( + width = 6, + mod_downloadHandler_filetype_ui(NS(id, "downloadHandler")) + ) + ))) + )) + ) +} + +#' Server logic for 'Database View' module +#' +#' @param id a module id name +#' @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 changes a reactive value integer count +#' +#' +#' @import dplyr +#' @importFrom lubridate as_datetime +#' @importFrom stringr str_replace_all str_replace +#' @importFrom shinyjs enable disable +#' @importFrom rmarkdown render +#' @importFrom glue glue +#' @importFrom DT renderDataTable formatStyle +#' @importFrom formattable formattable as.datatable formatter style csscolor +#' icontext +#' @keywords internal +databaseViewServer <- function(id, user, uploaded_pkgs, metric_weights, changes) { + moduleServer(id, function(input, output, session) { + + # Update table_data if a package has been uploaded + table_data <- eventReactive({uploaded_pkgs(); changes()}, { + + db_pkg_overview <- dbSelect( + 'SELECT pi.name, pi.version, pi.score, pi.decision, c.last_comment + FROM package as pi + LEFT JOIN ( + SELECT id, max(added_on) as last_comment FROM comments GROUP BY id) + AS c ON c.id = pi.name + ORDER BY 1 DESC' + ) + + db_pkg_overview %>% + dplyr::mutate(last_comment = as.character(lubridate::as_datetime(last_comment))) %>% + dplyr::mutate(last_comment = ifelse(is.na(last_comment), "-", last_comment)) %>% + dplyr::mutate(decision = ifelse(decision != "", paste(decision, "Risk"), "-")) %>% + dplyr::mutate(was_decision_made = ifelse(decision != "-", TRUE, FALSE)) %>% + dplyr::select(name, version, score, was_decision_made, decision, last_comment) + }) + + exportTestValues( + table_data = { + table_data() + }, + pkgs = { + pkgs() + } + ) + + # Create table for the db dashboard. + output$packages_table <- DT::renderDataTable({ + + formattable::as.datatable( + formattable::formattable( + table_data(), + list( + score = formattable::formatter( + "span", + style = x ~ formattable::style(display = "block", + "border-radius" = "4px", + "padding-right" = "4px", + "font-weight" = "bold", + "color" = "white", + "order" = x, + "background-color" = formattable::csscolor( + setColorPalette(100)[round(as.numeric(x)*100)]))), + decision = formattable::formatter( + "span", + style = x ~ formattable::style(display = "block", + "border-radius" = "4px", + "padding-right" = "4px", + "font-weight" = "bold", + "color" = "white", + "background-color" = + ifelse(x == "High Risk", high_risk_color, + ifelse(x == "Medium Risk", med_risk_color, + ifelse(x == "Low Risk", low_risk_color, "transparent"))))), + was_decision_made = formattable::formatter("span", + style = x ~ formattable::style(color = ifelse(x, "#0668A3", "gray")), + x ~ formattable::icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No"))) + )), + selection = list(mode = 'multiple'), + colnames = c("Package", "Version", "Score", "Decision Made?", "Decision", "Last Comment"), + rownames = FALSE, + options = list( + searching = FALSE, + lengthChange = FALSE, + #dom = 'Blftpr', + pageLength = 15, + lengthMenu = list(c(15, 60, 120, -1), c('15', '60', '120', "All")), + columnDefs = list(list(className = 'dt-center', targets = "_all")) + ) + ) %>% + DT::formatStyle(names(table_data()), textAlign = 'center') + }) + + pkgs <- reactive({ + if (is.null(input$packages_table_rows_selected)) { + character(0) + } else { + table_data() %>% + dplyr::slice(input$packages_table_rows_selected) %>% + dplyr::pull(name) + } + }) + + mod_downloadHandler_server("downloadHandler", pkgs, user, metric_weights) + }) +} diff --git a/R/mod_decision_automation.R b/R/mod_decision_automation.R new file mode 100644 index 000000000..abe2dbf9b --- /dev/null +++ b/R/mod_decision_automation.R @@ -0,0 +1,338 @@ +#' decision_automation UI Function +#' +#' @description A shiny Module. +#' +#' @param id,input,output,session Internal parameters for {shiny}. +#' +#' @noRd +mod_decision_automation_ui <- function(id){ + ns <- NS(id) + tagList( + uiOutput(ns("auto_classify")), + DT::dataTableOutput(ns("auto_table")) + ) +} + +#' decision_automation Server Functions +#' +#' @noRd +#' +#' @importFrom jsonlite read_json write_json +#' @importFrom purrr compact +#' @importFrom shinyWidgets tooltipOptions +mod_decision_automation_server <- function(id, user){ + moduleServer( id, function(input, output, session){ + ns <- session$ns + + auto_json <- jsonlite::read_json("auto_decisions.json") + auto_list <- reactiveVal(auto_json) + + output$auto_table <- + DT::renderDataTable({ + req(!rlang::is_empty(auto_list())) + + DT::datatable({ + auto_list() %>% + purrr::imap_dfr(~ dplyr::tibble(decision = .y, ll = .x[[1]], ul = .x[[2]])) %>% + dplyr::arrange(ll,) + }, + escape = FALSE, + class = "cell-border", + selection = 'none', + colnames = c("Decision Category", "Lower Limit", "Upper Limit"), + rownames = FALSE, + options = list( + dom = "t", + searching = FALSE, + sScrollX = "100%", + iDisplayLength = -1, + ordering = FALSE + )) + }) + + output$empty_auto <- + renderUI({ + if (rlang::is_empty(auto_list())) { + tagList( + br(), + p("Decision automation is not enabled. Click on the gear to the right if you wish to add.") + ) + } + }) + + observe({ + req(user$role) + req(user$role == "admin" || !rlang::is_empty(auto_json)) + + if (user$role == "admin") { + output$auto_classify <- + renderUI({ + tagList( + br(),br(), + hr(), + fluidRow( + column(9, h5("Decision Automation:")), + column(3, uiOutput(ns("auto_settings"))) + ), + uiOutput(ns("empty_auto")), + ) + }) + } else if (!rlang::is_empty(auto_json)) { + output$auto_classify <- + renderUI({ + tagList( + br(),br(), + hr(), + h5("Decision Automation:"), + ) + }) + } + + if (user$role == "admin") { + initial_values <- list(Low = .2, Medium = c(.2,.5), High = .5) + initial_selection <- NULL + if (!rlang::is_empty(auto_json)) { + for (.y in names(auto_json)) { + initial_values[[.y]] <- + if (.y == "Low") { + unlist(auto_json[[.y]][2]) + } else if (.y == "Medium") { + unlist(auto_json[[.y]]) + } else if (.y == "High") { + unlist(auto_json[[.y]][1]) + } + } + initial_selection <- names(auto_json) + } + + output$auto_settings <- + renderUI({ + div( + style = "float: right;", + shinyWidgets::dropdownButton( + div( + style = "display: flex;", + checkboxGroupInput(ns("auto_include"), "Auto-Assign Risk Decisions For...", c("Low", "Medium", "High"), selected = initial_selection, inline = TRUE), + actionButton(ns("auto_reset"), label = icon("refresh"), class = "btn-circle-sm", style = "margin-left: auto;") + ), + div( + risk = "low", + class = "shinyjs-hide", + style = "width: 100%", + sliderInput(ns("low_risk"), "Low Risk", 0, 1, initial_values$Low, + width = '100%', step = .01) + ), + div( + risk = "medium", + class = "shinyjs-hide", + style = "width: 100%", + sliderInput(ns("med_risk"), "Medium Risk", 0, 1, initial_values$Medium, + width = '100%', step = .01) + ), + div( + risk = "high", + class = "shinyjs-hide", + style = "width: 100%", + sliderInput(ns("high_risk"), "High Risk", 0, 1, initial_values$High, + width = '100%', step = .01) + ), + br(), + actionButton(ns("submit_auto"), "Apply Decision Rules", width = "100%"), + circle = TRUE, + icon = icon("gear"), + right = TRUE, + width = '600px', + inputId = ns("auto_dropdown"), + tooltip = shinyWidgets::tooltipOptions(title = "Click here to add/adjust decision automation rules.", placement = "left") + ) + ) + }) + + auto_decision <- reactiveValues() + auto_current <- reactiveVal(names(auto_json)) + + observeEvent(input$auto_include, { + grp_added <- setdiff(input$auto_include, auto_current()) + grp_removed <- setdiff(auto_current(), input$auto_include) + + if (!rlang::is_empty(grp_added)) + purrr::walk(grp_added, ~ { + if ("Low" == .x) { + value_l <- 0 + if ("Medium" %in% input$auto_include) { + value_u <- min(input$low_risk, input$med_risk[1]) + updateSliderInput(session, "low_risk", value = value_u) + } else if ("High" %in% input$auto_include) { + value_u <- min(input$low_risk, input$high_risk) + updateSliderInput(session, "low_risk", value = value_u) + } else { + value_u <- input$low_risk + } + } else if ("Medium" == .x) { + if ("Low" %in% input$auto_include) { + value_l <- max(input$low_risk, input$med_risk[1]) + updateSliderInput(session, "med_risk", value = c(value_l, max(value_l, input$med_risk[2]))) + } else { + value_l <- input$med_risk[1] + } + if ("High" %in% input$auto_include) { + value_u <- min(input$med_risk[2], input$high_risk) + updateSliderInput(session, "med_risk", value = c(min(input$med_risk[1], value_u), value_u)) + } else { + value_u <- input$med_risk[2] + } + } else if ("High" %in% grp_added) { + if ("Medium" %in% input$auto_include) { + value_l <- max(input$med_risk[2], input$high_risk) + updateSliderInput(session, "high_risk", value = value_l) + } else if ("Low" %in% input$auto_include) { + value_l <- max(input$low_risk, input$high_risk) + updateSliderInput(session, "high_risk", value = value_l) + } else { + value_l <- input$high_risk + } + value_u <- 1 + } + shinyjs::show(selector = glue::glue("[risk={tolower(.x)}")) + auto_decision[[.x]] <- c(value_l, value_u) + }) + + if (!rlang::is_empty(grp_removed)) + purrr::walk(grp_removed, ~ { + shinyjs::hide(selector = glue::glue("[risk={tolower(.x)}")) + auto_decision[[.x]] <- NULL + }) + + auto_current(input$auto_include) + }, ignoreNULL = FALSE) + + observeEvent(input$low_risk, { + req("Low" %in% input$auto_include) + + auto_decision$Low <- c(0, input$low_risk) + if ("Medium" %in% input$auto_include) + updateSliderInput(session, "med_risk", value = c(max(input$low_risk, input$med_risk[1]), max(input$low_risk, input$med_risk[2]))) + else if ("High" %in% input$auto_include) + updateSliderInput(session, "high_risk", value = max(input$low_risk, input$high_risk)) + }) + + observeEvent(input$med_risk, { + req("Medium" %in% input$auto_include) + + auto_decision$Medium <- input$med_risk + if ("Low" %in% input$auto_include) + updateSliderInput(session, "low_risk", value = min(input$low_risk, input$med_risk[1])) + if ("High" %in% input$auto_include) + updateSliderInput(session, "high_risk", value = max(input$med_risk[2], input$high_risk)) + }) + + observeEvent(input$high_risk, { + req("High" %in% input$auto_include) + + auto_decision$High <- c(input$high_risk, 1) + if ("Medium" %in% input$auto_include) + updateSliderInput(session, "med_risk", value = c(min(input$med_risk[1], input$high_risk), min(input$med_risk[2], input$high_risk))) + else if ("Low" %in% input$auto_include) + updateSliderInput(session, "low_risk", value = min(input$low_risk, input$high_risk)) + }) + + observeEvent(input$auto_reset, { + req(user$role == "admin") + + purrr::iwalk(auto_list(), ~ + if (.y == "Low") { + updateSliderInput(session, "low_risk", value = .x[2]) + } else if (.y == "Medium") { + updateSliderInput(session, "med_risk", value = .x) + } else if (.y == "High") { + updateSliderInput(session, "high_risk", value = .x[1]) + }) + updateCheckboxGroupInput(session, "auto_include", selected = names(auto_list())) + }) + + output$modal_table <- + DT::renderDataTable({ + out_lst <- purrr::compact(reactiveValuesToList(auto_decision)) + + DT::datatable({ + out_lst %>% + purrr::imap_dfr(~ dplyr::tibble(decision = .y, ll = .x[[1]], ul = .x[[2]])) %>% + dplyr::arrange(ll,) + }, + escape = FALSE, + class = "cell-border", + selection = 'none', + colnames = c("Decision Category", "Lower Limit", "Upper Limit"), + rownames = FALSE, + options = list( + dom = "t", + searching = FALSE, + sScrollX = "100%", + iDisplayLength = -1, + ordering = FALSE + )) + }) + + observeEvent(input$submit_auto, { + req(user$role == "admin") + + showModal(modalDialog( + size = "l", + easyClose = TRUE, + h5("Apply Decision Rules", style = 'text-align: center !important'), + hr(), + br(), + fluidRow( + column( + width = 12, + 'Please confirm your chosen decision rules: ', + br(), + if (!rlang::is_empty(purrr::compact(reactiveValuesToList(auto_decision)))) DT::DTOutput(ns("modal_table")) else h2("Disable Decision Automation"), + br(), + br(), + em('Note: Once submitted, these rules will be applied to all new packages loaded into the app or when any metric re-weighting is performed.') + ) + ), + br(), + footer = tagList( + actionButton(ns('confirm_submit_auto'), 'Submit'), + actionButton(ns('cancel'), 'Cancel') + ))) + }) + + # Close modal if user cancels decision submission. + observeEvent(input$cancel, { + removeModal() + shinyjs::click("auto_dropdown") + }) + + observeEvent(input$confirm_submit_auto, { + req(user$role == "admin") + + out_lst <- purrr::compact(reactiveValuesToList(auto_decision)) + jsonlite::write_json(out_lst, "auto_decisions.json") + auto_list(out_lst) + + if (length(out_lst) == 0) { + loggit::loggit("INFO", glue::glue("Decision automation rules have been disabled by {user$name} ({user$role}).")) + } else { + rules <- out_lst %>% + purrr::imap_chr(~ glue::glue("{.y} = ({.x[[1]]}, {.x[[2]]}]")) + loggit::loggit("INFO", glue::glue("The following decision rules were implemented by {user$name} ({user$role}): {paste(rules, collapse = '; ')}.")) + } + + removeModal() + shinyjs::click("auto_dropdown") + }) + } + }) + + return(auto_list) + }) +} + +## To be copied in the UI +# mod_decision_automation_ui("decision_automation_1") + +## To be copied in the server +# mod_decision_automation_server("decision_automation_1") diff --git a/R/mod_decision_automation_utils.R b/R/mod_decision_automation_utils.R new file mode 100644 index 000000000..27abbce39 --- /dev/null +++ b/R/mod_decision_automation_utils.R @@ -0,0 +1,19 @@ +#' Assign decision rules +#' +#' @noRd +assign_decisions <- function(decision_list, package) { + score <- get_pkg_info(package)$score + decision <- paste0(names(decision_list)[purrr::map_lgl(decision_list, ~ .x[1] < score && score <= .x[2])], "") + if (decision != "") { + dbUpdate(glue::glue("UPDATE package SET decision = '{decision}' WHERE name = '{package}'")) + loggit::loggit("INFO", + glue::glue("decision for the package {package} was assigned {decision} by decision automation rules")) + comment <- glue::glue("Risk was assigned ''{decision}'' by decision rules because the risk score was between {decision_list[[decision]][1]} and {decision_list[[decision]][2]}") + dbUpdate(glue::glue( + "INSERT INTO comments + VALUES ('{package}', 'auto_assign', 'admin', + '{comment}', 'o', '{getTimeStamp()}')")) + } + + return(decision) +} \ No newline at end of file diff --git a/R/mod_downloadHandler.R b/R/mod_downloadHandler.R new file mode 100644 index 000000000..41e24de19 --- /dev/null +++ b/R/mod_downloadHandler.R @@ -0,0 +1,207 @@ +#' downloadHandler UI Function +#' +#' @description A shiny Module. +#' +#' @param id,input,output,session Internal parameters for {shiny}. +#' +#' @noRd +mod_downloadHandler_button_ui <- function(id, multiple = TRUE){ + ns <- NS(id) + tagList( + downloadButton(ns("download_reports"), if (multiple) "Download Report(s)" else "Download Report") + ) +} + +#' downloadHandler UI Function +#' +#' @description A shiny Module. +#' +#' @param id,input,output,session Internal parameters for {shiny}. +#' +#' @noRd +mod_downloadHandler_filetype_ui <- function(id){ + ns <- NS(id) + tagList( + selectInput(ns("report_format"), "Select Format", c("html", "docx", "pdf")) + ) +} + +#' downloadHandler Server Functions +#' +#' @noRd +mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){ + moduleServer( id, function(input, output, session){ + ns <- session$ns + + observe({ + if(isTruthy(pkgs())) { + shinyjs::enable("download_reports") + } else { + shinyjs::disable("download_reports") + } + }) + + output$download_reports <- downloadHandler( + filename = function() { + n_pkgs <- length(pkgs()) + + if (n_pkgs > 1) { + report_datetime <- stringr::str_replace_all(stringr::str_replace(Sys.time(), " ", "_"), ":", "-") + glue::glue('RiskAssessment-Report-{report_datetime}.zip') + } else { + pkg_ver <- dbSelect(glue::glue("SELECT version FROM package WHERE name = '{pkgs()}'")) + glue::glue('{pkgs()}_{pkg_ver}_Risk_Assessment.{input$report_format}') + } + }, + content = function(file) { + n_pkgs <- length(pkgs()) + + req(n_pkgs > 0) + + shiny::withProgress( + message = glue::glue('Downloading {ifelse(n_pkgs > 1, paste0(n_pkgs, " "), "")}Report{ifelse(n_pkgs > 1, "s", paste0(": ", pkgs()))}'), + value = 0, + max = n_pkgs + 2, # Tell the progress bar the total number of events. + { + shiny::incProgress(1) + + my_tempdir <- tempdir() + if (input$report_format == "html") { + + # https://github.com/rstudio/fontawesome/issues/99 + # Here, we make sure user has a functional version of fontawesome + fa_v <- packageVersion("fontawesome") + if(fa_v == '0.4.0') { + msg1 <- "HTML reports will not render with {fontawesome} v0.4.0." + msg2 <- glue::glue("You currently have v{fa_v} installed. If the report download failed, please install a stable version. We recommend v0.5.0 or higher.") + warning(paste(msg1, msg2)) + showModal(modalDialog( + size = "l", + title = h3(msg1, class = "mb-0 mt-0 txt-color"), + h5(msg2) + )) + } + + Report <- file.path(my_tempdir, "reportHtml.Rmd") + file.copy(system.file('app/www', 'reportHtml.Rmd', package = "riskassessment"), Report, overwrite = TRUE) + file.copy(system.file('app/www', 'raa-image.png', package = "riskassessment"), + file.path(my_tempdir, 'raa-image.png'), overwrite = TRUE) + } + else if (input$report_format == "docx") { + Report <- file.path(my_tempdir, "reportDocx.Rmd") + if (!dir.exists(file.path(my_tempdir, "images"))) + dir.create(file.path(my_tempdir, "images")) + file.copy(system.file('app/www', 'ReportDocx.Rmd', package = "riskassessment"), + Report, + overwrite = TRUE) + file.copy(system.file('app/www', 'read_html.lua', package = "riskassessment"), + file.path(my_tempdir, "read_html.lua"), overwrite = TRUE) + file.copy(system.file('app/www', 'images', 'user-tie.png', package = "riskassessment"), + file.path(my_tempdir, "images", "user-tie.png"), + overwrite = TRUE) + file.copy(system.file('app/www', 'images', 'user-shield.png', package = "riskassessment"), + file.path(my_tempdir, "images", "user-shield.png"), + overwrite = TRUE) + file.copy(system.file('app/www', 'images', 'calendar-alt.png', package = "riskassessment"), + file.path(my_tempdir, "images", "calendar-alt.png"), + overwrite = TRUE) + } + else { + Report <- file.path(my_tempdir, "reportPdf.Rmd") + if (!dir.exists(file.path(my_tempdir, "images"))) + dir.create(file.path(my_tempdir, "images")) + file.copy(system.file('app/www', 'ReportPdf.Rmd', package = "riskassessment"), + Report, + overwrite = TRUE) + file.copy(system.file('app/www', 'read_html.lua', package = "riskassessment"), + file.path(my_tempdir, "read_html.lua"), overwrite = TRUE) + file.copy(system.file('app/www', 'images', 'user-tie.png', package = "riskassessment"), + file.path(my_tempdir, "images", "user-tie.png"), + overwrite = TRUE) + file.copy(system.file('app/www', 'images', 'user-shield.png', package = "riskassessment"), + file.path(my_tempdir, "images", "user-shield.png"), + overwrite = TRUE) + file.copy(system.file('app/www', 'images', 'calendar-alt.png', package = "riskassessment"), + file.path(my_tempdir, "images", "calendar-alt.png"), + overwrite = TRUE) + } + + fs <- c() + for (i in 1:n_pkgs) { + # Grab package name and version, then create filename and path. + # this_pkg <- "stringr" # for testing + selected_pkg <- get_pkg_info(pkgs()[i]) + this_pkg <- selected_pkg$name + this_ver <- selected_pkg$version + file_named <- glue::glue('{this_pkg}_{this_ver}_Risk_Assessment.{input$report_format}') + path <- if (n_pkgs > 1) { + file.path(my_tempdir, file_named) + } else { + file + } + + pkg_list <- list( + id = selected_pkg$id, + name = selected_pkg$name, + version = selected_pkg$version, + title = selected_pkg$title, + decision = selected_pkg$decision, + description = selected_pkg$description, + author = selected_pkg$author, + maintainer = selected_pkg$maintainer, + license = selected_pkg$license, + published = selected_pkg$published, + score = selected_pkg$score + ) + + # gather comments data + overall_comments <- get_overall_comments(this_pkg) + mm_comments <- get_mm_comments(this_pkg) + cm_comments <- get_cm_comments(this_pkg) + + # gather maint metrics & community metric data + mm_data <- get_mm_data(pkg_list$id) + comm_data <- get_comm_data(this_pkg) + comm_cards <- build_comm_cards(comm_data) + downloads_plot <- build_comm_plotly(comm_data) + + # Render the report, passing parameters to the rmd file. + rmarkdown::render( + input = Report, + output_file = path, + clean = FALSE, + params = list(pkg = pkg_list, + riskmetric_version = paste0(packageVersion("riskmetric")), + app_version = golem::get_golem_options('app_version'), + metric_weights = metric_weights(), + user_name = user$name, + user_role = user$role, + overall_comments = overall_comments, + mm_comments = mm_comments, + cm_comments = cm_comments, + maint_metrics = mm_data, + com_metrics = comm_cards, + com_metrics_raw = comm_data, + downloads_plot_data = downloads_plot + ) + ) + fs <- c(fs, path) # Save all the reports/ + shiny::incProgress(1) # Increment progress bar. + } + # Zip all the files up. -j retains just the files in zip file. + if (n_pkgs > 1) zip(zipfile = file, files = fs, extras = "-j") + shiny::incProgress(1) # Increment progress bar. + }) + } + ) + }) +} + +## To be copied in the UI +# mod_downloadHandler_button_ui("downloadHandler_1") + +## To be copied in the UI +# mod_downloadHandler_filetype_ui("downloadHandler_1") + +## To be copied in the server +# mod_downloadHandler_server("downloadHandler_1") diff --git a/R/introJS.R b/R/mod_introJS.R similarity index 96% rename from R/introJS.R rename to R/mod_introJS.R index 9794c3637..052e2131c 100644 --- a/R/introJS.R +++ b/R/mod_introJS.R @@ -2,8 +2,8 @@ #'UI for Module to display introJS button and functionality. #' #' @param id a module id +#' @keywords internal #' -#' @import shiny introJSUI <- function(id) { fluidRow( style = "float: right", @@ -27,9 +27,9 @@ introJSUI <- function(id) { #' relationship to the element. Please see `R/introJSText.R` for data.frames #' that populate this argument for the app #' -#' @import shiny +#' #' @importFrom rintrojs introjs -#' +#' @keywords internal introJSServer <- function(id, text) { moduleServer(id, function(input, output, session) { diff --git a/R/introJSText.R b/R/mod_introJS_utils_text.R similarity index 57% rename from R/introJSText.R rename to R/mod_introJS_utils_text.R index efba4c99e..503a090a4 100644 --- a/R/introJSText.R +++ b/R/mod_introJS_utils_text.R @@ -6,48 +6,77 @@ sidebar_steps <- data.frame( element = c( - "#assessment-criteria-tab","#database-tab", "#sidebar-select_pkg_ui", # "#sidebar-select_ver", # not working "#sidebar-status-wp", "#sidebar-score-wp", "#sidebar-decision-grp", "#sidebar-overall-comment-grp"), intro = c( - "Discover the package assessment process & criteria", - "Review the R packages that already exist in the database", - "Expand this dropdown list to selet assess a specific package that was previously uploaded. Then select a version (if more than one exists).", + "Expand this dropdown list to select a specific package to assess that was previously uploaded.", # "The latest version will autopopulate here.", # can't peg ui object name, even with a div! "The status can be either 'Under Review' or 'Reviewed'.", "The score can take any value between 0 (no risk) and 1 (highest risk).", - "After reviewing your package, you can leave an overall comment.", - "Provide your input on the overall risk of the selected package." + "Provide your input on the overall risk of the selected package.", + "After reviewing your package, you can leave an overall comment." ), - position = c(rep("bottom", 7)) + position = c(rep("bottom", 5)) ) +# appui tab widgets +apptab_steps <- data.frame( + element = c( + "[data-value=assessment-criteria-tab]", "[data-value=database-tab]"), + intro = c("Discover the package assessment process & criteria", + "Review the R packages that already exist in the database"), + position = c(rep("bottom", 2)) +) + +apptab_admn <- data.frame( + element = c( + "[data-value=admin-mode-tab]"), + intro = c("Manage user credentials and apply assessment reweighting here"), + position = "bottom" +) + # upload package tab. upload_pkg <- data.frame( - element = c("#upload_package-introJS-help", "#upload-file-grp", "#upload_package-upload_format"), + element = c("#upload_package-introJS-help", "#type-package-group", "#upload-file-grp", "#upload_package-upload_format"), intro = c( "Click here anytime you need help.", - "Upload a CSV file with the package(s) you would like to assess.", - "You can use this sample dataset to explore the app." + "Type in the name of the package(s) you would like to assess.", + "Or you can Upload a CSV file with the package(s) if you have a lot.", + "Follow format of this sample data when creating your csv. Or you can even download it to use as a template." ), - position = c("right", rep("top", 2)) + position = c("right", rep("top", 3)) ) -upload_pkg_complete <- union(upload_pkg, - data.frame( +upload_adm <- data.frame( + element = "#rem-package-group", + intro = "If you are an admin, you can also remove packages here.", + position = "top" +) + +upload_pkg_comp <- data.frame( element = c("#upload_summary_div", "#upload_package-upload_pkgs_table"), intro = c( "Text description of packages uploaded. Counts by type: 'Total', 'New', 'Undiscovered', 'Duplicate'.", "Confirm uploaded packages list, filter by type" ), position = c("bottom", "top") - ) -# # } else { -# # data.frame(element = character(0) , intro = character(0), position = character(0)) -# # } - ) +) + +upload_pkg_complete <- union(upload_pkg, + data.frame( + element = c("#upload_summary_div", "#upload_package-upload_pkgs_table"), + intro = c( + "Text description of packages uploaded. Counts by type: 'Total', 'New', 'Undiscovered', 'Duplicate'.", + "Confirm uploaded packages list, filter by type" + ), + position = c("bottom", "top") + ) + # # } else { + # # data.frame(element = character(0) , intro = character(0), position = character(0)) + # # } +) # Maintenance metrics. diff --git a/R/maintenanceMetrics.R b/R/mod_maintenanceMetrics.R similarity index 88% rename from R/maintenanceMetrics.R rename to R/mod_maintenanceMetrics.R index 4410a20a5..0b26eb81f 100644 --- a/R/maintenanceMetrics.R +++ b/R/mod_maintenanceMetrics.R @@ -1,8 +1,8 @@ #' Maintenance Metrics module's UI. #' #' @param id a module id name +#' @keywords internal #' -#' @import shiny maintenanceMetricsUI <- function(id) { uiOutput(NS(id, 'maintenance_metrics_ui')) } @@ -14,8 +14,9 @@ maintenanceMetricsUI <- function(id) { #' @param maint_metrics placeholder #' @param user placeholder #' -#' @import shiny #' @import dplyr +#' @keywords internal +#' maintenanceMetricsServer <- function(id, selected_pkg, maint_metrics, user) { moduleServer(id, function(input, output, session) { # Render Output UI for Maintenance Metrics. @@ -44,9 +45,17 @@ maintenanceMetricsServer <- function(id, selected_pkg, maint_metrics, user) { } }) - # IntroJS. - introJSServer(id = "introJS", text = mm_steps) + mm_text <- reactive({ + if(user$role == "admin") { + apptab_steps <- bind_rows(apptab_admn, apptab_steps) + } + mm_steps %>% + bind_rows(apptab_steps) + }) + # IntroJS. + introJSServer(id = "introJS", text = mm_text()) + # Call module that creates section to add comments. comment_added <- addCommentServer(id = "add_comment", metric_abrv = 'mm', @@ -71,4 +80,4 @@ maintenanceMetricsServer <- function(id, selected_pkg, maint_metrics, user) { comment_added = comment_added ) }) -} \ No newline at end of file +} diff --git a/R/metricBox.R b/R/mod_metricBox.R similarity index 62% rename from R/metricBox.R rename to R/mod_metricBox.R index da412aa89..79679ef15 100644 --- a/R/metricBox.R +++ b/R/mod_metricBox.R @@ -1,8 +1,8 @@ #' The UI for the 'Metric Box' module #' #' @param id a module id name +#' @keywords internal #' -#' @import shiny metricBoxUI <- function(id) { uiOutput(NS(id, "metricBox_ui")) } @@ -13,16 +13,17 @@ metricBoxUI <- function(id) { #' @param title title. #' @param desc description. #' @param value metric value. -#' @param is_true whether the metric is TRUE. If true, then the succ_icon will -#' be used; if false, then the unsucc_icon will be used. -#' @param is_perc whether the value is a percentage. +#' @param is_perc logical is the value is a percentage? +#' @param is_url logical is the value a url #' @param succ_icon icon used if is_true. #' @param unsucc_icon icon used if not is_true. +#' @param icon_class string type of icon #' -#' @import shiny +#' #' @import dplyr #' @importFrom stringr str_sub #' @importFrom glue glue +#' @keywords internal #' metricBoxServer <- function(id, title, desc, value, is_perc = FALSE, is_url = FALSE, @@ -35,6 +36,8 @@ metricBoxServer <- function(id, title, desc, value, output$metricBox_ui <- renderUI({ req(title, desc, value) + # 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")) @@ -42,10 +45,14 @@ metricBoxServer <- function(id, title, desc, value, else if(is_perc) value <- glue::glue('{round(as.numeric(value), 1)}%') else if(is_url) - value <- a(glue::glue('{stringr::str_sub(value, 1, 29)}...'), href = value) + value <- a(ifelse(nchar(value) <= val_max_nchar, value, + glue::glue('{stringr::str_sub(value, 1, (val_max_nchar - 3))}...') + ), href = value) + # unfortunately, adding the href can sometimes force the footer to fall + # outside the card when val_max_nchar is too large. else if(value %in% c('TRUE', 'FALSE')) value <- ifelse(value == 'TRUE', 'Yes', 'No') - + icon_name <- succ_icon if(!is_true){ @@ -58,21 +65,26 @@ metricBoxServer <- function(id, title, desc, value, icon_class <- "text-info" } - card_style = "max-width: 400px; max-height: 250px; overflow-y: scroll;" + # 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, txt_max = val_max_nchar, + size_min = .85, size_max = 1.5) #, num_bins = 3 + body_p_style = glue::glue('font-size: {auto_font_out}vw') div(class="card mb-3 text-center border-info", style=card_style, - div(class ="row no-gutters", + div(class ="row no-gutters;", div(class="col-md-4 text-center border-info", - icon(icon_name, class=icon_class, + icon(icon_name, class=icon_class, verify_fa = FALSE, style="padding-top: 40%; font-size:60px; padding-left: 20%;")), div(class="col-md-8", h5(class="card-header bg-transparent", style="font-size: 1vw", title), div(class="card-body text-info", - p(class="card-title", style="font-size: 1.5vw", value))), + p(class="card-title", style= body_p_style, value))), div(class="card-footer bg-transparent", desc) ) ) }) }) -} \ No newline at end of file +} + diff --git a/R/metricGrid.R b/R/mod_metricGrid.R similarity index 67% rename from R/metricGrid.R rename to R/mod_metricGrid.R index 86e9a68e4..4e30e65f6 100644 --- a/R/metricGrid.R +++ b/R/mod_metricGrid.R @@ -2,8 +2,8 @@ #' Metric Grid module's UI. #' #' @param id a module id name +#' @keywords internal #' -#' @import shiny metricGridUI <- function(id) { fluidPage(uiOutput(NS(id, 'grid'))) } @@ -14,13 +14,15 @@ metricGridUI <- function(id) { #' @param id a module id name #' @param metrics placeholder #' -#' @import shiny +#' @keywords internal +#' #' @import dplyr metricGridServer <- function(id, metrics) { moduleServer(id, function(input, output, session) { + output$grid <- renderUI({ - req(metrics()) + req(nrow(metrics()) > 0) col_length <- nrow(metrics())%/%3 @@ -43,17 +45,19 @@ metricGridServer <- function(id, metrics) { ) }) - observeEvent(metrics(), { + observeEvent(req(nrow(metrics()) > 0), { apply(metrics(), 1, function(metric) metricBoxServer(id = metric['name'], - title = metric['title'], - desc = metric['desc'], - value = metric['value'], - is_perc = metric['is_perc'] == 1, - is_url = metric['is_url'] == 1, - succ_icon = metric['succ_icon'], - icon_class = metric['icon_class']) + title = metric['title'], + desc = metric['desc'], + value = dplyr::case_when(metric['name'] != 'has_bug_reports_url' ~ metric['value'], + metric['value'] == "1" ~ 'TRUE', + TRUE ~ 'FALSE'), + is_perc = metric['is_perc'] == 1, + is_url = metric['is_url'] == 1, + succ_icon = metric['succ_icon'], + icon_class = metric['icon_class']) ) }) }) -} \ No newline at end of file +} diff --git a/R/reportPreview.R b/R/mod_reportPreview.R similarity index 57% rename from R/reportPreview.R rename to R/mod_reportPreview.R index 2d674dc4f..c1dc30f4f 100644 --- a/R/reportPreview.R +++ b/R/mod_reportPreview.R @@ -1,8 +1,8 @@ #' UI for 'Report Preview' module #' #' @param id a module id name +#' @keywords internal #' -#' @import shiny reportPreviewUI <- function(id) { uiOutput(NS(id, "reportPreview_ui")) } @@ -21,12 +21,13 @@ reportPreviewUI <- function(id) { #' @param app_version placeholder #' @param metric_weights placeholder #' -#' @import shiny +#' #' @import dplyr #' @importFrom rmarkdown render #' @importFrom plotly plotlyOutput renderPlotly #' @importFrom DT dataTableOutput renderDataTable #' @importFrom glue glue +#' @keywords internal #' reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, com_metrics_raw, mm_comments, cm_comments, @@ -34,9 +35,17 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, metric_weights) { moduleServer(id, function(input, output, session) { - # IntroJS. - introJSServer(id = "introJS", text = rp_steps) + rp_text <- reactive({ + if(user$role == "admin") { + apptab_steps <- bind_rows(apptab_admn, apptab_steps) + } + rp_steps %>% + bind_rows(apptab_steps) + }) + # IntroJS. + introJSServer(id = "introJS", text = rp_text()) + # Render Output UI for Report Preview. output$reportPreview_ui <- renderUI({ @@ -53,8 +62,8 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, br(), br(), div(id = "dwnld_rp", - selectInput(NS(id, "report_format"), "Select Format", c("html", "docx")), - downloadButton(NS(id, 'download_report'), "Download Report") + mod_downloadHandler_filetype_ui(NS(id, "downloadHandler")), + mod_downloadHandler_button_ui(NS(id, "downloadHandler"), multiple = FALSE) ), br(), br(), @@ -84,14 +93,7 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, br(), br(), hr(), fluidRow( - column(width = 12, - h5("Community Usage Metrics", - style = "text-align: center; padding-bottom: 50px;"), - metricGridUI(NS(id, 'cm_metricGrid')), - div(id = "cum_plot", fluidRow( - column(width = 12, style = 'padding-left: 20px; padding-right: 20px;', - plotly::plotlyOutput(NS(id, "downloads_plot"), height = "500px")))), - viewCommentsUI(NS(id, 'cm_comments'))) + column(width = 12, uiOutput(NS(id, 'communityMetrics_ui'))) ), br(), br(), hr(), @@ -145,6 +147,31 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, # Community usage metrics cards. metricGridServer("cm_metricGrid", metrics = com_metrics) + output$communityMetrics_ui <- renderUI({ + req(selected_pkg$name()) + + vect <- dbSelect("select distinct id from community_usage_metrics") %>% dplyr::pull() + + if(!selected_pkg$name() %in% vect) { + tagList( + h5("Community Usage Metrics", + style = "text-align: center;"), + showHelperMessage(message = glue::glue("Community Usage Metrics not avaiable for ", {selected_pkg$name()} )) + ) + } else { + tagList( + h5("Community Usage Metrics", + style = "text-align: center; padding-bottom: 50px;"), + metricGridUI(NS(id, 'cm_metricGrid')), + div(id = "cum_plot", fluidRow( + column(width = 12, style = 'padding-left: 20px; padding-right: 20px;', + plotly::plotlyOutput(NS(id, "downloads_plot"), height = "500px")))), + viewCommentsUI(NS(id, 'cm_comments')) + ) + } + + }) + # Display general information of the selected package. output$pkg_overview <- renderUI({ @@ -164,8 +191,11 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, # Display the decision status of the selected package. output$decision_display <- renderUI({ + req(selected_pkg$name()) tagList( + h5('Risk Score:'), + selected_pkg$score(), h5('Overall risk:'), ifelse(selected_pkg$decision() == '', 'Pending', @@ -177,7 +207,7 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, req(selected_pkg$name()) tagList( - h5('Risk Assessment App Version:'), app_version, + h5('{riskassessment} App Version:'), app_version, h5('riskmetric Version:'), paste0(packageVersion("riskmetric")), h5('Generated on:'), format(Sys.time(), usetz = TRUE) ) @@ -192,83 +222,6 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, }, options = list(searching = FALSE, pageLength = 15, lengthChange = FALSE, info = FALSE)) - # Create report. - output$download_report <- downloadHandler( - filename = function() { - glue::glue('{selected_pkg$name()}_{selected_pkg$version()}_Risk_Assessment.', - "{switch(input$report_format, docx = 'docx', html = 'html')}") - }, - content = function(file) { - shiny::withProgress( - message = glue::glue('Downloading Report: {selected_pkg$name()}'), - value = 0, - { - shiny::incProgress(1 / 10) - shiny::incProgress(5 / 10) - - report <- '' - my_tempdir <- tempdir() - - if (input$report_format == "html") { - report <- file.path('inst/app/www', 'reportHtml.Rmd') - } - else { - report <- file.path(my_tempdir, "reportDocx.Rmd") - if (!dir.exists(file.path(my_tempdir, "images"))) - dir.create(file.path(my_tempdir, "images")) - file.copy(file.path('inst/app/www', 'reportDocx.Rmd'), - report, overwrite = TRUE) - file.copy(file.path('inst/app/www', 'read_html.lua'), - file.path(my_tempdir, "read_html.lua"), - overwrite = TRUE) - file.copy(file.path('inst/app/www', 'images', 'user-tie.png'), - file.path(my_tempdir, "images", "user-tie.png"), - overwrite = TRUE) - file.copy(file.path('inst/app/www', 'images', 'user-shield.png'), - file.path(my_tempdir, "images", "user-shield.png"), - overwrite = TRUE) - file.copy(file.path('inst/app/www', 'images', 'calendar-alt.png'), - file.path(my_tempdir, "images", "calendar-alt.png"), - overwrite = TRUE) - } - - # file.copy(report, report_path, overwrite = TRUE) - - # Collect info about package. - pkg <- list( - id = selected_pkg$id(), - name = selected_pkg$name(), - version = selected_pkg$version(), - title = selected_pkg$title(), - decision = selected_pkg$decision(), - description = selected_pkg$description(), - author = selected_pkg$author(), - maintainer = selected_pkg$maintainer(), - license = selected_pkg$license(), - published = selected_pkg$published() - ) - - rmarkdown::render( - report, - output_file = file, - params = list(pkg = pkg, - riskmetric_version = paste0(packageVersion("riskmetric")), - app_version = app_version, - metric_weights = metric_weights(), - user_name = user$name, - user_role = user$role, - overall_comments = overall_comments(), - mm_comments = mm_comments(), - cm_comments = cm_comments(), - maint_metrics = maint_metrics(), - com_metrics = com_metrics(), - com_metrics_raw = com_metrics_raw(), # used for word doc - downloads_plot_data = downloads_plot_data() - ), - envir = new.env(parent = globalenv()) - ) - }) - } - ) + mod_downloadHandler_server("downloadHandler", selected_pkg$name, user, metric_weights) }) } diff --git a/R/reweightView.R b/R/mod_reweightView.R similarity index 86% rename from R/reweightView.R rename to R/mod_reweightView.R index 99389525f..926aabf5f 100644 --- a/R/reweightView.R +++ b/R/mod_reweightView.R @@ -1,8 +1,7 @@ #' UI for the 'Re-weight View' module #' #' @param id the module id -#' -#' @import shiny +#' @keywords internal #' reweightViewUI <- function(id) { tagList( @@ -15,8 +14,9 @@ reweightViewUI <- function(id) { #' #' @param id the module id #' @param user the user name +#' @param decision_list the list containing the decision automation criteria +#' #' -#' @import shiny #' @import dplyr #' @importFrom DT datatable formatStyle styleEqual renderDataTable #' @importFrom shinyjs enable disable delay @@ -24,9 +24,19 @@ reweightViewUI <- function(id) { #' @importFrom DBI dbConnect dbDisconnect #' @importFrom RSQLite SQLite sqliteCopyDatabase #' -reweightViewServer <- function(id, user) { +#' @keywords internal +reweightViewServer <- function(id, user, decision_list) { moduleServer(id, function(input, output, session) { + exportTestValues( + save = { + reactiveValuesToList(save) + }, + curr_new_wts = { + curr_new_wts() + } + ) + save <- reactiveValues(data=NULL) curr_new_wts <- reactiveVal( @@ -35,6 +45,7 @@ reweightViewServer <- function(id, user) { dplyr::mutate(weight = ifelse(name == "covr_coverage", 0, weight))) observeEvent(input$update_weight, { + req(user$role == "admin") curr_new_wts(save$data %>% dplyr::mutate(new_weight = ifelse(name == isolate(input$metric_name), isolate(input$metric_weight), new_weight))) @@ -117,11 +128,13 @@ reweightViewServer <- function(id, user) { DT::dataTableOutput(NS(id, "weights_table"))) ), br(), br(), br(), - conditionalPanel("input.metric_name === 'covr_coverage'", + conditionalPanel("input.metric_name === 'covr_coverage'", + ns = NS(id), fluidRow( - column(width = 12, tags$div(style = "color: red", - h5(em("Note: the 'covr_coverage' metric is currently disabled (weight = 0) until the 'riskmetric' package returns a non-NA value for this metric. - ")))) + column(1), + column(width = 10, h5(em("Note: the 'covr_coverage' metric is currently disabled (weight = 0) until the 'riskmetric' package returns a non-NA value for this metric. + "), style = "color: red;"), align = "center"), + column(1) ), br() ), @@ -139,7 +152,26 @@ reweightViewServer <- function(id, user) { ) }) - # make sure "Re-calculate" button is disbaled if no weights have changed. Need to make + metric_weight <- debounce(reactive(input$metric_weight), 500) + + observeEvent(input$metric_weight, { + shinyjs::disable("update_weight") + }) + observeEvent(metric_weight(), { + req(input$metric_name) + + if (input$metric_name == "covr_coverage" && (is.na(metric_weight()) || metric_weight() != 0)) { + updateNumericInput(session, "metric_weight", value = 0) + } else if (is.na(metric_weight()) || metric_weight() < 0) { + updateNumericInput(session, "metric_weight", value = 0) + } else if (metric_weight() != curr_new_wts() %>% + dplyr::filter(name == input$metric_name) %>% + dplyr::pull(new_weight)){ + shinyjs::enable("update_weight") + } + }) + + # make sure "Re-calculate" button is disabled if no weights have changed. Need to make # sure renderUI exists, so we put a req() on metric_name input and also a .5 second delay # on the disable/ enable functions to give renderUI enough time to re-render n_wts_chngd <- reactive({ @@ -161,6 +193,7 @@ reweightViewServer <- function(id, user) { # Update metric weight dropdown so that it matches the metric name. observeEvent(input$metric_name, { + req(user$role == "admin") if(input$metric_name == "covr_coverage"){ # set to zero, don't allow change until riskmetric fixes this assessment @@ -181,12 +214,14 @@ reweightViewServer <- function(id, user) { # Note that another of the observeEvents will update the metric weight after # the selected metric name is updated. observeEvent(input$weights_table_rows_selected, { + req(user$role == "admin") updateSelectInput(session, "metric_name", selected = curr_new_wts()$name[input$weights_table_rows_selected]) }) # Save new weight into db. - observeEvent(input$update_pkg_risk, { + observeEvent(input$update_pkg_risk, { + req(user$role == "admin") # if you the user goes input$back2dash, then when they return to the if(n_wts_chngd() == 0){ @@ -223,6 +258,7 @@ reweightViewServer <- function(id, user) { # Upon confirming the risk re-calculation observeEvent(input$confirm_update_risk, { + req(user$role == "admin") removeModal() # Update the weights in the `metric` table to reflect recent changes @@ -290,7 +326,10 @@ reweightViewServer <- function(id, user) { "DELETE FROM package_metrics WHERE package_id = (SELECT id FROM package WHERE name = '{pkg$pkg_name[i]}')") ) # metric_mm_tm_Info_upload_to_DB(pkg$pkg_name[i]) - insert_maintenance_metrics_to_db(pkg$pkg_name[i]) + insert_riskmetric_to_db(pkg$pkg_name[i]) + if (!rlang::is_empty(decision_list())) { + assign_decisions(decision_list(), pkg$pkg_name[i]) + } } }) @@ -313,7 +352,7 @@ reweightViewServer <- function(id, user) { glue::glue("datase_backup-{Sys.Date()}.sqlite") }, content = function(file) { - con <- DBI::dbConnect(RSQLite::SQLite(), database_name) + con <- DBI::dbConnect(RSQLite::SQLite(), golem::get_golem_options('assessment_db_name')) cbk <- DBI::dbConnect(RSQLite::SQLite(), file) RSQLite::sqliteCopyDatabase(con, cbk) DBI::dbDisconnect(con) diff --git a/R/sidebar.R b/R/mod_sidebar.R similarity index 98% rename from R/sidebar.R rename to R/mod_sidebar.R index 07db50bd7..bc50a107a 100644 --- a/R/sidebar.R +++ b/R/mod_sidebar.R @@ -4,12 +4,9 @@ #' most components of the app, central to it's function #' #' @param id a module id -#' @param user a username -#' @param uploaded_pkgs a vector of packages #' -#' @import shiny #' @importFrom shinyjs disabled -#' +#' @keywords internal sidebarUI <- function(id) { tagList( tags$b(h4("Package Control Panel", style = "text-align: center;")), @@ -85,14 +82,15 @@ sidebarUI <- function(id) { #' @param user a username #' @param uploaded_pkgs a vector of packages #' -#' @import shiny +#' #' @importFrom shinyjs enable disable +#' @keywords internal #' sidebarServer <- function(id, user, uploaded_pkgs) { moduleServer(id, function(input, output, session) { # Required for shinyhelper to work. - shinyhelper::observe_helpers() + # shinyhelper::observe_helpers() # Create list of packages. output$select_pkg_ui <- renderUI({ @@ -448,7 +446,8 @@ sidebarServer <- function(id, user, uploaded_pkgs) { maintainer = reactive(selected_pkg$maintainer), license = reactive(selected_pkg$license), published = reactive(selected_pkg$published), - overall_comment_added = reactive(c(input$submit_overall_comment, input$submit_overall_comment_yes)) + overall_comment_added = reactive(c(input$submit_overall_comment, input$submit_overall_comment_yes)), + score = reactive(selected_pkg$score) ) }) } diff --git a/R/mod_uploadPackage.R b/R/mod_uploadPackage.R new file mode 100644 index 000000000..32fcbf8fb --- /dev/null +++ b/R/mod_uploadPackage.R @@ -0,0 +1,462 @@ +#' 'Upload Package' UI +#' +#' @param id a module id +#' +#' +#' @importFrom DT dataTableOutput +#' @keywords internal +#' +uploadPackageUI <- function(id) { + fluidPage( + br(), br(), + + introJSUI(NS(id, "introJS")), + + tags$head(tags$style(".shiny-notification {font-size:30px; color:darkblue; position: fixed; width:415px; height: 150px; top: 75% ;right: 10%;")), + + fluidRow( + + column( + width = 4, + div( + id = "type-package-group", + style = "display: flex;", + selectizeInput(NS(id, "pkg_lst"), "Type Package Name(s)", choices = NULL, multiple = TRUE, + options = list(create = TRUE, showAddOptionOnCreate = FALSE, + onFocus = I(paste0('function() {Shiny.setInputValue("', NS(id, "load_cran"), '", "load", {priority: "event"})}')))), + actionButton(NS(id, "add_pkgs"), shiny::icon("angle-right"), + style = 'height: calc(1.5em + 1.5rem + 2px)'), + tags$head(tags$script(I(paste0('$(window).on("load resize", function() {$("#', NS(id, "add_pkgs"), '").css("margin-top", $("#', NS(id, "pkg_lst"), '-label")[0].scrollHeight + .5*parseFloat(getComputedStyle(document.documentElement).fontSize));});')))) + ), + + uiOutput(NS(id, "rem_pkg_div")) + ), + column(width = 1), + + column( + width = 4, + div(id = "upload-file-grp", + fileInput( + inputId = NS(id, "uploaded_file"), + label = "Or Upload a CSV file", + accept = ".csv", + placeholder = "No file selected" + ) + ), + actionLink(NS(id, "upload_format"), "View Sample Dataset") + ), + ), + fluidRow(mod_decision_automation_ui(NS(id, "automate"))), + + # Display the summary information of the uploaded csv. + fluidRow(column(width = 12, htmlOutput(NS(id, "upload_summary_text")))), + + # Summary of packages uploaded. + fluidRow(column(width = 12, DT::dataTableOutput(NS(id, "upload_pkgs_table")))) + ) +} + + +#' Server logic for the 'Upload Package' module +#' +#' @param id a module id +#' @param user a username +#' +#' @importFrom riskmetric pkg_ref +#' @importFrom rintrojs introjs +#' @importFrom utils read.csv available.packages +#' @importFrom rvest read_html html_nodes html_text +#' @keywords internal +#' +uploadPackageServer <- function(id, user) { + moduleServer(id, function(input, output, session) { + + # Determine which guide to use for IntroJS. + upload_pkg_txt <- reactive({ + req(uploaded_pkgs()) + + if(user$role == "admin") { + upload_pkg <- bind_rows(upload_pkg, upload_adm) + apptab_steps <- bind_rows(apptab_admn, apptab_steps) + } + if(nrow(uploaded_pkgs()) > 0) + upload_pkg_complete <- bind_rows(upload_pkg, upload_pkg_comp) %>% + bind_rows(apptab_steps) + else + upload_pkg %>% + bind_rows(apptab_steps) + }) + + auto_list <- mod_decision_automation_server("automate", user) + + cran_pkgs <- reactiveVal() + + observeEvent(input$load_cran, { + if (!isTruthy(cran_pkgs())) { + if (isTRUE(getOption("shiny.testmode"))) { + cran_pkgs(c("dplyr", "tidyr", "readr", "purrr", "tibble", "stringr", "forcats")) + } else { + cran_pkgs(available.packages("https://cran.rstudio.com/src/contrib")[,1]) + } + } + }, + once = TRUE) + + pkgs_have <- reactiveVal() + + observeEvent(input$curr_pkgs, { + pkgs_have(dbSelect("select name from package")[,1]) + }) + + observeEvent(cran_pkgs(), { + req(cran_pkgs()) + updateSelectizeInput(session, "pkg_lst", choices = cran_pkgs(), server = TRUE) + }) + + observeEvent(pkgs_have(), { + req(pkgs_have()) + req(user$role == "admin") + updateSelectizeInput(session, "rem_pkg_lst", choices = pkgs_have(), server = TRUE) + }) + + # Start introjs when help button is pressed. Had to do this outside of + # a module in order to take a reactive data frame of steps + observeEvent( + input[["introJS-help"]], # notice input contains "id-help" + rintrojs::introjs(session, + options = list( + steps = + upload_pkg_txt() %>% + union(sidebar_steps), + "nextLabel" = "Next", + "prevLabel" = "Previous" + ) + ), + ) + + uploaded_pkgs00 <- reactiveVal() + + observeEvent(user$role, { + req(user$role == "admin") + output$rem_pkg_div <- renderUI({ + div( + id = "rem-package-group", + style = "display: flex;", + selectizeInput(NS(id, "rem_pkg_lst"), "Remove Package(s)", choices = NULL, multiple = TRUE, + options = list(create = FALSE, showAddOptionOnCreate = FALSE, + onFocus = I(paste0('function() {Shiny.setInputValue("', NS(id, "curr_pkgs"), '", "load", {priority: "event"})}')))), + # note the action button moved out of alignment with 'selectizeInput' under 'renderUI' + actionButton(NS(id, "rem_pkg_btn"), shiny::icon("trash-can")), + tags$head(tags$script(I(paste0('$(window).on("load resize", function() {$("#', NS(id, "rem_pkg_btn"), '").css("margin-top", $("#', NS(id, "rem_pkg_lst"), '-label")[0].scrollHeight + .5*parseFloat(getComputedStyle(document.documentElement).fontSize));});')))) + ) + }) + }) + + observeEvent(input$uploaded_file, { + req(input$uploaded_file) + + if(is.null(input$uploaded_file$datapath)) + uploaded_pkgs00(validate('Please upload a nonempty CSV file.')) + + uploaded_packages <- read.csv(input$uploaded_file$datapath, stringsAsFactors = FALSE) + np <- nrow(uploaded_packages) + if(np == 0) + uploaded_pkgs00(validate('Please upload a nonempty CSV file.')) + + if(!all(colnames(uploaded_packages) == colnames(template))) + uploaded_pkgs00(validate("Please upload a CSV with a valid format.")) + + # Add status column and remove white space around package names. + uploaded_packages <- uploaded_packages %>% + dplyr::mutate( + status = rep('', np), + package = trimws(package), + version = trimws(version) + ) + + uploaded_pkgs00(uploaded_packages) + }) + + + + observeEvent(input$add_pkgs, { + req(input$pkg_lst) + + np <- length(input$pkg_lst) + uploaded_packages <- + dplyr::tibble( + package = input$pkg_lst, + version = rep('0.0.0', np), + status = rep('', np) + ) + + updateSelectizeInput(session, "pkg_lst", selected = "") + + uploaded_pkgs00(uploaded_packages) + }) + + observeEvent(input$rem_pkg_btn, { + req(input$rem_pkg_lst) + req(user$role == "admin") + + np <- length(input$rem_pkg_lst) + uploaded_packages <- + dplyr::tibble( + package = input$rem_pkg_lst, + version = rep('0.0.0', np), + status = rep("removed", np) + ) + + for (i in 1:np) { + pkg_name <- input$rem_pkg_lst[i] + # update version with what is in the package table + uploaded_packages$version[i] <- dbSelect(glue::glue("select version from package where name = '{pkg_name}'"), db_name = golem::get_golem_options('assessment_db_name')) + dbUpdate(glue::glue("delete from package where name = '{pkg_name}'"), db_name = golem::get_golem_options('assessment_db_name')) + } + + # clean up other db tables + db_trash_collection(db_name = golem::get_golem_options('assessment_db_name')) + + # update the list of packages we have + pkgs_have(dbSelect("select name from package")[,1]) + + updateSelectizeInput(session, "rem_pkg_lst", choices=pkgs_have(), selected = "") + + uploaded_pkgs(uploaded_packages) + + }) + + uploaded_pkgs <- reactiveVal(data.frame()) + # Save all the uploaded packages, marking them as 'new', 'not found', + # 'duplicate' or 'removed' + observeEvent(uploaded_pkgs00(), { + + uploaded_packages <- uploaded_pkgs00() + uploaded_packages$score <- NA_real_ + if (!rlang::is_empty(auto_list())) + uploaded_packages$decision <- "" + np <- nrow(uploaded_packages) + + if (!isTruthy(cran_pkgs())) { + cran_pkgs(available.packages("https://cran.rstudio.com/src/contrib")[,1]) + } + + # Start progress bar. Need to establish a maximum increment + # value based on the number of packages, np, and the number of + # incProgress() function calls in the loop, plus one to show + # the incProgress() that the process is completed. + withProgress( + max = (np * 5) + 1, value = 0, + message = "Uploading Packages to DB:", { + + for (i in 1:np) { + + user_ver <- uploaded_packages$version[i] + incProgress(1, detail = glue::glue("{uploaded_packages$package[i]} {user_ver}")) + + if (grepl("^[[:alpha:]][[:alnum:].]*[[:alnum:]]$", uploaded_packages$package[i])) { + # run pkg_ref() to get pkg version and source info + ref <- riskmetric::pkg_ref(uploaded_packages$package[i], + source = "pkg_cran_remote", + repos = c("https://cran.rstudio.com")) + } else { + ref <- list(name = uploaded_packages$package[i], + source = "name_bad") + } + + if (ref$source %in% c("pkg_missing", "name_bad")) { + incProgress(1, detail = 'Package {uploaded_packages$package[i]} not found') + + # Suggest alternative spellings using utils::adist() function + v <- utils::adist(uploaded_packages$package[i], cran_pkgs(), ignore.case = FALSE) + rlang::inform(paste("Package name",uploaded_packages$package[i],"was not found.")) + + suggested_nms <- paste("Suggested package name(s):",paste(head(cran_pkgs()[which(v == min(v))], 10),collapse = ", ")) + rlang::inform(suggested_nms) + + uploaded_packages$status[i] <- HTML(paste0('not found')) + + if (ref$source == "pkg_missing") + loggit::loggit('WARN', + glue::glue('Package {ref$name} was flagged by riskmetric as {ref$source}.')) + else + loggit::loggit('WARN', + glue::glue("Riskmetric can't interpret '{ref$name}' as a package reference.")) + + next + } + + ref_ver <- as.character(ref$version) + + if(user_ver == ref_ver) ver_msg <- ref_ver + else ver_msg <- glue::glue("{ref_ver}, not '{user_ver}'") + + as.character(ref$version) + deets <- glue::glue("{uploaded_packages$package[i]} {ver_msg}") + + # Save version. + incProgress(1, detail = deets) + uploaded_packages$version[i] <- as.character(ref$version) + + found <- nrow(dbSelect(glue::glue( + "SELECT name + FROM package + WHERE name = '{uploaded_packages$package[i]}'"))) + + uploaded_packages$status[i] <- ifelse(found == 0, 'new', 'duplicate') + + # Add package and metrics to the db if package is not in the db. + if(!found) { + # Get and upload pkg general info to db. + incProgress(1, detail = deets) + insert_pkg_info_to_db(uploaded_packages$package[i]) + # Get and upload maintenance metrics to db. + incProgress(1, detail = deets) + insert_riskmetric_to_db(uploaded_packages$package[i]) + # Get and upload community metrics to db. + incProgress(1, detail = deets) + insert_community_metrics_to_db(uploaded_packages$package[i]) + uploaded_packages$score[i] <- get_pkg_info(uploaded_packages$package[i])$score + if (!rlang::is_empty(auto_list())) { + uploaded_packages$decision[i] <- + assign_decisions(auto_list(), uploaded_packages$package[i]) + } + } + } + + incProgress(1, detail = " **Completed Pkg Uploads**") + Sys.sleep(0.25) + + }) #withProgress + + uploaded_pkgs(uploaded_packages) + }) + + # Download the sample dataset. + output$download_sample <- downloadHandler( + filename = function() { + paste("template", ".csv", sep = "") + }, + content = function(file) { + write.csv(template, file, row.names = F) + } + ) + + # Removed/Uploaded packages summary. + output$upload_summary_text <- renderText({ + req(uploaded_pkgs) + req(nrow(uploaded_pkgs()) > 0) + # modify the message if we are removing packages + if(isTruthy(sum(uploaded_pkgs()$status == 'removed') >0)) { + loggit::loggit("INFO", + paste("Uploaded file:", input$uploaded_file$name, + "Removed Packages", sum(uploaded_pkgs()$status == 'removed')), + echo = FALSE) + + as.character(tagList( + br(), br(), + hr(), + div(id = "upload_summary_div", + h5("Summary of Removed package(s)"), + br(), + p(tags$b("Removed Packages: "), sum(uploaded_pkgs()$status == 'removed')), + p(tags$b("Remaining Packages: "), nrow(dbSelect("SELECT name FROM package"))), + p("Note: The assessment will be performed on the latest version of each + package, irrespective of the uploaded version.") + ) + )) + } else { + loggit::loggit("INFO", + paste("Uploaded file:", input$uploaded_file$name, + "Total Packages:", nrow(uploaded_pkgs()), + "New Packages:", sum(uploaded_pkgs()$status == 'new'), + "Undiscovered Packages:", sum(grepl('not found', uploaded_pkgs()$status)), + "Duplicate Packages:", sum(uploaded_pkgs()$status == 'duplicate')), + echo = FALSE) + if (!is.null(uploaded_pkgs()$decision)) { + dec_lst <- uploaded_pkgs()$decision %>% + unique() %>% + `[`(. != "") %>% + purrr::map_chr(~ glue::glue("{.x}: {sum(uploaded_pkgs()$decision == .x)}")) %>% + purrr::map(~ list(tags$code(.x), HTML(" "))) + } + as.character(tagList( + br(), br(), + hr(), + div(id = "upload_summary_div", + h5("Summary of uploaded package(s)"), + br(), + p(tags$b("Total Packages: "), nrow(uploaded_pkgs())), + p(tags$b("New Packages: "), sum(uploaded_pkgs()$status == 'new')), + if (!is.null(uploaded_pkgs()$decision)) list(p(tags$b("Decisions Made: "), sum(uploaded_pkgs()$decision != "")), p(style = "margin-left: 25px", dec_lst)), + p(tags$b("Undiscovered Packages: "), sum(grepl('not found', uploaded_pkgs()$status))), + p(tags$b("Duplicate Packages: "), sum(uploaded_pkgs()$status == 'duplicate')), + p("Note: The assessment will be performed on the latest version of each + package, irrespective of the uploaded version.") + ) + )) + } + }) + + # Uploaded packages table. + output$upload_pkgs_table <- DT::renderDataTable({ + req(nrow(uploaded_pkgs()) > 0) + + DT::datatable( + uploaded_pkgs(), + escape = FALSE, + class = "cell-border", + selection = 'none', + extensions = 'Buttons', + options = list( + searching = FALSE, + sScrollX = "100%", + lengthChange = FALSE, + aLengthMenu = list(c(5, 10, 20, 100, -1), list('5', '10', '20', '100', 'All')), + iDisplayLength = 5 + ) + ) + }) + + # View sample dataset. + observeEvent(input$upload_format, { + DT::dataTableOutput(NS(id, "sampletable")) + + showModal(modalDialog( + size = "l", + easyClose = TRUE, + footer = "", + h5("Sample Dataset", style = 'text-align: center !important'), + hr(), + br(), + fluidRow( + column( + width = 12, + output$sampletable <- DT::renderDataTable( + DT::datatable( + template, + escape = FALSE, + editable = FALSE, + filter = 'none', + selection = 'none', + extensions = 'Buttons', + options = list( + sScrollX = "100%", + aLengthMenu = list(c(5, 10, 20, 100, -1), list('5', '10', '20', '100', 'All')), + iDisplayLength = 5, + dom = 't' + ) + ))) + ), + br(), + fluidRow(column(align = 'center', width = 12, + downloadButton(NS(id, "download_sample"), "Download"))) + )) + }) + + list( + names = uploaded_pkgs, + auto_decision = auto_list + ) + }) +} diff --git a/R/viewComments.R b/R/mod_viewComments.R similarity index 79% rename from R/viewComments.R rename to R/mod_viewComments.R index 01017a683..d22c459fb 100644 --- a/R/viewComments.R +++ b/R/mod_viewComments.R @@ -4,8 +4,8 @@ #' as the user inserts more comments. #' #' @param id a module id name +#' @keywords internal #' -#' @import shiny #' viewCommentsUI <- function(id) { fluidRow( @@ -20,12 +20,12 @@ viewCommentsUI <- function(id) { #' viewComment module's server logic #' -#' @param id a module id name -#' @param pkg_name placeholder -#' @param comments placeholder -#' @param label placeholder +#' @param id the module id name +#' @param pkg_name string name of the package +#' @param comments data.frame comments table entry +#' @param label string default: Current Comments #' -#' @import shiny +#' @keywords internal #' viewCommentsServer <- function(id, pkg_name, comments, label = 'Current Comments') { moduleServer(id, function(input, output, session) { @@ -41,4 +41,4 @@ viewCommentsServer <- function(id, pkg_name, comments, label = 'Current Comments ) }) }) -} \ No newline at end of file +} diff --git a/R/run_app.R b/R/run_app.R index 84d18eafd..26a993ba1 100644 --- a/R/run_app.R +++ b/R/run_app.R @@ -1,9 +1,19 @@ #' Run the Shiny Application #' -#' @param ... arguments to pass to golem_opts. -#' See `?golem::get_golem_options` for more details. +#' @param app_ver a "global" variable that is passed to several modules & +#' reports which details the installed package version when not specified. It +#' can be overwritten to include a specific version name as a text string. +#' @param login_note a text string to display underneath the auth screen's login +#' button, provided to guide users +#' @param credentials_db_name a text string that names the credentials databse. +#' Please make sure name ends with '.sqlite'. For example: 'cred_db.sqlite'. +#' @param assessment_db_name text string that names the credentials databse. +#' Please make sure name ends with '.sqlite'. For example: 'assess_db.sqlite'. +#' @param ... arguments to pass to golem_opts. See `?golem::get_golem_options` +#' for more details. #' @inheritParams shiny::shinyApp -#' +#' @return a shiny app object +#' #' @export #' @importFrom shiny shinyApp #' @importFrom golem with_golem_options @@ -12,24 +22,42 @@ run_app <- function( options = list(), enableBookmarking = NULL, uiPattern = "/", + app_ver = NULL, + login_note = NULL, + credentials_db_name = NULL, + assessment_db_name = NULL, ... ) { + # Pre-process some run-app inputs + if(is.null(app_ver)) app_ver <- paste0(packageVersion("riskassessment")) + if(is.null(assessment_db_name)) assessment_db_name <- "database.sqlite" + if(is.null(credentials_db_name)) credentials_db_name <- "credentials.sqlite" + if(is.null(login_note)) { + # https://github.com/rstudio/fontawesome/issues/99 + # Here, we make sure user has a functional version of fontawesome + fa_v <- packageVersion("fontawesome") + if(!file.exists(credentials_db_name)) { + login_note <- HTML('Note: To log in for the first time, use the admin user: + admin with password QWERTY1.') + } else if(fa_v == '0.4.0') { + login_note <- HTML(glue::glue("Note: HTML reports will not render with {fontawesome} v0.4.0. You currently have v{fa_v} installed. If the report download fails, please install a more stable version. We recommend v.0.5.0 or higher.")) + } + } + + # Run the app with_golem_options( app = shinyApp( - ui = add_tags(shinymanager::secure_app(app_ui, - tags_top = tags$div( - tags$head(tags$style(HTML(readLines(system.file("app", "www", "css", "login_screen.css", package = "riskassessment"))))), - id = "login_screen", - tags$h2("Risk Assessment Application", style = "align:center"), - tags$h3(glue::glue('**Version {app_version}**'), - style = "align:center; color: darkgray")), - enable_admin = TRUE, theme = app_theme)), + ui = add_shinymanager_auth(app_ui, app_ver, login_note), server = app_server, onStart = onStart, options = options, enableBookmarking = enableBookmarking, uiPattern = uiPattern ), - golem_opts = list(...) + golem_opts = list(app_version = app_ver, + credentials_db_name = credentials_db_name, + assessment_db_name = assessment_db_name, + ...) ) } + diff --git a/R/sysdata.rda b/R/sysdata.rda index 6cba704f9..817034566 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/uploadPackage.R b/R/uploadPackage.R deleted file mode 100644 index 3369af8d6..000000000 --- a/R/uploadPackage.R +++ /dev/null @@ -1,296 +0,0 @@ -#' 'Upload Package' UI -#' -#' @param id a module id -#' -#' @import shiny -#' @importFrom DT dataTableOutput -#' -uploadPackageUI <- function(id) { - fluidPage( - br(), br(), - - introJSUI(NS(id, "introJS")), - - tags$head(tags$style(".shiny-notification {font-size:30px; color:darkblue; position: fixed; width:415px; height: 150px; top: 75% ;right: 10%;")), - - fluidRow( - column( - width = 4, - div(id = "upload-file-grp", - fileInput( - inputId = NS(id, "uploaded_file"), - label = "Choose a CSV file", - accept = ".csv", - placeholder = "No file selected" - ) - ), - actionLink(NS(id, "upload_format"), "View Sample Dataset") - ) - ), - - # Display the summary information of the uploaded csv. - fluidRow(column(width = 12, htmlOutput(NS(id, "upload_summary_text")))), - - # Summary of packages uploaded. - fluidRow(column(width = 12, DT::dataTableOutput(NS(id, "upload_pkgs_table")))) - ) -} - - -#' Server logic for the 'Upload Package' module -#' -#' @param id a module id -#' -#' @importFrom riskmetric pkg_ref -#' @importFrom rintrojs introjs -#' @importFrom readr read_csv -#' @importFrom rvest read_html html_nodes html_text -#' -uploadPackageServer <- function(id) { - moduleServer(id, function(input, output, session) { - - # Determine which guide to use for IntroJS. - upload_pkg_txt <- reactive({ - req(uploaded_pkgs()) - - if(nrow(uploaded_pkgs()) > 0) - upload_pkg_complete - else - upload_pkg - }) - - # Start introjs when help button is pressed. Had to do this outside of - # a module in order to take a reactive data frame of steps - observeEvent( - input[["introJS-help"]], # notice input contains "id-help" - rintrojs::introjs(session, - options = list( - steps = - upload_pkg_txt() %>% - union(sidebar_steps), - "nextLabel" = "Next", - "prevLabel" = "Previous" - ) - ) - ) - - # Save all the uploaded packages, marking them as 'new', 'not found', or - # 'duplicate'. - uploaded_pkgs <- reactive({ - - # Return an empty data.frame when no file is uploaded. - # This is to allow for the database view method to update when a package - # is uploaded without failing. - if(is.null(input$uploaded_file)) - return(data.frame()) - - req(input$uploaded_file) - - if(is.null(input$uploaded_file$datapath)) - validate('Please upload a nonempty CSV file.') - - uploaded_packages <- readr::read_csv(input$uploaded_file$datapath, show_col_types = FALSE) - np <- nrow(uploaded_packages) - if(np == 0) - validate('Please upload a nonempty CSV file.') - - if(!all(colnames(uploaded_packages) == colnames(template))) - validate("Please upload a CSV with a valid format.") - - # Add status column and remove white space around package names. - uploaded_packages <- uploaded_packages %>% - dplyr::mutate( - status = rep('', np), - package = trimws(package), - version = trimws(version) - ) - - # read website to create vector of available packages by name - website <- "https://cran.rstudio.com/web/packages/available_packages_by_name.html" - con <- url(website, open = "rb") - namelst <- rvest::read_html(con) - close(con) - - pkgnames <- namelst %>% - rvest::html_nodes("a") %>% - rvest::html_text() - - # Drop A-Z - CRAN_arch <- pkgnames[27:length(pkgnames)] - rm(namelst, pkgnames) - - # Start progress bar. Need to establish a maximum increment - # value based on the number of packages, np, and the number of - # incProgress() function calls in the loop, plus one to show - # the incProgress() that the process is completed. - withProgress( - max = (np * 5) + 1, value = 0, - message = "Uploading Packages to DB:", { - - for (i in 1:np) { - - user_ver <- uploaded_packages$version[i] - incProgress(1, detail = glue::glue("{uploaded_packages$package[i]} {user_ver}")) - - # run pkg_ref() to get pkg version and source info - ref <- riskmetric::pkg_ref(uploaded_packages$package[i]) - - if (ref$source == "pkg_missing"){ - incProgress(1, detail = 'Package {uploaded_packages$package[i]} not found') - - # Suggest alternative spellings using utils::adist() function - v <- utils::adist(uploaded_packages$package[i], CRAN_arch, ignore.case = FALSE) - rlang::inform(paste("Package name",uploaded_packages$package[i],"was not found.")) - - suggested_nms <- paste("Suggested package name(s):",paste(head(CRAN_arch[which(v == min(v))], 10),collapse = ", ")) - rlang::inform(suggested_nms) - - uploaded_packages$status[i] <- HTML(paste0('not found')) - - loggit::loggit('WARN', - glue::glue('Package {ref$name} was flagged by riskmetric as {ref$source}.')) - - next - } - - ref_ver <- as.character(ref$version) - - if(user_ver == ref_ver) ver_msg <- ref_ver - else ver_msg <- glue::glue("{ref_ver}, not '{user_ver}'") - - as.character(ref$version) - deets <- glue::glue("{uploaded_packages$package[i]} {ver_msg}") - - # Save version. - incProgress(1, detail = deets) - uploaded_packages$version[i] <- as.character(ref$version) - - found <- nrow(dbSelect(glue::glue( - "SELECT name - FROM package - WHERE name = '{uploaded_packages$package[i]}'"))) - - uploaded_packages$status[i] <- ifelse(found == 0, 'new', 'duplicate') - - # Add package and metrics to the db if package is not in the db. - if(!found) { - # Get and upload pkg general info to db. - incProgress(1, detail = deets) - insert_pkg_info_to_db(uploaded_packages$package[i]) - # Get and upload maintenance metrics to db. - incProgress(1, detail = deets) - insert_maintenance_metrics_to_db(uploaded_packages$package[i]) - # Get and upload community metrics to db. - incProgress(1, detail = deets) - insert_community_metrics_to_db(uploaded_packages$package[i]) - } - } - - incProgress(1, detail = " **Completed Pkg Uploads**") - Sys.sleep(0.25) - - }) #withProgress - - uploaded_packages - }) - - # Download the sample dataset. - output$download_sample <- downloadHandler( - filename = function() { - paste("template", ".csv", sep = "") - }, - content = function(file) { - write.csv(template, file, row.names = F) - } - ) - - # Uploaded packages summary. - output$upload_summary_text <- renderText({ - req(uploaded_pkgs) - req(nrow(uploaded_pkgs()) > 0) - - loggit::loggit("INFO", - paste("Uploaded file:", input$uploaded_file$name, - "Total Packages:", nrow(uploaded_pkgs()), - "New Packages:", sum(uploaded_pkgs()$status == 'new'), - "Undiscovered Packages:", sum(grepl('not found', uploaded_pkgs()$status)), - "Duplicate Packages:", sum(uploaded_pkgs()$status == 'duplicate')), - echo = FALSE) - - as.character(tagList( - br(), br(), - hr(), - div(id = "upload_summary_div", - h5("Summary of uploaded package(s)"), - br(), - p(tags$b("Total Packages: "), nrow(uploaded_pkgs())), - p(tags$b("New Packages: "), sum(uploaded_pkgs()$status == 'new')), - p(tags$b("Undiscovered Packages: "), sum(grepl('not found', uploaded_pkgs()$status))), - p(tags$b("Duplicate Packages: "), sum(uploaded_pkgs()$status == 'duplicate')), - p("Note: The assessment will be performed on the latest version of each - package, irrespective of the uploaded version.") - ) - )) - }) - - # Uploaded packages table. - output$upload_pkgs_table <- DT::renderDataTable({ - req(nrow(uploaded_pkgs()) > 0) - - DT::datatable( - uploaded_pkgs(), - escape = FALSE, - class = "cell-border", - selection = 'none', - extensions = 'Buttons', - options = list( - searching = FALSE, - sScrollX = "100%", - lengthChange = FALSE, - aLengthMenu = list(c(5, 10, 20, 100, -1), list('5', '10', '20', '100', 'All')), - iDisplayLength = 5 - ) - ) - }) - - # View sample dataset. - observeEvent(input$upload_format, { - DT::dataTableOutput(NS(id, "sampletable")) - - showModal(modalDialog( - size = "l", - easyClose = TRUE, - footer = "", - h5("Sample Dataset", style = 'text-align: center !important'), - hr(), - br(), - fluidRow( - column( - width = 12, - output$sampletable <- DT::renderDataTable( - DT::datatable( - template, - escape = FALSE, - editable = FALSE, - filter = 'none', - selection = 'none', - extensions = 'Buttons', - options = list( - sScrollX = "100%", - aLengthMenu = list(c(5, 10, 20, 100, -1), list('5', '10', '20', '100', 'All')), - iDisplayLength = 5, - dom = 't' - ) - ))) - ), - br(), - fluidRow(column(align = 'center', width = 12, - downloadButton(NS(id, "download_sample"), "Download"))) - )) - }) - - list( - names = uploaded_pkgs - ) - }) -} diff --git a/R/utils-pipe.R b/R/utils-pipe.R deleted file mode 100644 index fd0b1d13d..000000000 --- a/R/utils-pipe.R +++ /dev/null @@ -1,14 +0,0 @@ -#' Pipe operator -#' -#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. -#' -#' @name %>% -#' @rdname pipe -#' @keywords internal -#' @export -#' @importFrom magrittr %>% -#' @usage lhs \%>\% rhs -#' @param lhs A value or the magrittr placeholder. -#' @param rhs A function call using the magrittr semantics. -#' @return The result of calling `rhs(lhs)`. -NULL diff --git a/R/utils.R b/R/utils.R index 002faf0b1..2f5e5c0e0 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,256 +1,214 @@ -#' The 'Add tags' function +#' showHelperMessage #' -#' @param ui placeholder -#' @param ... placeholder +#' Displays a helper message. By default, it informs the user that he should +#' select a package. #' -#' @import shiny -#' @importFrom shinymanager fab_button -#' @importFrom shinyjs useShinyjs -add_tags <- function(ui, ...) { - ui <- force(ui) - - function(request) { - query <- parseQueryString(request$QUERY_STRING) - admin <- query$admin - - if (is.function(ui)) { - ui <- ui(request) - } - - if (identical(admin, "true")) { - ui <- tagList(ui, - tags$script(HTML("document.getElementById('admin-add_user').style.width = 'auto';")), - tags$script(HTML("var oldfab = Array.prototype.slice.call(document.getElementsByClassName('mfb-component--br'), 0); - for (var i = 0; i < oldfab.length; ++i) { - oldfab[i].remove(); - }")), - shinymanager::fab_button( - position = "bottom-right", - actionButton( - inputId = ".shinymanager_logout", - label = "Logout", - icon = icon("right-from-bracket") - ), - actionButton( - inputId = ".shinymanager_app", - label = "Go to application", - icon = icon("share") - ) - ) - ) - } - - tagList(shinyjs::useShinyjs(), - ui, - tags$script(HTML("$(document).on('shiny:value', function(event) { - if (event.target.id === 'admin-table_users') { - Shiny.onInputChange('table_users-returns', document.getElementById('admin-table_users').innerHTML) - } else if (event.target.id === 'admin-table_pwds') { - Shiny.onInputChange('table_pwds-returns', document.getElementById('admin-table_pwds').innerHTML) - } - });"))) - } +#' @param message a string +#' @keywords internal +#' +showHelperMessage <- function(message = "Please select a package"){ + h6(message, + style = + "text-align: center; + color: gray; + padding-top: 50px;") } - -#' Create package database -#' -#' @description Note: the database_name object is assigned in data-raw/internal-data.R +#' Get the package general information from CRAN/local #' -#' @param db_name a string +#' @param pkg_name string name of the package #' #' @import dplyr -#' @importFrom DBI dbConnect dbDisconnect dbSendStatement dbClearResult -#' @importFrom RSQLite SQLite -#' @importFrom loggit loggit +#' @importFrom glue glue +#' @importFrom rvest read_html html_node html_table html_text +#' @importFrom stringr str_remove_all +#' @keywords internal #' -create_db <- function(db_name = database_name){ - - # Create an empty database. - con <- DBI::dbConnect(RSQLite::SQLite(), db_name) - - # Set the path to the queries. - path <- app_sys("app/www/sql_queries") #file.path('sql_queries') - - # Queries needed to run the first time the db is created. - queries <- c( - "create_package_table.sql", - "create_metric_table.sql", - "initialize_metric_table.sql", - "create_package_metrics_table.sql", - "create_community_usage_metrics_table.sql", - "create_comments_table.sql" - ) +get_latest_pkg_info <- function(pkg_name) { + url <- glue::glue('https://cran.r-project.org/web/packages/{pkg_name}') + tryCatch( + expr = { + url = url(url, "rb") + on.exit(close(url)) + }, + warning = function(w) { + stop("HTTP status was '404 Not Found'") + }) + webpage <- rvest::read_html(url) + + # Regex that finds entry: '\n ', "'", and '"' (the `|` mean 'or' and the + # `\`` is to scape the double quotes). + pattern <- '\n |\'|\"|\\"' - # Append path to the queries. - queries <- file.path(path, queries) + # Save div with class container to get the title and description. + div_container <- webpage %>% rvest::html_nodes("div.container") - # Apply each query. - sapply(queries, function(x){ - - tryCatch({ - rs <- DBI::dbSendStatement( - con, - paste(scan(x, sep = "\n", what = "character"), collapse = "")) - }, error = function(err) { - message <- paste("dbSendStatement",err) - message(message, .loggit = FALSE) - loggit::loggit("ERROR", message) - DBI::dbDisconnect(con) - }) - - DBI::dbClearResult(rs) - }) + # Read package title and clean it. + title <- div_container %>% + rvest::html_nodes("h2") %>% + rvest::html_text() %>% + stringr::str_remove_all(pattern = pattern) - DBI::dbDisconnect(con) -} - - - -#' Create credentials database -#' -#' Note: the credentials_name object is assigned in data-raw/internal-data.R -#' -#' @param db_name a string -#' -#' @import dplyr -#' @importFrom DBI dbConnect dbDisconnect -#' @importFrom RSQLite SQLite -#' @importFrom shinymanager read_db_decrypt write_db_encrypt -#' -create_credentials_db <- function(db_name = credentials_name){ - - # Init the credentials table for credentials database - credentials <- data.frame( - user = "admin", - password = "QWERTY1", - # password will automatically be hashed - admin = TRUE, - expire = as.character(Sys.Date()), - stringsAsFactors = FALSE - ) + # Read package description and clean it. + description <- div_container %>% + rvest::html_nodes("h2 + p") %>% + rvest::html_text() %>% + stringr::str_remove_all(pattern = pattern) - # Init the credentials database - shinymanager::create_db( - credentials_data = credentials, - sqlite_path = file.path(db_name), - passphrase = passphrase - ) + # Get the table displaying version, authors, etc. + table_infx <- (webpage %>% rvest::html_table())[[1]] %>% + dplyr::mutate(X1 = stringr::str_remove_all(string = X1, pattern = ':')) %>% + dplyr::mutate(X2 = stringr::str_remove_all(string = X2, pattern = pattern)) %>% + dplyr::filter(X1 %in% c("Version", "Maintainer", "Author", "License", "Published")) - # set pwd_mngt$must_change to TRUE - con <- DBI::dbConnect(RSQLite::SQLite(), db_name) - pwd <- shinymanager::read_db_decrypt( - con, name = "pwd_mngt", - passphrase = passphrase) %>% - dplyr::mutate(must_change = ifelse( - have_changed == "TRUE", must_change, as.character(TRUE))) - - shinymanager::write_db_encrypt( - con, - value = pwd, - name = "pwd_mngt", - passphrase = passphrase - ) - DBI::dbDisconnect(con) - - # update expire date here to current date + 365 days - con <- DBI::dbConnect(RSQLite::SQLite(), db_name) - dat <- shinymanager::read_db_decrypt(con, name = "credentials", passphrase = passphrase) %>% - dplyr::mutate(expire = as.character(Sys.Date() + 365)) - - shinymanager::write_db_encrypt( - con, - value = dat, - name = "credentials", - passphrase = passphrase - ) + table_infy <- t(table_infx$X2) %>% dplyr::as_tibble(.name_repair = "minimal") + colnames(table_infy) <- t(table_infx$X1) %>% dplyr::as_tibble(.name_repair = "minimal") - DBI::dbDisconnect(con) + table_info <- table_infy %>% + dplyr::select(Version, Maintainer, Author, License, Published) %>% + dplyr::mutate(Title = title, Description = description) + + return(table_info) } - - - - -#' Select data from database +#' Generate Community Usage Data #' -#' @param query a sql query as a string -#' @param db_name a string +#' @description +#' Extracts community usage metrics for a given package. +#' @returns A tibble of community usage metrics +#' @param pkg_name A string containing the name of a package. #' #' @import dplyr -#' @importFrom DBI dbConnect dbSendQuery dbFetch dbClearResult dbDisconnect -#' @importFrom RSQLite SQLite +#' @importFrom cranlogs cran_downloads +#' @importFrom lubridate year month +#' @importFrom glue glue +#' @importFrom rvest read_html html_node html_table html_text #' @importFrom loggit loggit -dbSelect <- function(query, db_name = database_name){ - errFlag <- FALSE - con <- DBI::dbConnect(RSQLite::SQLite(), db_name) - +#' @importFrom stringr str_remove_all +#' @return a data.frame which includes downloads per month for the given pkg +#' @examples +#' if( interactive()) { +#' ggplot_comm_df <- generate_comm_data("ggplot2") +#' head(ggplot_comm_df) +#' } +#' @keywords reproduce +#' @export +generate_comm_data <- function(pkg_name){ + + # initialize empty tibble + pkgs_cum_metrics <- dplyr::tibble() + + # turn off summarise() .groups message + options(dplyr.summarise.inform = FALSE) + tryCatch( expr = { - rs <- DBI::dbSendQuery(con, query) - }, - warning = function(warn) { - message <- paste0("warning:\n", query, "\nresulted in\n", warn) - message(message, .loggit = FALSE) - loggit::loggit("WARN", message) - errFlag <<- TRUE - }, - error = function(err) { - message <- paste0("error:\n", query, "\nresulted in\n",err) - message(message, .loggit = FALSE) - loggit::loggit("ERROR", message) - DBI::dbDisconnect(con) - errFlag <<- TRUE + + # get current release version number and date + curr_release <- get_latest_pkg_info(pkg_name) %>% + dplyr::select(`Last modified` = Published, version = Version) + # Get the packages past versions and dates. + pkg_url <- url(glue::glue('https://cran.r-project.org/src/contrib/Archive/{pkg_name}')) + pkg_page <- try(rvest::read_html(pkg_url), silent = TRUE) + + + # if past releases exist... they usually do! + if(all(class(pkg_page) != "try-error")){ #exists("pkg_page") + versions_with_dates0 <- pkg_page %>% + rvest::html_node('table') %>% + rvest::html_table() %>% + dplyr::select("Name", "Last modified") %>% + dplyr::filter(`Last modified` != "") %>% + dplyr::mutate(version = stringr::str_remove_all( + string = Name, pattern = glue::glue('{pkg_name}_|.tar.gz')), + .keep = 'unused') %>% + # get latest high-level package info + union(curr_release) + } else { + versions_with_dates0 <- curr_release + } + # close(pkg_url) + + versions_with_dates <- versions_with_dates0 %>% + dplyr::mutate(date = as.Date(`Last modified`), .keep = 'unused') %>% + dplyr::mutate(month = lubridate::month(date)) %>% + dplyr::mutate(year = lubridate::year(date)) + + # First release date. + first_release_date <- versions_with_dates %>% + dplyr::pull(date) %>% + min() + + # Summarize versions as a range when there was + # more than one release in a month + one_v_per_month <- versions_with_dates %>% + dplyr::arrange(year, month, date) %>% + dplyr::select(month, year, ea_v = version) %>% + dplyr::group_by(year, month) %>% + dplyr::mutate(version = dplyr::case_when( + n() > 1 ~ paste(ea_v[1], ea_v[n()], sep = " - "), + TRUE ~ as.character(ea_v)) + ) %>% + select(-ea_v) %>% + distinct(year, month, .keep_all = TRUE) + + + # Get the number of downloads by month, year. + pkgs_cum_metrics <- + cranlogs::cran_downloads( + pkg_name, + from = first_release_date, + to = Sys.Date()) %>% + dplyr::mutate(month = lubridate::month(date), + year = lubridate::year(date)) %>% + dplyr::filter(!(month == lubridate::month(Sys.Date()) & + year == lubridate::year(Sys.Date()))) %>% + group_by(id = package, month, year) %>% + summarise(downloads = sum(count)) %>% + ungroup() %>% + left_join(one_v_per_month, by = c('month', 'year')) %>% + dplyr::arrange(year, month) + }, - finally = { - if (errFlag) return(NULL) - }) - - dat <- DBI::dbFetch(rs) - DBI::dbClearResult(rs) - DBI::dbDisconnect(con) + error = function(e) { + loggit::loggit("ERROR", paste("Error extracting cum metric info of the package:", + pkg_name, "info", e), + app = "fileupload-webscraping", echo = FALSE) + } + ) - return(dat) + return(pkgs_cum_metrics) } - - - -#' dbUpdate -#' -#' Deletes, updates or inserts queries. -#' -#' @param command a string -#' @param db_name a string -#' -#' @import dplyr -#' @importFrom DBI dbConnect dbSendStatement dbClearResult dbDisconnect -#' dbGetRowsAffected -#' @importFrom RSQLite SQLite -#' @importFrom loggit loggit -#' @importFrom glue glue -dbUpdate <- function(command, db_name = database_name){ - con <- DBI::dbConnect(RSQLite::SQLite(), db_name) - - tryCatch({ - rs <- DBI::dbSendStatement(con, command) - }, error = function(err) { - message <- glue::glue("command: {command} resulted in {err}") - message(message, .loggit = FALSE) - loggit::loggit("ERROR", message) - DBI::dbDisconnect(con) - }) - - nr <- DBI::dbGetRowsAffected(rs) - DBI::dbClearResult(rs) - - if (nr == 0) { - message <- glue::glue("zero rows were affected by the command: {command}") - message(message, .loggit = FALSE) - } - DBI::dbDisconnect(con) +#' showComments +#' +#' Displays formatted comments +#' +#' @param pkg_name string name of the package +#' @param comments data.frame comments table entry +#' @return a formatted string of comments +#' @keywords internal +#' @export +showComments <- function(pkg_name, comments){ + if (length(pkg_name) == 0) + return("") + + ifelse( + length(comments$user_name) == 0, + "No comments", + paste0( + "
", + icon("user-tie"), " ", "user: ", comments$user_name, ", ", + icon("user-shield"), " ", "role: ", comments$user_role, ", ", + icon("calendar-days"), " ", "date: ", comments$added_on, + br(), br(), + comments$comment, + "
", + collapse = "" + ) + ) } @@ -259,57 +217,13 @@ dbUpdate <- function(command, db_name = database_name){ #' Retrieves Sys.time(), but transforms slightly #' #' @importFrom stringr str_replace +#' @keywords internal getTimeStamp <- function(){ initial <- stringr::str_replace(Sys.time(), " ", "; ") return(paste(initial, Sys.timezone())) } -#' get_metric_weights -#' -#' Retrieves metric name and current weight from metric table -#' -get_metric_weights <- function(){ - dbSelect( - "SELECT name, weight - FROM metric" - ) -} - - -#' weight_risk_comment -#' -#' Used to add a comment on every tab saying how the risk and weights changed, -#' and that the overall comment & final decision may no longer be applicable. -#' -#' @param pkg_name a package name, as a string -#' @importFrom glue glue -weight_risk_comment <- function(pkg_name) { - - pkg_score <- dbSelect(glue::glue( - "SELECT score - FROM package - WHERE name = '{pkg_name}'" - )) - - glue::glue('Metric re-weighting has occurred. - The previous risk score was {pkg_score}.') -} - -#' update_metric_weight -#' -#' @param metric_name a metric name, as a string -#' @param metric_name a weight, as a string or double -#' -#' @importFrom glue glue -update_metric_weight <- function(metric_name, metric_weight){ - dbUpdate(glue::glue( - "UPDATE metric - SET weight = {metric_weight} - WHERE name = '{metric_name}'" - )) -} - #' The 'Get Date Span' function #' #' Function accepts a start date and optional end date and will @@ -319,7 +233,7 @@ update_metric_weight <- function(metric_name, metric_weight){ #' #' @importFrom lubridate interval years #' @importFrom stringr str_remove -#' +#' @keywords internal get_date_span <- function(start, end = Sys.Date()) { # Get approximate difference between today and latest release. # time_diff_latest_version <- lubridate::year(Sys.Date()) - last_ver$year @@ -346,9 +260,23 @@ get_date_span <- function(start, end = Sys.Date()) { #' @import dplyr #' @importFrom lubridate interval make_date year #' @importFrom glue glue -#' @importFrom tibble add_row +#' @keywords internal #' build_comm_cards <- function(data){ + + cards <- dplyr::tibble( + name = character(), + title = character(), + desc = character(), + value = character(), + succ_icon = character(), + icon_class = character(), + is_perc = numeric(), + is_url = numeric() + ) + + if (nrow(data) == 0) + return(cards) # Get the first package release. first_version <- data %>% @@ -361,16 +289,17 @@ build_comm_cards <- function(data){ # has elapsed time_diff_first_rel <- get_date_span(first_version$fake_rel_date) - cards <- data.frame( - name = 'time_since_first_version', - title = 'First Version Release', - desc = 'Time passed since first version release', - value = glue::glue('{time_diff_first_rel$value} {time_diff_first_rel$label} Ago'), - succ_icon = 'black-tie', - icon_class = "text-info", - is_perc = 0, - is_url = 0 - ) + cards <- cards %>% + dplyr::add_row( + name = 'time_since_first_version', + title = 'First Version Release', + desc = 'Time passed since first version release', + value = glue::glue('{time_diff_first_rel$value} {time_diff_first_rel$label} Ago'), + succ_icon = 'black-tie', + icon_class = "text-info", + is_perc = 0, + is_url = 0 + ) # Get the last package release's month and year, then @@ -387,7 +316,7 @@ build_comm_cards <- function(data){ time_diff_latest_rel <- get_date_span(last_ver$fake_rel_date) cards <- cards %>% - tibble::add_row(name = 'time_since_latest_version', + dplyr::add_row(name = 'time_since_latest_version', title = 'Latest Version Release', desc = 'Time passed since latest version release', value = glue::glue('{time_diff_latest_rel$value} {time_diff_latest_rel$label} Ago'), @@ -401,7 +330,7 @@ build_comm_cards <- function(data){ dplyr::distinct(year, month, downloads) cards <- cards %>% - tibble::add_row(name = 'downloads_last_year', + dplyr::add_row(name = 'downloads_last_year', title = 'Package Downloads', desc = 'Number of downloads since last year', value = format(sum(downloads_last_year$downloads), big.mark = ","), @@ -413,32 +342,88 @@ build_comm_cards <- function(data){ cards } +#' Automatic font re-sizer +#' +#' A function that adjusts the number (to be used as font size) that is +#' proportional to the length of a text string. So the longer the text string, +#' the smaller the font. Used in MetricBox.R. +#' +#' @param txt a string +#' @param txt_max an integer to specify a length of text that is considered "to +#' long" to continue to toggle the font size +#' @param size_min an integer specifying the smallest font size you'd like to +#' see in the output +#' @param size_max integer specifying the largest font size you'd like to see in +#' the output +#' @param num_bins when not NULL (the default), accepts an integer that bins a +#' continuous font size into a categorical one. +#' +#' @keywords internal +#' +auto_font <- function(txt, txt_max = 45, size_min = .75, size_max = 1.5, + num_bins = NULL){ + txt_len <- nchar(txt) + txt_pct <- 1- ifelse(txt_len >= txt_max, 1, txt_len / txt_max) + cont_size <- round(size_min + (txt_pct * (size_max - size_min)), 3) + if (is.null(num_bins)) { + return(cont_size) + } else { + # when creating bins, we want equally sized categories and to choose the + # left bound if cont_size falls in the lowest category; otherwise, + # re-calculate the breaks to be more proportional and choose the upper bound + num_bins0 <- ifelse(num_bins < 2, 2, num_bins) + breaks <- seq(size_min, size_max, length.out = num_bins0 + 1) + grp <- as.character(cut(cont_size, breaks, include.lowest = TRUE)) + + breaks2 <- seq(size_min, size_max, length.out = num_bins0) + return(ifelse(substr(grp, 1, 1) == "[", + size_min, + breaks2[cut(cont_size, breaks, include.lowest = TRUE, labels = FALSE)]) + ) + } +} -#' The 'Build Community plot' function -#' -#' @param data a data.frame + +#' Build a plotly of community usage metrics +#' @description +#' Responsible for building an interactive `{plotly}` graphic containing the trend line for number of CRAN pkg downloads by month. #' +#' @param data a data.frame containing monthly download data, built using `generate_comm_data()`. This argument is optional, but if `NULL`, a `pkg_name` must be provided. +#' @param pkg_name a string of a package name. This parameter is optional. If `pkg_name` is provided, the data argument should be `NULL`. +#' @returns a plotly object +#' @examples +#' metricGraph <- build_comm_plotly(pkg_name = "ggplot2") #' @import dplyr #' @importFrom lubridate NA_Date_ interval #' @importFrom glue glue #' @importFrom plotly plot_ly layout add_segments add_annotations config -#' -build_comm_plotly <- function(data) { +#' @return an interactive plotly object +#' +#' @keywords reproduce +#' @export +build_comm_plotly <- function(data = NULL, pkg_name = NULL) { + + # If there is a package listed, in pkg_name, a plotly graphic will be created + if (!is.null(pkg_name)){ + data <- generate_comm_data(pkg_name) + } else { + if (is.null(data)) { + stop("must include either data or pkg_name argument") + } + } + if (nrow(data) == 0) return(NULL) pkg_name <- unique(data$id) - community_data <- data %>% + downloads_data <- data %>% dplyr::mutate(day_month_year = glue::glue('1-{month}-{year}')) %>% dplyr::mutate(day_month_year = as.Date(day_month_year, "%d-%m-%Y")) %>% dplyr::mutate(month_year = glue::glue('{months(day_month_year)} {year}')) %>% dplyr::mutate(month = month.name[month]) %>% dplyr::arrange(day_month_year) - downloads_data <- community_data %>% - dplyr::distinct(month, year, .keep_all = TRUE) - # Last day that appears on the community metrics. latest_date <- downloads_data %>% dplyr::slice_max(day_month_year) %>% @@ -485,18 +470,16 @@ build_comm_plotly <- function(data) { showlegend = FALSE, yaxis = list(title = "Downloads"), xaxis = list(title = "", type = 'date', tickformat = "%b %Y", - range = dates_range) - ) %>% + range = dates_range)) %>% plotly::add_segments( - x = ~dplyr::if_else(version %in% c("", "NA"), lubridate::NA_Date_, day_month_year), - xend = ~dplyr::if_else(version %in% c("", "NA"), lubridate::NA_Date_, day_month_year), + x = ~dplyr::if_else(version %in% c("", "NA", NA), lubridate::NA_Date_, day_month_year), + xend = ~dplyr::if_else(version %in% c("", "NA", NA), lubridate::NA_Date_, day_month_year), y = ~.98 * min(downloads), yend = ~1.02 * max(downloads), name = "Version Release", hoverinfo = "text", text = ~glue::glue('Version {version}'), - line = list(color = '#4BBF73') - ) %>% + line = list(color = '#4BBF73')) %>% plotly::add_annotations( yref = 'paper', xref = "x", @@ -506,8 +489,7 @@ build_comm_plotly <- function(data) { showarrow = F, textangle = 270, font = list(size = 14, color = '#4BBF73'), - text = ~ifelse(downloads_data$version %in% c("", "NA"), "", downloads_data$version) - ) %>% + text = ~ifelse(downloads_data$version %in% c("", "NA", NA), "", downloads_data$version)) %>% plotly::layout( xaxis = list( range = dates_range, @@ -538,8 +520,7 @@ build_comm_plotly <- function(data) { stepmode = "backward") )), rangeslider = list(visible = TRUE) - ) - ) %>% + )) %>% plotly::config(displayModeBar = F) } @@ -551,125 +532,8 @@ build_comm_plotly <- function(data) { -# Below are a series of get_* functions that help us query -# certain sql tables in a certain way. They are used 2 - 3 -# times throughout the app, so it's best to maintain them -# in a central location - -#' The 'Get Overall Comments' function -#' -#' Retrieves the overall comments for a specific package -#' -#' @param pkg_name string -#' -#' @importFrom glue glue -#' -get_overall_comments <- function(pkg_name) { - dbSelect(glue::glue( - "SELECT * FROM comments - WHERE comment_type = 'o' AND id = '{pkg_name}'") - ) -} - -#' The 'Get Maintenance Metrics Comments' function -#' -#' Retrieves the Maint Metrics comments for a specific package -#' -#' @param pkg_name string -#' -#' @importFrom glue glue -#' @importFrom purrr map -#' -get_mm_comments <- function(pkg_name) { - dbSelect( - glue::glue( - "SELECT user_name, user_role, comment, added_on - FROM comments - WHERE id = '{pkg_name}' AND comment_type = 'mm'" - ) - ) %>% - purrr::map(rev) -} - -#' The 'Get Community Usage Metrics Comments' function -#' -#' Retrieve the Community Metrics comments for a specific package -#' -#' @param pkg_name string -#' -#' @importFrom glue glue -#' @importFrom purrr map -#' -get_cm_comments <- function(pkg_name) { - dbSelect( - glue::glue( - "SELECT user_name, user_role, comment, added_on - FROM comments - WHERE id = '{pkg_name}' AND comment_type = 'cum'" - ) - ) %>% - purrr::map(rev) -} -#' The 'Get Maintenance Metrics Data' function -#' -#' Pull the maint metrics data for a specific package id, and create -#' necessary columns for Cards UI -#' -#' @param pkg_id string -#' -#' @import dplyr -#' @importFrom glue glue -#' -get_mm_data <- function(pkg_id){ - dbSelect(glue::glue( - "SELECT metric.name, metric.long_name, metric.description, metric.is_perc, - metric.is_url, package_metrics.value - FROM metric - INNER JOIN package_metrics ON metric.id = package_metrics.metric_id - WHERE package_metrics.package_id = '{pkg_id}' AND - metric.class = 'maintenance' ;")) %>% - dplyr::mutate( - title = long_name, - desc = description, - succ_icon = rep(x = 'check', times = nrow(.)), - unsucc_icon = rep(x = 'times', times = nrow(.)), - icon_class = rep(x = 'text-success', times = nrow(.)), - .keep = 'unused' - ) -} -#' The 'Get Communnity Data' function -#' -#' Get all community metric data on a specific package -#' -#' @param pkg_name string -#' -#' @importFrom glue glue -#' -get_comm_data <- function(pkg_name){ - dbSelect(glue::glue( - "SELECT * - FROM community_usage_metrics - WHERE id = '{pkg_name}'") - ) -} -#' The 'Get Package Info' function -#' -#' Get all general info on a specific package -#' -#' @param pkg_name string -#' -#' @importFrom glue glue -#' -get_pkg_info <- function(pkg_name){ - dbSelect(glue::glue( - "SELECT * - FROM package - WHERE name = '{pkg_name}'") - ) -} -##### End of get_* functions ##### diff --git a/R/utils_get_db.R b/R/utils_get_db.R new file mode 100644 index 000000000..d3b14b855 --- /dev/null +++ b/R/utils_get_db.R @@ -0,0 +1,231 @@ + +#' Select data from database +#' +#' @param query a sql query as a string +#' @param db_name character name (and file path) of the database +#' +#' @import dplyr +#' @importFrom DBI dbConnect dbSendQuery dbFetch dbClearResult dbDisconnect +#' @importFrom RSQLite SQLite +#' @importFrom loggit loggit +#' +#' @returns a data frame +#' +#' @noRd +dbSelect <- function(query, db_name = golem::get_golem_options('assessment_db_name')){ + errFlag <- FALSE + con <- DBI::dbConnect(RSQLite::SQLite(), db_name) + + tryCatch( + expr = { + rs <- DBI::dbSendQuery(con, query) + }, + warning = function(warn) { + message <- paste0("warning:\n", query, "\nresulted in\n", warn) + message(message, .loggit = FALSE) + loggit::loggit("WARN", message, echo = FALSE) + errFlag <<- TRUE + }, + error = function(err) { + message <- paste0("error:\n", query, "\nresulted in\n",err) + message(message, .loggit = FALSE) + loggit::loggit("ERROR", message, echo = FALSE) + DBI::dbDisconnect(con) + errFlag <<- TRUE + }, + finally = { + if (errFlag) return(NULL) + }) + + dat <- DBI::dbFetch(rs) + DBI::dbClearResult(rs) + DBI::dbDisconnect(con) + + return(dat) +} + + +# Below are a series of get_* functions that help us query +# certain sql tables in a certain way. They are used 2 - 3 +# times throughout the app, so it's best to maintain them +# in a central location + +#' The 'Get Overall Comments' function +#' +#' Retrieves the overall comments for a specific package +#' +#' @param pkg_name character name of the package +#' @param db_name character name (and file path) of the database +#' +#' @importFrom glue glue +#' +#' @returns a data frame +#' @noRd +get_overall_comments <- function(pkg_name, db_name = golem::get_golem_options('assessment_db_name')) { + dbSelect(glue::glue( + "SELECT * FROM comments + WHERE comment_type = 'o' AND id = '{pkg_name}'"), db_name + ) +} + + +#' The 'Get Maintenance Metrics Comments' function +#' +#' Retrieves the Maint Metrics comments for a specific package +#' +#' @param pkg_name character name of the package +#' @param db_name character name (and file path) of the database +#' +#' @importFrom glue glue +#' @importFrom purrr map +#' +#' @returns a data frame +#' @noRd +get_mm_comments <- function(pkg_name, db_name = golem::get_golem_options('assessment_db_name')) { + dbSelect( + glue::glue( + "SELECT user_name, user_role, comment, added_on + FROM comments + WHERE id = '{pkg_name}' AND comment_type = 'mm'" + ), db_name + ) %>% + purrr::map(rev) +} + + +#' The 'Get Community Usage Metrics Comments' function +#' +#' Retrieve the Community Metrics comments for a specific package +#' +#' @param pkg_name character name of the package +#' @param db_name character name (and file path) of the database +#' +#' @importFrom glue glue +#' @importFrom purrr map +#' +#' @returns a data frame +#' @noRd +get_cm_comments <- function(pkg_name, db_name = golem::get_golem_options('assessment_db_name')) { + dbSelect( + glue::glue( + "SELECT user_name, user_role, comment, added_on + FROM comments + WHERE id = '{pkg_name}' AND comment_type = 'cum'" + ), db_name + ) %>% + purrr::map(rev) +} + +#' The 'Get Maintenance Metrics Data' function +#' +#' Pull the maint metrics data for a specific package id, and create +#' necessary columns for Cards UI +#' +#' @param pkg_id integer package id +#' @param db_name character name (and file path) of the database +#' +#' @import dplyr +#' @importFrom glue glue +#' +#' @returns a data frame +#' @noRd +get_mm_data <- function(pkg_id, db_name = golem::get_golem_options('assessment_db_name')){ + dbSelect(glue::glue( + "SELECT metric.name, metric.long_name, metric.description, metric.is_perc, + metric.is_url, package_metrics.value + FROM metric + INNER JOIN package_metrics ON metric.id = package_metrics.metric_id + WHERE package_metrics.package_id = '{pkg_id}' AND + metric.class = 'maintenance' ;"), db_name) %>% + dplyr::mutate( + title = long_name, + desc = description, + succ_icon = rep(x = 'check', times = nrow(.)), + unsucc_icon = rep(x = 'times', times = nrow(.)), + icon_class = rep(x = 'text-success', times = nrow(.)), + .keep = 'unused' + ) +} + + +#' The 'Get Community Data' function +#' +#' Get all community metric data on a specific package +#' +#' @param pkg_name character name of the package +#' @param db_name character name (and file path) of the database +#' +#' @importFrom glue glue +#' +#' @returns a data frame +#' @noRd +get_comm_data <- function(pkg_name, db_name = golem::get_golem_options('assessment_db_name')){ + dbSelect(glue::glue( + "SELECT * + FROM community_usage_metrics + WHERE id = '{pkg_name}'"), db_name + ) +} + +#' The 'Get Package Info' function +#' +#' Get all general info on a specific package +#' +#' @param pkg_name character name of the package +#' @param db_name character name (and file path) of the database +#' +#' @importFrom glue glue +#' +#' @returns a data frame +#' @noRd +get_pkg_info <- function(pkg_name, db_name = golem::get_golem_options('assessment_db_name')){ + dbSelect(glue::glue( + "SELECT * + FROM package + WHERE name = '{pkg_name}'"), db_name + ) +} + + +#' get_metric_weights +#' +#' Retrieves metric name and current weight from metric table +#' +#' @param db_name character name (and file path) of the database +#' +#' @returns a data frame +#' @noRd +get_metric_weights <- function(db_name = golem::get_golem_options('assessment_db_name')){ + dbSelect( + "SELECT name, weight + FROM metric", db_name + ) +} + + +##### End of get_* functions ##### + + +#' weight_risk_comment +#' +#' Used to add a comment on every tab saying how the risk and weights changed, +#' and that the overall comment & final decision may no longer be applicable. +#' +#' @param pkg_name character name of the package +#' @param db_name character name (and file path) of the database +#' @importFrom glue glue +#' +#' @returns a data frame +#' @noRd +weight_risk_comment <- function(pkg_name, db_name = golem::get_golem_options('assessment_db_name')) { + + pkg_score <- dbSelect(glue::glue( + "SELECT score + FROM package + WHERE name = '{pkg_name}'" + ), db_name) + + glue::glue('Metric re-weighting has occurred. + The previous risk score was {pkg_score}.') +} + diff --git a/R/utils_initialize.R b/R/utils_initialize.R deleted file mode 100644 index 32b4c0ec9..000000000 --- a/R/utils_initialize.R +++ /dev/null @@ -1,42 +0,0 @@ -#' Initialize the Risk Assessment Application -#' -#' @description This sets up the environment when running the Risk Assessment -#' Application. It sets the log file, initializes the package database if -#' missing, and initializes the credentials database if missing. -#' -#' @return There is no return value. The function is run for its side effects. -#' @importFrom loggit set_logfile -#' -#' @export -initialize_raa <- function() { - # Start logging info. - loggit::set_logfile("loggit.json") - - - # Create package db & credentials db if it doesn't exist yet. - if(!file.exists(database_name)) create_db() - if(!file.exists(credentials_name)) create_credentials_db() -} - - -#' Application Theme -#' -#' @description This sets the Risk Assessment Application theme object using -#' bslib's bs_theme() function. The app_theme object gets used in run_app.R, -#' in addition to app_ui.R -#' -#' @return an bs_theme object of several classes -#' @importFrom bslib bs_theme -#' -#' @export -app_theme <- bslib::bs_theme( - bootswatch = "lux", - version = 5, - # bg = "white", - # fg = "#023967", - primary = "#24305E", - secondary = "#F76C6C", - # success = "orange", - # info = "yellow", - # warning = "pink" -) diff --git a/R/dbupload.R b/R/utils_insert_db.R similarity index 53% rename from R/dbupload.R rename to R/utils_insert_db.R index 6a0606486..ab41d49ff 100644 --- a/R/dbupload.R +++ b/R/utils_insert_db.R @@ -1,54 +1,58 @@ -#' Get the package general information from CRAN/local -#' -#' @param pkg_name the package name -#' +#' dbUpdate +#' +#' Deletes, updates or inserts queries. +#' +#' @param command a string +#' @param db_name character name (and file path) of the database +#' #' @import dplyr -#' @importFrom tidyr pivot_wider -#' @importFrom glue glue -#' @importFrom rvest read_html html_node html_table html_text -#' @importFrom stringr str_remove_all +#' @importFrom DBI dbConnect dbSendStatement dbClearResult dbDisconnect +#' dbGetRowsAffected +#' @importFrom RSQLite SQLite +#' @importFrom loggit loggit +#' @importFrom glue glue #' -get_latest_pkg_info <- function(pkg_name) { - webpage <- rvest::read_html(glue::glue( - 'https://cran.r-project.org/web/packages/{pkg_name}')) - - # Regex that finds entry: '\n ', "'", and '"' (the `|` mean 'or' and the - # `\`` is to scape the double quotes). - pattern <- '\n |\'|\"|\\"' - - # Save div with class container to get the title and description. - div_container <- webpage %>% rvest::html_nodes("div.container") - - # Read package title and clean it. - title <- div_container %>% - rvest::html_nodes("h2") %>% - rvest::html_text() %>% - stringr::str_remove_all(pattern = pattern) +#' @returns nothing +#' @noRd +dbUpdate <- function(command, db_name = golem::get_golem_options('assessment_db_name')){ + errFlag <- FALSE + con <- DBI::dbConnect(RSQLite::SQLite(), db_name) - # Read package description and clean it. - description <- div_container %>% - rvest::html_nodes("h2 + p") %>% - rvest::html_text() %>% - stringr::str_remove_all(pattern = pattern) - - # Get the table displaying version, authors, etc. - table_info <- (webpage %>% rvest::html_table())[[1]] %>% - dplyr::mutate(X1 = stringr::str_remove_all(string = X1, pattern = ':')) %>% - dplyr::mutate(X2 = stringr::str_remove_all(string = X2, pattern = pattern)) %>% - tidyr::pivot_wider(names_from = X1, values_from = X2) %>% - dplyr::select(Version, Maintainer, Author, License, Published) %>% - dplyr::mutate(Title = title, Description = description) + tryCatch({ + rs <- DBI::dbSendStatement(con, command) + }, error = function(err) { + message <- glue::glue("command: {command} resulted in {err}") + message(message, .loggit = FALSE) + loggit::loggit("ERROR", message, echo = FALSE) + DBI::dbDisconnect(con) + errFlag <<- TRUE + }, + finally = { + if (errFlag) return(invisible(NULL)) + }) + + nr <- DBI::dbGetRowsAffected(rs) + DBI::dbClearResult(rs) - return(table_info) + if (nr == 0) { + message <- glue::glue("zero rows were affected by the command: {command}") + message(message, .loggit = FALSE) + } + DBI::dbDisconnect(con) } - #' Call function to get and upload info from CRAN/local to db. #' +#' @param pkg_name string name of the package +#' @param db_name character name (and file path) of the database +#' #' @importFrom loggit loggit #' -insert_pkg_info_to_db <- function(pkg_name) { +#' @returns nothing +#' @noRd +insert_pkg_info_to_db <- function(pkg_name, + db_name = golem::get_golem_options('assessment_db_name')) { tryCatch( expr = { # get latest high-level package info @@ -59,7 +63,7 @@ insert_pkg_info_to_db <- function(pkg_name) { upload_package_to_db(pkg_name, pkg_info$Version, pkg_info$Title, pkg_info$Description, pkg_info$Author, pkg_info$Maintainer, pkg_info$License, - pkg_info$Published) + pkg_info$Published, db_name) }, error = function(e) { @@ -76,23 +80,35 @@ insert_pkg_info_to_db <- function(pkg_name) { lis <- d$get("License") pub <- d$get("Packaged") - upload_package_to_db(pkg_name, ver, title, desc, auth, main, lis, pub) + upload_package_to_db(pkg_name, ver, title, desc, auth, main, lis, pub, db_name) }} } else{ loggit::loggit("ERROR", paste("Error in extracting general info of the package", - pkg_name, "info", e), app = "fileupload-webscraping") + pkg_name, "info", e), app = "fileupload-webscraping") } } ) } + #' Upload the general info into DB. +#' @param name string the package name +#' @param version string package version +#' @param title string title of the package +#' @param description string description of the package +#' @param authors string author name(s) +#' @param maintainers string names of maintainers +#' @param license string type of package license +#' @param published_on string char date of publication +#' @param db_name character name (and file path) of the database #' #' @importFrom glue glue #' @importFrom loggit loggit #' +#' @returns nothing +#' @noRd upload_package_to_db <- function(name, version, title, description, - authors, maintainers, license, published_on) { + authors, maintainers, license, published_on, db_name) { tryCatch( expr = { dbUpdate(glue::glue( @@ -101,11 +117,11 @@ upload_package_to_db <- function(name, version, title, description, license, published_on, decision, date_added) VALUES('{name}', '{version}', '{title}', '{description}', '{maintainers}', '{authors}', '{license}', '{published_on}', - '', '{Sys.Date()}')")) + '', '{Sys.Date()}')"), db_name) }, error = function(e) { loggit::loggit("ERROR", paste("Error in uploading the general info of the package", name, "info", e), - app = "fileupload-DB") + app = "fileupload-DB") } ) } @@ -115,19 +131,27 @@ upload_package_to_db <- function(name, version, title, description, #' #' Get the maintenance and testing metrics info and upload into DB. #' +#' @param pkg_name string name of the package +#' @param db_name character name (and file path) of the database +#' #' @import dplyr #' @importFrom riskmetric pkg_ref pkg_assess pkg_score #' @importFrom glue glue #' -insert_maintenance_metrics_to_db <- function(pkg_name){ - +#' @returns nothing +#' @noRd +insert_riskmetric_to_db <- function(pkg_name, + db_name = golem::get_golem_options('assessment_db_name')){ + riskmetric_assess <- - riskmetric::pkg_ref(pkg_name) %>% + riskmetric::pkg_ref(pkg_name, + source = "pkg_cran_remote", + repos = c("https://cran.rstudio.com")) %>% dplyr::as_tibble() %>% riskmetric::pkg_assess() # Get the metrics weights to be used during pkg_score. - metric_weights_df <- dbSelect("SELECT id, name, weight FROM metric") + metric_weights_df <- dbSelect("SELECT id, name, weight FROM metric", db_name) metric_weights <- metric_weights_df$weight names(metric_weights) <- metric_weights_df$name @@ -135,7 +159,7 @@ insert_maintenance_metrics_to_db <- function(pkg_name){ riskmetric_assess %>% riskmetric::pkg_score(weights = metric_weights) - package_id <- dbSelect(glue::glue("SELECT id FROM package WHERE name = '{pkg_name}'")) + package_id <- dbSelect(glue::glue("SELECT id FROM package WHERE name = '{pkg_name}'"), db_name) # Leave method if package not found. if(nrow(package_id) == 0){ @@ -169,19 +193,22 @@ insert_maintenance_metrics_to_db <- function(pkg_name){ dbUpdate(glue::glue( "INSERT INTO package_metrics (package_id, metric_id, weight, value) - VALUES ({package_id}, {metric$id}, {metric$weight}, '{metric_value}')") + VALUES ({package_id}, {metric$id}, {metric$weight}, '{metric_value}')"), db_name ) } dbUpdate(glue::glue( "UPDATE package SET score = '{format(round(riskmetric_score$pkg_score[1], 2))}' - WHERE name = '{pkg_name}'")) + WHERE name = '{pkg_name}'"), db_name) } #' Generate community usage metrics and upload data into DB #' +#' @param pkg_name string name of the package +#' @param db_name character name (and file path) of the database +#' #' @import dplyr #' @importFrom cranlogs cran_downloads #' @importFrom lubridate year month @@ -189,74 +216,13 @@ insert_maintenance_metrics_to_db <- function(pkg_name){ #' @importFrom rvest read_html html_node html_table html_text #' @importFrom loggit loggit #' @importFrom stringr str_remove_all -#' @importFrom tidyr tibble #' -insert_community_metrics_to_db <- function(pkg_name) { - pkgs_cum_metrics <- tidyr::tibble() +#' @returns nothing +#' @noRd +insert_community_metrics_to_db <- function(pkg_name, + db_name = golem::get_golem_options('assessment_db_name')) { - tryCatch( - expr = { - - # get current release version number and date - curr_release <- get_latest_pkg_info(pkg_name) %>% - dplyr::select(`Last modified` = Published, version = Version) - - # Get the packages past versions and dates. - pkg_url <- url(glue::glue('https://cran.r-project.org/src/contrib/Archive/{pkg_name}')) - pkg_page <- try(rvest::read_html(pkg_url), silent = TRUE) - - # if past releases exist... they usually do! - if(all(class(pkg_page) != "try-error")){ #exists("pkg_page") - versions_with_dates0 <- pkg_page %>% - rvest::html_node('table') %>% - rvest::html_table() %>% - dplyr::select(-c("", "Description", 'Size')) %>% - dplyr::filter(`Last modified` != "") %>% - dplyr::mutate(version = stringr::str_remove_all( - string = Name, pattern = glue::glue('{pkg_name}_|.tar.gz')), - .keep = 'unused') %>% - # get latest high-level package info - union(curr_release) - } else { - versions_with_dates0 <- curr_release - } - # close(pkg_url) - - versions_with_dates <- versions_with_dates0 %>% - dplyr::mutate(date = as.Date(`Last modified`), .keep = 'unused') %>% - dplyr::mutate(month = lubridate::month(date)) %>% - dplyr::mutate(year = lubridate::year(date)) - - - # First release date. - first_release_date <- versions_with_dates %>% - dplyr::pull(date) %>% - min() - - # Get the number of downloads by month, year. - pkgs_cum_metrics <- - cranlogs::cran_downloads( - pkg_name, - from = first_release_date, - to = Sys.Date()) %>% - dplyr::mutate(month = lubridate::month(date), - year = lubridate::year(date)) %>% - dplyr::filter(!(month == lubridate::month(Sys.Date()) & - year == lubridate::year(Sys.Date()))) %>% - group_by(month, year) %>% - summarise(downloads = sum(count)) %>% - ungroup() %>% - left_join(versions_with_dates, by = c('month', 'year')) %>% - dplyr::arrange(year, month) %>% - dplyr::select(-date) - - }, - error = function(e) { - loggit::loggit("ERROR", paste("Error extracting cum metric info of the package:", - pkg_name, "info", e), - app = "fileupload-webscraping", echo = FALSE) - } - ) + pkgs_cum_metrics <- generate_comm_data(pkg_name) if(nrow(pkgs_cum_metrics) != 0){ for (i in 1:nrow(pkgs_cum_metrics)) { @@ -265,8 +231,46 @@ insert_community_metrics_to_db <- function(pkg_name) { (id, month, year, downloads, version) VALUES ('{pkg_name}', {pkgs_cum_metrics$month[i]}, {pkgs_cum_metrics$year[i]}, {pkgs_cum_metrics$downloads[i]}, - '{pkgs_cum_metrics$version[i]}')")) + '{pkgs_cum_metrics$version[i]}')"), db_name) } } } + +#' update_metric_weight +#' +#' @param metric_name a metric name, as a string +#' @param metric_weight a weight, as a string or double +#' @param db_name character name (and file path) of the database +#' +#' @importFrom glue glue +#' +#' @returns nothing +#' @noRd +update_metric_weight <- function(metric_name, metric_weight, + db_name = golem::get_golem_options('assessment_db_name')){ + dbUpdate(glue::glue( + "UPDATE metric + SET weight = {metric_weight} + WHERE name = '{metric_name}'" + ), db_name) +} + +#' db trash collection +#' +#' clean up tables package_metrics, community_usage_metrics and comments +#' after one or more packages have been removed from the package table. +#' +#' @param db_name character name (and file path) of the database +#' +#' @returns nothing +#' @noRd +db_trash_collection <- function(db_name = golem::get_golem_options('assessment_db_name')){ + + dbUpdate("delete from package_metrics where package_id not in(select id from package)", db_name) + dbUpdate("delete from community_usage_metrics where id not in(select name from package)", db_name) + cmtbl <- dbSelect("select distinct id from comments", db_name) + if (nrow(cmtbl) >0) { + dbUpdate("delete from comments where id not in(select name from package)", db_name) + } +} \ No newline at end of file diff --git a/R/utils_startup.R b/R/utils_startup.R new file mode 100644 index 000000000..99c573366 --- /dev/null +++ b/R/utils_startup.R @@ -0,0 +1,313 @@ +#' Create package database +#' +#' @description Note: the database_name object is assigned by deployment users in R/run_app.R +#' +#' @param db_name A string denoting the name of the database +#' +#' @import dplyr +#' @importFrom DBI dbConnect dbDisconnect dbSendStatement dbClearResult +#' @importFrom RSQLite SQLite +#' @importFrom loggit loggit +#' @keywords internal +create_db <- function(db_name){ + + if (missing(db_name) || is.null(db_name) || typeof(db_name) != "character" || length(db_name) != 1 || !grepl("\\.sqlite$", db_name)) + stop("db_name must follow SQLite naming conventions (e.g. 'database.sqlite')") + + # Create an empty database. + con <- DBI::dbConnect(RSQLite::SQLite(), db_name) + + # Set the path to the queries. + path <- app_sys("app/www/sql_queries") #file.path('sql_queries') + + # Queries needed to run the first time the db is created. + queries <- c( + "create_package_table.sql", + "create_metric_table.sql", + "initialize_metric_table.sql", + "create_package_metrics_table.sql", + "create_community_usage_metrics_table.sql", + "create_comments_table.sql" + ) + + # Append path to the queries. + queries <- file.path(path, queries) + + # Apply each query. + sapply(queries, function(x){ + + tryCatch({ + rs <- DBI::dbSendStatement( + con, + paste(scan(x, sep = "\n", what = "character"), collapse = "")) + }, error = function(err) { + message <- paste("dbSendStatement",err) + message(message, .loggit = FALSE) + loggit::loggit("ERROR", message) + DBI::dbDisconnect(con) + }) + + DBI::dbClearResult(rs) + }) + + DBI::dbDisconnect(con) + invisible(db_name) +} + + + +#' Create credentials database +#' +#' Note: the credentials_db_name object is assigned by the deployment user in R/run_app.R +#' +#' @param db_name A string denoting the name of the database +#' +#' @import dplyr +#' @importFrom DBI dbConnect dbDisconnect +#' @importFrom RSQLite SQLite +#' @importFrom shinymanager read_db_decrypt write_db_encrypt +#' @keywords internal +#' +create_credentials_db <- function(db_name){ + + if (missing(db_name) || is.null(db_name) || typeof(db_name) != "character" || length(db_name) != 1 || !grepl("\\.sqlite$", db_name)) + stop("db_name must follow SQLite naming conventions (e.g. 'credentials.sqlite')") + + # Init the credentials table for credentials database + credentials <- data.frame( + user = "ADMIN", + password = "QWERTY1", + # password will automatically be hashed + admin = TRUE, + expire = as.character(Sys.Date()), + stringsAsFactors = FALSE + ) + + # Init the credentials database + shinymanager::create_db( + credentials_data = credentials, + sqlite_path = file.path(db_name), + passphrase = passphrase + ) + + # set pwd_mngt$must_change to TRUE + con <- DBI::dbConnect(RSQLite::SQLite(), db_name) + pwd <- shinymanager::read_db_decrypt( + con, name = "pwd_mngt", + passphrase = passphrase) %>% + dplyr::mutate(must_change = ifelse( + have_changed == "TRUE", must_change, as.character(TRUE))) + + shinymanager::write_db_encrypt( + con, + value = pwd, + name = "pwd_mngt", + passphrase = passphrase + ) + DBI::dbDisconnect(con) + + # update expire date here to current date + 365 days + con <- DBI::dbConnect(RSQLite::SQLite(), db_name) + dat <- shinymanager::read_db_decrypt(con, name = "credentials", passphrase = passphrase) %>% + dplyr::mutate(expire = as.character(Sys.Date() + 365)) + + shinymanager::write_db_encrypt( + con, + value = dat, + name = "credentials", + passphrase = passphrase + ) + + DBI::dbDisconnect(con) + invisible(db_name) +} + +#' Create credentials dev database +#' +#' @param db_name A string denoting the name of the database +#' +#' @importFrom shinymanager create_db +#' @keywords internal +#' +create_credentials_dev_db <- function(db_name){ + + if (missing(db_name) || is.null(db_name) || typeof(db_name) != "character" || length(db_name) != 1 || !grepl("\\.sqlite$", db_name)) + stop("db_name must follow SQLite naming conventions (e.g. 'credentials.sqlite')") + + # Init the credentials table for credentials database + credentials <- data.frame( + user = c("admin", "nonadmin"), + password = c("cxk1QEMYSpYcrNB", "Bt0dHK383lLP1NM"), + # password will automatically be hashed + admin = c(TRUE, FALSE), + stringsAsFactors = FALSE + ) + + # Init the credentials database + shinymanager::create_db( + credentials_data = credentials, + sqlite_path = file.path(db_name), + passphrase = passphrase + ) + + invisible(db_name) +} + +#' Initialize `riskassessment` Application Settings +#' +#' @description This sets up the environment when running the `riskassessment` +#' Application. It sets the log file, initializes the package database if +#' missing, and initializes the credentials database if missing. +#' +#' @param assess_db A string denoting the name of the assessment database. +#' @param cred_db A string denoting the name of the credentials database. +#' +#' @return There is no return value. The function is run for its side effects. +#' @importFrom loggit set_logfile +#' @importFrom jsonlite write_json +#' +#' @export +initialize_raa <- function(assess_db, cred_db) { + + if (missing(assess_db)) assessment_db <- golem::get_golem_options('assessment_db_name') else assessment_db <- assess_db + if (missing(cred_db)) credentials_db <- golem::get_golem_options('credentials_db_name') else credentials_db <- cred_db + + if (is.null(assessment_db) || typeof(assessment_db) != "character" || length(assessment_db) != 1 || !grepl("\\.sqlite$", assessment_db)) + stop("assess_db must follow SQLite naming conventions (e.g. 'database.sqlite')") + if (is.null(credentials_db) || typeof(credentials_db) != "character" || length(credentials_db) != 1 || !grepl("\\.sqlite$", credentials_db)) + stop("cred_db must follow SQLite naming conventions (e.g. 'database.sqlite')") + + # Start logging info. + if (isRunning()) loggit::set_logfile("loggit.json") + + # https://github.com/rstudio/fontawesome/issues/99 + # Here, we make sure user has a functional version of fontawesome + fa_v <- packageVersion("fontawesome") + if(fa_v == '0.3.0') warning(glue::glue("HTML reports will not render with {fontawesome} v0.4.0. You currently have v{fa_v} installed. If the report download failed, please install a stable version. We recommend v0.5.0 or higher.")) + + # Create package db & credentials db if it doesn't exist yet. + if(!file.exists(assessment_db)) create_db(assessment_db) + if(!file.exists(credentials_db)) create_credentials_db(credentials_db) + + if(!file.exists("auto_decisions.json")) jsonlite::write_json(data.frame(decision = character(0), lower_limit = numeric(0), upper_limit = numeric(0)), "auto_decisions.json") + + invisible(c(assessment_db, credentials_db)) +} + + +#' The 'Add tags' function +#' +#' @param ui placeholder +#' @param ... placeholder +#' +#' +#' @importFrom shinymanager fab_button +#' @importFrom shinyjs useShinyjs +#' @keywords internal +add_tags <- function(ui, ...) { + ui <- force(ui) + + function(request) { + query <- parseQueryString(request$QUERY_STRING) + admin <- query$admin + + if (is.function(ui)) { + ui <- ui(request) + } + + if (identical(admin, "true")) { + ui <- tagList(ui, + tags$script(HTML("document.getElementById('admin-add_user').style.width = 'auto';")), + tags$script(HTML("var oldfab = Array.prototype.slice.call(document.getElementsByClassName('mfb-component--br'), 0); + for (var i = 0; i < oldfab.length; ++i) { + oldfab[i].remove(); + }")), + shinymanager::fab_button( + position = "bottom-right", + actionButton( + inputId = ".shinymanager_logout", + label = "Logout", + icon = icon("right-from-bracket") + ), + actionButton( + inputId = ".shinymanager_app", + label = "Go to application", + icon = icon("share") + ) + ) + ) + } + + tagList(shinyjs::useShinyjs(), + ui, + tags$script(HTML("$(document).on('shiny:value', function(event) { + if (event.target.id === 'admin-table_users') { + Shiny.onInputChange('table_users-returns', document.getElementById('admin-table_users').innerHTML) + } else if (event.target.id === 'admin-table_pwds') { + Shiny.onInputChange('table_pwds-returns', document.getElementById('admin-table_pwds').innerHTML) + } + });"))) + } +} + +#' Add an Authentication Screen +#' +#' Adds an authentication screen via [shinymanager::secure_app()]. +#' +#' @param app_ui The `app_ui` function for the application. +#' @param app_ver See identical param in [run_app()]. +#' @param login_note See identical param in [run_app()]. +#' +#' @importFrom shinymanager secure_app +#' @importFrom golem get_golem_options +#' +#' @md +#' @keywords internal +add_shinymanager_auth <- function(app_ui, app_ver, login_note) { + if (!isTRUE(getOption("shiny.testmode"))) { + add_tags(shinymanager::secure_app(app_ui, + tags_top = tags$div( + tags$head(tags$style(HTML(readLines(system.file("app", "www", "css", "login_screen.css", package = "riskassessment"))))), + tags$head(if (!get_golem_config("app_prod") && !is.null(golem::get_golem_options("pre_auth_user"))) { + tags$script(HTML(glue::glue("$(document).on('shiny:connected', function () {{ + Shiny.setInputValue('auth-user_id', '{golem::get_golem_options('login_creds')$user_id}'); + Shiny.setInputValue('auth-user_pwd', '{golem::get_golem_options('login_creds')$user_pwd}'); + $('#auth-go_auth').trigger('click'); + }});"))) + }), + id = "login_screen", + tags$h2("Risk Assessment Application", style = "align:center"), + tags$h3(glue::glue("**Version {app_ver}**"), + style = "align:center; color: darkgray" + ) + ), + tags_bottom = tags$div( + tags$h6(login_note, style = "color: white") + ), + enable_admin = TRUE, theme = app_theme() + )) + } else { + app_ui + } +} + + +#' Application Theme +#' +#' @description This sets the `riskassessment` Application theme object using +#' bslib's bs_theme() function. The app_theme object gets used in run_app.R, +#' in addition to app_ui.R +#' +#' @return an bs_theme object of several classes +#' @importFrom bslib bs_theme +#' +#' @keywords internal +#' @export +app_theme <- function() { + bslib::bs_theme( + bootswatch = "lux", + version = 5, + primary = "#24305E", + secondary = "#F76C6C", + ) +} diff --git a/README.Rmd b/README.Rmd index 530e3e4b2..ca7603415 100644 --- a/README.Rmd +++ b/README.Rmd @@ -13,19 +13,22 @@ knitr::opts_chunk$set( ) ``` -# `{riskassessment}`: an extension of `{riskmetric}` +# The `{riskassessment}` application - [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) - +[](https://RValidationHub.slack.com) +[![R-CMD-check](https://github.com/pharmaR/riskassessment/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/pharmaR/riskassessment/actions/workflows/R-CMD-check.yaml) +[![Coverage status](https://codecov.io/gh/pharmaR/riskassessment/branch/master/graph/badge.svg)](https://codecov.io/github/pharmaR/riskassessment?branch=master) +[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) + -`riskassessment` is a handy interface that augments the utility of the [`riskmetric`](https://github.com/pharmaR/riskmetric) package within an organizational setting. +`riskassessment` is an R package containing a shiny front-end to augment the utility of the [`riskmetric`](https://github.com/pharmaR/riskmetric) package within an organizational context.
-Risk Assessment app +{riskassessment} app
@@ -34,7 +37,7 @@ knitr::opts_chunk$set(
-More over, `riskassessment` is an R package containing an interactive shiny application. It serves as a front end interface to the [`riskmetric`](https://github.com/pharmaR/riskmetric) R package. If you're unfamiliar, `riskmetric` is a framework to quantify an R package's "risk" by assessing a number of meaningful metrics designed to evaluate package development best practices, code documentation, community engagement, and development sustainability. Together, the `riskassessment` app and the `riskmetric` package aim to provide some context for validation within regulated industries. +`riskmetric` is a framework to quantify an R package's "risk" by assessing a number of meaningful metrics designed to evaluate package development best practices, code documentation, community engagement, and development sustainability. Together, the `riskassessment` app and the `riskmetric` package aim to provide some context for validation within regulated industries. The app extends the functionality of `riskmetric` by allowing the reviewer to: @@ -49,16 +52,18 @@ the reviewer to: -### Echo-ing `{riskmetric}`'s Approach to Validation +### Echo-ing `{riskmetric}`'s Approach to Validation Validation can serve as an umbrella for various terms, and admittedly, companies will diverge on what is the correct approach to validation. The validation approach we followed is based on the philosophy of the white paper set forth by the R Validation Hub: [White Paper](https://www.pharmar.org/white-paper/). +_Note:_ Development of both `riskassessment` and `riskmetric` were made possible thanks to the [R Validation Hub](https://www.pharmar.org/about/), a collaboration to support the adoption of R within a biopharmaceutical regulatory setting. ### Usage -If you are new to using the `riskassessment` app, welcome! We'd highly encourage you to start exploring the [`demo verson`](https://rinpharma.shinyapps.io/risk_assessment) of the app currently deployed on shinyapps.io. There, you'll find a number of pre-loaded packages just waiting to be assessed. Hands on experience will help you become familiar with the general layout of the app as you poke around and explore. +If you are new to using the `riskassessment` app, welcome! We'd highly encourage you to start exploring the [`demo version`](https://rinpharma.shinyapps.io/risk_assessment) of the app currently deployed on shinyapps.io. There, you'll find a number of pre-loaded packages just waiting to be assessed. Hands on experience will help you become familiar with the general layout of the app as you poke around and explore. + +With that said, you should immediately recognize that the app requires authentication, since it's intended use is within an organization. There are two pre-defined roles: 'nonadmin' users and 'admin' users. The latter can add/delete users, download an entire copy of the database, and modify the metric weights used in calculation of risk scores. Initially, both share the same password: `QWERTY1`. If you log in with this credential, the app will immediately prompt you to change your password and repeat the the process with your new credentials. -With that said, you should immediately recognize that the app requires authentication, since it's intended use is within an organization. There are two pre-defined roles: 'nonadmin' users and 'admin' users. The latter can add/delete users, download an entire copy of the database, and modify the metric weights used in calculation of risk scores. Initially, both share the same password: `QWERTY1`. If you log in with this credential, the app will immediately prompt you to change your password and repeat the tje process with your new credentials. If you want a quick tour through the app (or need assistance getting past the authentication wall), you should watch this short walk through on the R Consortium's website: @@ -77,20 +82,27 @@ If you desire a more comprehensive overview of `riskmetric`'s approach to valida #### Installation -For those who are ready to run/deploy this application in their own environment, we'd recommend the below workflow to install the package. Note: the `riskassessment` package is not on CRAN yet, but you can easily install the latest version from GitHub using: +We recommend to run/deploy this application in a controlled development environment. Of course, you can install the latest version from GitHub using the code below, but it doesn't take into consideration other environment dependencies which means we can't guarantee stability: ```{r, eval=FALSE} # install.packages("remotes") # if needed +remotes::install_github("pharmaR/riskmetric") remotes::install_github("pharmaR/riskassessment") + +# Run the application +riskassessment::run_app() ``` -With a simple `library(riskassessment)` you can access all the exported functions from `riskassessment` that help users reproduce analysis performed in the app. Or, you can create an `app.R` file and launch (or deploy) the application if you include the following line of code: +Instead, we'd recommend that you clone the repo's R project locally and run the following code in order to take advantage of our `renv.lock` file which set's up the project dependencies: ```{r, eval=FALSE} -# Run the application -riskassessment::run_app() +# First, clone the repo from Github, then... +# Get dependcies synced using {renv} +renv::activate() +renv::restore() ``` +After this step is complete, you can simply run the contents of `app.R` to launch and/or deploy the application! #### Deployments @@ -111,25 +123,5 @@ For more information on each of these, we highly recommend reading our deploymen We are currently working on improving the app and it's documentation. Since they are are currently in-progress, please explore the user guides that have been developed so far, available on the [documentation site](https://pharmar.github.io/riskassessment/). -### Contributors/Authors - -We would like to thank all the contributors! Specifically, we would like to thank: - -- [R Validation Hub](https://www.pharmar.org) -- [Aaron Clark](https://www.linkedin.com/in/dataaaronclark/), Biogen, *Maintainer* -- [Marly Gotti](https://www.marlygotti.com), Previously Biogen -- Robert Krajcik, Cytel -- Jeff Thompson, Cytel -- Maya Gans, Cytel -- Aravind Reddy Kallem -- Fission Labs India Pvt Ltd - -_Note:_ This app was made possible thanks to the [R Validation Hub](https://www.pharmar.org/about/), a collaboration to support the adoption of R within a biopharmaceutical regulatory setting. - - -### License - -Please see the [License](LICENSE.md) file that lives alongside this repo. -
diff --git a/README.md b/README.md index cf1b8ba31..0d16c077c 100644 --- a/README.md +++ b/README.md @@ -1,23 +1,27 @@ -# `{riskassessment}`: an extension of `{riskmetric}` +# The `{riskassessment}` application +[](https://RValidationHub.slack.com) +[![R-CMD-check](https://github.com/pharmaR/riskassessment/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/pharmaR/riskassessment/actions/workflows/R-CMD-check.yaml) +[![Coverage +status](https://codecov.io/gh/pharmaR/riskassessment/branch/master/graph/badge.svg)](https://codecov.io/github/pharmaR/riskassessment?branch=master) [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) -`riskassessment` is a handy interface that augments the utility of the -[`riskmetric`](https://github.com/pharmaR/riskmetric) package within an -organizational setting. +`riskassessment` is an R package containing a shiny front-end to augment +the utility of the [`riskmetric`](https://github.com/pharmaR/riskmetric) +package within an organizational context.
-Risk Assessment app +{riskassessment} app
@@ -25,15 +29,12 @@ organizational setting.
-More over, `riskassessment` is an R package containing an interactive -shiny application. It serves as a front end interface to the -[`riskmetric`](https://github.com/pharmaR/riskmetric) R package. If -you’re unfamiliar, `riskmetric` is a framework to quantify an R -package’s “risk” by assessing a number of meaningful metrics designed to -evaluate package development best practices, code documentation, -community engagement, and development sustainability. Together, the -`riskassessment` app and the `riskmetric` package aim to provide some -context for validation within regulated industries. +`riskmetric` is a framework to quantify an R package’s “risk” by +assessing a number of meaningful metrics designed to evaluate package +development best practices, code documentation, community engagement, +and development sustainability. Together, the `riskassessment` app and +the `riskmetric` package aim to provide some context for validation +within regulated industries. The app extends the functionality of `riskmetric` by allowing the reviewer to: @@ -50,7 +51,7 @@ reviewer to: - user authentication with with admin roles to manage users and metric weighting -### Echo-ing `{riskmetric}`’s Approach to Validation +### Echo-ing `{riskmetric}`’s Approach to Validation Validation can serve as an umbrella for various terms, and admittedly, companies will diverge on what is the correct approach to validation. @@ -58,11 +59,16 @@ The validation approach we followed is based on the philosophy of the white paper set forth by the R Validation Hub: [White Paper](https://www.pharmar.org/white-paper/). +*Note:* Development of both `riskassessment` and `riskmetric` were made +possible thanks to the [R Validation +Hub](https://www.pharmar.org/about/), a collaboration to support the +adoption of R within a biopharmaceutical regulatory setting. + ### Usage If you are new to using the `riskassessment` app, welcome! We’d highly encourage you to start exploring the -[`demo verson`](https://rinpharma.shinyapps.io/risk_assessment) of the +[`demo version`](https://rinpharma.shinyapps.io/risk_assessment) of the app currently deployed on shinyapps.io. There, you’ll find a number of pre-loaded packages just waiting to be assessed. Hands on experience will help you become familiar with the general layout of the app as you @@ -75,7 +81,7 @@ latter can add/delete users, download an entire copy of the database, and modify the metric weights used in calculation of risk scores. Initially, both share the same password: `QWERTY1`. If you log in with this credential, the app will immediately prompt you to change your -password and repeat the tje process with your new credentials. +password and repeat the the process with your new credentials. If you want a quick tour through the app (or need assistance getting past the authentication wall), you should watch this short walk through @@ -98,26 +104,34 @@ don’t forget to take it for a spin! #### Installation -For those who are ready to run/deploy this application in their own -environment, we’d recommend the below workflow to install the package. -Note: the `riskassessment` package is not on CRAN yet, but you can -easily install the latest version from GitHub using: +We recommend to run/deploy this application in a controlled development +environment. Of course, you can install the latest version from GitHub +using the code below, but it doesn’t take into consideration other +environment dependencies which means we can’t guarantee stability: ``` r # install.packages("remotes") # if needed +remotes::install_github("pharmaR/riskmetric") remotes::install_github("pharmaR/riskassessment") + +# Run the application +riskassessment::run_app() ``` -With a simple `library(riskassessment)` you can access all the exported -functions from `riskassessment` that help users reproduce analysis -performed in the app. Or, you can create an `app.R` file and launch (or -deploy) the application if you include the following line of code: +Instead, we’d recommend that you clone the repo’s R project locally and +run the following code in order to take advantage of our `renv.lock` +file which set’s up the project dependencies: ``` r -# Run the application -riskassessment::run_app() +# First, clone the repo from Github, then... +# Get dependcies synced using {renv} +renv::activate() +renv::restore() ``` +After this step is complete, you can simply run the contents of `app.R` +to launch and/or deploy the application! + #### Deployments As you might expect, certain deployment environments offer persistent @@ -146,28 +160,4 @@ Since they are are currently in-progress, please explore the user guides that have been developed so far, available on the [documentation site](https://pharmar.github.io/riskassessment/). -### Contributors/Authors - -We would like to thank all the contributors! Specifically, we would like -to thank: - -- [R Validation Hub](https://www.pharmar.org) -- [Aaron Clark](https://www.linkedin.com/in/dataaaronclark/), Biogen, - *Maintainer* -- [Marly Gotti](https://www.marlygotti.com), Previously Biogen -- Robert Krajcik, Cytel -- Jeff Thompson, Cytel -- Maya Gans, Cytel -- Aravind Reddy Kallem -- Fission Labs India Pvt Ltd - -*Note:* This app was made possible thanks to the [R Validation -Hub](https://www.pharmar.org/about/), a collaboration to support the -adoption of R within a biopharmaceutical regulatory setting. - -### License - -Please see the [License](LICENSE.md) file that lives alongside this -repo. -
diff --git a/_pkgdown.yml b/_pkgdown.yml new file mode 100644 index 000000000..7fd728352 --- /dev/null +++ b/_pkgdown.yml @@ -0,0 +1,28 @@ +url: https://pharmar.github.io/riskassessment/ +template: + bootstrap: 5 + +articles: +- title: Getting Started + contents: + - riskassessment +- title: User Guides + navbar: User Guides + desc: Step-by-step tutorials for modules in the application + contents: + - Administrative_Tools_and_Options +- title: Developer Guides + desc: Reference material for those who plan to contribute to the application's code base + contents: + - starts_with("dev") + +reference: +- title: Run app + desc: Run the application locally + contents: + - run_app + - initialize_raa +- title: Use {riskassessment} outside the app + desc: Leverage these functions to mimic analysis performed in the app + contents: + - has_keyword("reproduce") diff --git a/codecov.yml b/codecov.yml new file mode 100644 index 000000000..9ca9bcb25 --- /dev/null +++ b/codecov.yml @@ -0,0 +1,5 @@ + +coverage: + status: + patch: off + project: off diff --git a/data-raw/internal-data.R b/data-raw/internal-data.R index 4f61e7d5a..9d3d50002 100644 --- a/data-raw/internal-data.R +++ b/data-raw/internal-data.R @@ -1,26 +1,15 @@ # Global variables used within the application -app_version <- 'beta' +# app_version <- 'beta' passphrase <- 'somepassphrase' -database_name <- "database.sqlite" -credentials_name <- "credentials.sqlite" +# database_name <- "database.sqlite" +# credentials_name <- "credentials.sqlite" # Overall descriptive text for community usage. Please edit text file to make changes. -community_usage_txt <- readr::read_file(file.path("data-raw", "community.txt")) +community_usage_txt <- readLines(file.path("data-raw", "community.txt")) # Table of community usage descriptions. Please edit the csv file to make changes. -community_usage_tbl <- - DT::datatable( - suppressMessages(readr::read_csv(file.path("data-raw", "community.csv"))), - escape = FALSE, - class = "cell-border", - selection = 'none', - options = list( - sScrollX = "100%", - aLengthMenu = list(c(5, 10, 20, 100,-1), list('5', '10', '20', '100', 'All')), - iDisplayLength = 15 - ) - ) +community_usage_tbl <- read.csv(file.path("data-raw", "community.csv"), stringsAsFactors = FALSE) # Overall descriptive text for maintenance metrics. maintenance_metrics_text <- shiny::HTML("Best practices in software development and @@ -34,35 +23,13 @@ A Risk-based Approach for Assessing R package Accuracy within a Validated Infrastructure.") # Table of maintenance metrics descriptions. Please edit the csv file to make changes. -maintenance_metrics_tbl <- - DT::datatable( - suppressMessages(readr::read_csv(file.path("data-raw", "maintenance.csv"))), - escape = FALSE, - class = "cell-border", - selection = 'none', - options = list( - sScrollX = "100%", - aLengthMenu = list(c(5, 10, 20, 100,-1), list('5', '10', '20', '100', 'All')), - iDisplayLength = 15 - ) -) +maintenance_metrics_tbl <- read.csv(file.path("data-raw", "maintenance.csv"), stringsAsFactors = FALSE) # Overall descriptive text for testing. Please edit text file to make changes. -testing_text <- readr::read_file(file.path("data-raw", "testing.txt")) +testing_text <- readLines(file.path("data-raw", "testing.txt")) # Table of testing descriptions. Please edit the csv file to make changes. -testing_tbl <- - DT::datatable( - readr::read_csv(file.path("data-raw", "testing.csv")), - escape = FALSE, - class = "cell-border", - selection = 'none', - options = list( - sScrollX = "100%", - aLengthMenu = list(c(5, 10, 20, 100,-1), list('5', '10', '20', '100', 'All')), - iDisplayLength = 5 - ) -) +testing_tbl <- read.csv(file.path("data-raw", "testing.csv"), stringsAsFactors = FALSE) # Overall risk calculation text. riskcalc_text <- shiny::HTML("Per the riskmetric package, there @@ -83,12 +50,12 @@ numeric value x standardized weight)") # Upload format template. -template <- readr::read_csv(file.path('data-raw', 'upload_format.csv'), show_col_types = FALSE) +template <- read.csv(file.path('data-raw', 'upload_format.csv'), stringsAsFactors = FALSE) usethis::use_data( - app_version, + # app_version, + # database_name, #credentials_name, passphrase, - database_name, credentials_name, community_usage_txt, community_usage_tbl, maintenance_metrics_text, maintenance_metrics_tbl, testing_text, testing_tbl, diff --git a/dev/001_start.R b/dev/001_start.R index 8d0ebbcf6..6b93f6673 100644 --- a/dev/001_start.R +++ b/dev/001_start.R @@ -34,7 +34,7 @@ usethis::use_description(check_name = F) # author_first_name = "Marly", # Your First Name # author_last_name = "Gotti", # Your Last Name # author_email = c("marly.cormar@biogen.com"), # Your Email -# repo_url = "https://github.com/pharmaR/risk_assessment" # The URL of the GitHub Repo (optional) +# repo_url = "https://github.com/pharmaR/riskassessment" # The URL of the GitHub Repo (optional) # ) # ## Set {golem} options ---- ran @@ -79,13 +79,11 @@ usethis::use_mit_license(copyright_holder = "2020 Fission Labs and R Validation # Packages needed for the app. raa_pkgs = c( "shiny" - ,"shinyhelper" ,"shinyjs" ,"shinydashboard" ,"shinyWidgets" ,"data.table" ,"DT" - ,"readr" ,"lubridate" ,"RSQLite" ,"DBI" @@ -106,7 +104,6 @@ raa_pkgs = c( ,"formattable" ,"rintrojs" ,"shinymanager" - ,"keyring" ) use_package_v <- Vectorize(usethis::use_package) use_package_v(raa_pkgs) @@ -118,6 +115,7 @@ usethis::use_package("glue") usethis::use_dev_package("riskmetric") usethis::use_package("rstudioapi", type = "Suggests") +usethis::use_package("pkgload", type = "Suggests") usethis::use_package("shiny") usethis::use_package("shinymanager") usethis::use_package("shinydashboard") # for box() @@ -126,7 +124,6 @@ usethis::use_package("RSQLite") usethis::use_package("rstudioapi") usethis::use_package("rmarkdown") usethis::use_package("rintrojs") -usethis::use_package("keyring") usethis::use_package("lubridate") usethis::use_package("rvest") usethis::use_package("bslib") @@ -136,7 +133,6 @@ usethis::use_package("config", min_version = "0.3.1") usethis::use_package("golem", min_version = "0.3.3") usethis::use_package("shiny", min_version = "1.7.1") usethis::use_package("riskmetric") -usethis::use_package("tidyr") usethis::use_pipe() diff --git a/dev/02_dev.R b/dev/02_dev.R index 289ddeabc..b18283807 100644 --- a/dev/02_dev.R +++ b/dev/02_dev.R @@ -11,6 +11,9 @@ #### CURRENT FILE: DEV SCRIPT ##### ################################### +# Specify license +usethis::use_mit_license() + # Engineering # ## Dependencies ---- not run @@ -36,7 +39,9 @@ # # usethis::use_package("data.table") # usethis::use_package("gt") # # usethis::use_package("shinyBS") +usethis::use_package("fontawesome", type = "Suggests") # usethis::use_package("knitr", type = "Suggests") +# usethis::use_package("tinytex", type = "Suggests") # usethis::use_package("pkgdown", type = "Suggests")#, min_version = "1.6.1") # usethis::use_package("rlang") # # usethis::use_package("stringi") @@ -54,9 +59,6 @@ # usethis::use_package("dplyr") # usethis::use_package("stringr") # usethis::use_package("purrr") -# usethis::use_package("tidyr") -# # usethis::use_package("tibble") -# # usethis::use_package("magrittr") # usethis::use_package("cicerone") # usethis::use_package("glue") # usethis::use_package("lazyeval",type="Suggests") @@ -66,8 +68,6 @@ # usethis::use_package("ggcorrplot") # usethis::use_pipe() - - # ## Add modules ---- not run. Modules already exist # ## Create a module infrastructure in R/ # ## Only argument is Name of the module @@ -97,7 +97,7 @@ # ## Add helper functions ---- not run, function helper files already exist # ## Creates fct_* and utils_* # -# golem::add_utils( "strObjs" ) # ran +golem::add_utils( "text", module = "introJS" ) # ran # golem::add_utils( "helpers" ) # ran, but Maya still has to uncomment and document her funtions # golem::add_utils( "initialize" ) # @@ -114,11 +114,12 @@ golem::add_fct( "helpers" ) # golem::add_fct( "anova", module = "tableGen" ) # # golem::add_utils("helpers", module = "indvExp" ) -# golem::add_fct( "buildEvents", module = "indvExp" ) # ran: used in modules: indvExpPatEvents & indvExpPatVisits -# golem::add_fct( "organizeEvent", module = "indvExp" ) # ran -# golem::add_fct( "plot", module = "indvExpPatVisits" ) # ran +# golem::add_fct( "buildEvents", module = "indvExp" ) +# golem::add_fct( "organizeEvent", module = "indvExp" ) +# golem::add_fct( "plot", module = "indvExpPatVisits" ) # -# golem::add_utils( "helpers" ) # ran +golem::add_utils( "get_db" ) # ran +golem::add_utils( "insert_db" ) # ran # # # golem::add_fct( "scttr", module = "popExp") #ran # # golem::add_fct( "bxplt", module = "popExp") #ran @@ -142,6 +143,33 @@ golem::add_js_file( "test2" ) golem::add_css_file( "yeti" ) golem::add_css_file( "styles" ) + + +rd_dir_files <- stringr::str_remove(list.files("./man/", pattern = "\\.Rd$"), ".Rd") +Table <- dplyr::as_tibble(data.frame(group = "", fun = rd_dir_files, developer = "", complete = "")) %>% + filter(fun != "riskassessment-package") %>% + mutate(group = dplyr::case_when( + (stringr::str_detect(fun,"UI") | stringr::str_detect(fun,"Server")) & + (stringr::str_detect(tolower(fun),"metric") | + stringr::str_detect(tolower(fun),"comment"))~ "metric modules", + stringr::str_detect(fun,"UI") | stringr::str_detect(fun,"Server") ~ "other modules", + fun %in% c("pipe", "getTimeStamp", "get_date_span", "auto_font", "get_latest_pkg_info", + "build_comm_cards", "build_comm_plotly", "showHelperMessage", "showComments") ~ "util helpers", + stringr::str_detect(fun,"get_") | fun %in% c("dbSelect", "weight_risk_comment") ~ "get db", + stringr::str_detect(fun,"insert_") | stringr::str_detect(tolower(fun),"update") | + fun == "upload_package_to_db" ~ "insert db", + stringr::str_detect(fun,"create_") | + fun %in% c("add_tags", "app_theme", "initialize_raa") ~ "startup", + fun == "run_app" ~ "app", + TRUE ~ group + )) %>% + arrange(group, fun) + +# View(Table) + +knitr::kable(Table) + + ################################################################### # ac golem: Aaron stopped here and pushed code to team on 6/3/2020 ################################################################### @@ -153,14 +181,16 @@ usethis::use_data_raw( name = "adsl", open = FALSE ) # not run. ## Tests ---- not run ## Add one line by test you want to create usethis::use_test( "app" ) +usethis::use_test( "auto_font" ) +usethis::use_test( "generate_comm_data" ) # Documentation -## Vignette ---- notrun -usethis::use_vignette("riskmetric") +## Vignettes +usethis::use_vignette("getting_started") # Before submitting a PR, run this code & update NEWS.md -usethis::use_version("patch") #choices: "dev", "patch", "minor", "major" +usethis::use_version("dev") #choices: "dev", "patch", "minor", "major" # Build pkg, including vignettes. Do this before updating documentation. devtools::build() # calls pkgbuld::build() # X.X MB diff --git a/dev/run_dev.R b/dev/run_dev.R index d09e46a99..47781f601 100644 --- a/dev/run_dev.R +++ b/dev/run_dev.R @@ -10,11 +10,9 @@ golem::detach_all_attached() # Document and reload your package, which runs these three functions... golem::document_and_reload() -# Run the application -run_app() +# Run the application +run_app(pre_auth_user = TRUE) # # turn off any options # options(shiny.autoload.r=NULL) - - diff --git a/docs/ConvertSQLite2MariaDB.Rmd b/docs/ConvertSQLite2MariaDB.Rmd deleted file mode 100644 index 8e31e3f6b..000000000 --- a/docs/ConvertSQLite2MariaDB.Rmd +++ /dev/null @@ -1,254 +0,0 @@ ---- -title: "Convert from SQLite to MariaDB" -author: "Robert Krajcik" -date: "September 3, 2020" -output: - html_document: - theme: cerulean - highlight: pygments - toc: true - toc_float: - collapsed: false - smooth_scroll: false - toc_depth: 2 ---- - -```{r setup, include=FALSE} -knitr::opts_chunk$set(echo = TRUE) -``` - -


- -## Why convert from SQLite? - -Perhaps you want to use a remote storage location multiple users can access the same data intead of each user having their own "silo" on their own laptop or desktop. SQLite does not provide remote storage. - -Take a look at this blog by Dean Attali: -[Persistent Data Storage](https://shiny.rstudio.com/articles/persistent-data-storage.html) - -## Set up MariaDB - -- Download the MariaDB installation software from: -https://go.mariadb.com/download-mariadb-server-community.html
-You should have `mariadb-10.5.4-winx64.msi` in your download folder - -- Next, install (or get IT to install for you) the msi file you downloaded. -(Go into Biogen Access Management and Chat with IT) - -- During installation, set up your root (admin) password and save it. -It will also ask you to choose a port number, the default being 3306. -If you already have MySQL running, you will need to choose another port number. - -- Keep the MariaDB reference guide nearby: -https://mariadb.com/kb/en/documentation/ - -- Go into settings -> Services and check that MariaDB is running
- ![](images/Services.png) - -- Next, start the MariaDB command line client and create a database
- ![](images/MariaDB_CLI.png) - -- Now it's time to create a database. Note the name is case-sensitive.
- type: `CREATE DATABASE mymariadatabase;`
- on the command line. Note the semicolon at the end.
- and then type: `USE mymariadatabase;`
- -- Create a user and grant privileges
- type: `CREATE USER 'rkrajcik'@'localhost' IDENTIFIED BY 'mysqlpassword';`
- type: `GRANT ALL PRIVILEGES ON mymariadatabase.* TO 'rkrajcik'@'localhost';` - -- Databases are created in "C:\\Program Files\\MariaDB 10.5\\data" - -- To remove a database, type: `DROP DATABASE mymariadatabase;` - -## Shiny Modifications. - -- In R, type: `install.packages("RMariaDB")` - -- In `setup.R`, replace `"RSQLite"` with `"RMariaDB"` - And add package "glue" to the bottom of the list if it's not already there. - -- Add add these two lines at the bottom of `setup.R` -```{r, eval = FALSE} -options(shiny.port = 1221) # default port number for shiny -options(shiny.host = '127.0.0.1') # use '127.0.0.1' for local access -``` - -In `utils.R` make the following changes: -```{r, eval = FALSE} -# Stores the database name. -# db_name <- "database.sql" - -db_name <- "mymariadatabase" -db_user <- Sys.getenv("USERNAME") -# db_password <- "mysqlpassword" -db_password <- rstudioapi::askForPassword("Please enter your password") - -db_host <- unlist(unname(options("shiny.host"))) -db_port <- 3703 # port for MariaDB (3306 was used by MySQL) -``` - -Instead of hardcoding the MariaDB user password, I opted to ask for it the first time around and save it. Note the port number for MariaDB defaults to 3306, but I chose 3703 instead as MySQL was using 3306. - -Now for some more changes. - -in the `create_db()` function inside `utils.R` -```{r, eval = FALSE} -# Create a local database. -create_db <- function(){ - - # Create an empty database. - # con <- DBI::dbConnect(RMySQL::MySQL(), db_name) - - con <- DBI::dbConnect(RMariaDB::MariaDB(), user = db_user, - password = db_password, - dbname = db_name, host = db_host, port = db_port) - - alltables = dbListTables(con) # new line - - # create tables if there aren't any yet - if (rlang::is_empty(alltables)) { # new line - - message(glue::glue("No tables defined for {db_name}, Creating them now.")) # new line - - # Set the path to the queries. - path <- file.path("Utils", "sql_queries") - - # Queries needed to run the first time the db is created. - queries <- c( - "create_package_table.sql", - "create_MaintenanceMetrics_table.sql", - "create_CommunityUsageMetrics_table.sql", - "create_TestMetrics_table.sql", - "create_Comments_table.sql" - ) - - # Append path to the queries. - queries <- file.path(path, queries) - - # Apply each query. - sapply(queries, function(x){ - res <- DBI::dbSendStatement( - con, - paste(scan(x, sep = "\n", what = "character"), collapse = "")) - - DBI::dbClearResult(res) - }) - } # New line -- if (rlang::is_empty(alltables)) - - DBI::dbDisconnect(con) -} - -``` - -Now change the code for the `db_fun()` and `db_ins()` functions like this: -```{r, eval = FALSE} - # con <- DBI::dbConnect(RSQLite::SQLite(), db_name) - - con <- DBI::dbConnect(RMariaDB::MariaDB(), user = db_user, password = db_password, - dbname = db_name, host = db_host, port = db_port) -``` - -Again in Utils.R, the Timestamp created is completely non-standard.
-At least using Sys.time() resembles the CURRENT_TIMESTAMP provided in MySQL and MariaDB. -I found that a UTC time value was expected and modified as follows: -```{r, eval=FALSE} -TimeStamp<-function(){ - # Timestamp_intial<-stringr::str_replace(Sys.time()," ", "; ") - # Timestamp<-paste(Timestamp_intial, Sys.timezone()) - # return(Timestamp) - # use something MySQL is expecting to see... - # as.character(Sys.time()) - lubridate::with_tz(Sys.time(), "UTC") # lubridate is a tidyverse package -} -``` -I was able to confirm by going back to the MariaDB Command Line Interface: - ![](images/SelectFromComments.png) - -Finally, update function `genInfo_upload_to_DB()` in `Modules\dbupload.R` as follows: - -```{r, eval = FALSE} -genInfo_upload_to_DB <- function(package_name, ver, title, desc, auth, main, lis, pub) { - tryCatch( - expr = { - # db_ins(paste0( "INSERT or REPLACE INTO package values(", "'", package_name, "',", "'", ver, "',", "'", title ,"'," , "'", desc, "',", - # "'", main, "',", "'", auth, "',", "'", lis, "',", "'", pub, "',", "'',", "''", ")")) - db_ins(paste0( "INSERT INTO package values(", "'", package_name, "',", "'", ver, "',", "'", title ,"'," , "'", desc, "',", - "'", main, "',", "'", auth, "',", "'", lis, "',", "'", pub, "',", "'',", "''", - ") ON DUPLICATE KEY UPDATE package = ", "'", package_name, "'" )) - }, - error = function(e) { - loggit::loggit("ERROR", paste("Error in uploading the general info of the package", package_name, "info", e), app = "fileupload-DB") - } - )# End of try catch - -} # End of the function -``` - - -## Setup the Tables - -SQLite is very forgiving about specifying data types. Not so with either MySQL or MariaDB. - -The easiest way for me to guess what the Types and lengths were needed was to take the SQLite database created and dump it using the sqlite3 utility: `sqlite3 database.sqlite .dump > datadump` - -This is what the SQL statements look like now in `Utils\sql_queries` -Note the `FOREIGN KEY` and `REFERENCES` have been removed. I did not find them necessary. - -```{r, eval=FALSE} -CREATE TABLE IF NOT EXISTS Comments ( -comm_id CHAR(20) NOT NULL, -user_name CHAR(40), -user_role CHAR(40), -comment VARCHAR(1000), -comment_type CHAR(10), -added_on TIMESTAMP -); - -CREATE TABLE IF NOT EXISTS CommunityUsageMetrics ( -cum_id CHAR(20) NOT NULL, -no_of_downloads_last_year INT, -month CHAR(20), -no_of_downloads INT, -ver_release CHAR(5), -position INT, -time_since_first_release INT, -time_since_version_release INT -); - -CREATE TABLE IF NOT EXISTS MaintenanceMetrics ( -mm_id CHAR(20) NOT NULL, -package_has_vignettes CHAR(5), -package_has_news CHAR(5), -news_is_current CHAR(10), -package_has_website VARCHAR(200), -has_bug_reports VARCHAR(200), -has_a_package_maintainer VARCHAR(200), -source_code_is_public VARCHAR(100), -exported_objects_with_documentation VARCHAR(15), -status_of_last_30_reported_bugs CHAR(15) -); - -CREATE TABLE IF NOT EXISTS package( -id INTEGER AUTO_INCREMENT, -name CHAR(20) PRIMARY KEY NOT NULL, -version CHAR(10), -title VARCHAR(200), -description TEXT, -maintainer VARCHAR(200), -author VARCHAR(1000), -license CHAR(50), -published_on CHAR(15), -score CHAR(5), -weigthed_score INT, -decision CHAR(1), -PRIMARY KEY (id) -); - -CREATE TABLE TestMetrics IF NOT EXISTS( -tm_id CHAR(20) NOT NULL, -test_coverage CHAR(10) -); -``` - -Now run the app and build the tables! diff --git a/docs/ConvertSQLite2MariaDB.html b/docs/ConvertSQLite2MariaDB.html deleted file mode 100644 index a5241709c..000000000 --- a/docs/ConvertSQLite2MariaDB.html +++ /dev/null @@ -1,598 +0,0 @@ - - - - - - - - - - - - - - - -Convert from SQLite to MariaDB - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
-
-
-
-
- -
- - - - - - - -




-
-

Why convert from SQLite?

-

Perhaps you want to use a remote storage location multiple users can access the same data intead of each user having their own “silo” on their own laptop or desktop. SQLite does not provide remote storage.

-

Take a look at this blog by Dean Attali: Persistent Data Storage

-
-
-

Set up MariaDB

-
    -
  • Download the MariaDB installation software from: https://go.mariadb.com/download-mariadb-server-community.html
    You should have mariadb-10.5.4-winx64.msi in your download folder

  • -
  • Next, install (or get IT to install for you) the msi file you downloaded. (Go into Biogen Access Management and Chat with IT)

  • -
  • During installation, set up your root (admin) password and save it. It will also ask you to choose a port number, the default being 3306. If you already have MySQL running, you will need to choose another port number.

  • -
  • Keep the MariaDB reference guide nearby: https://mariadb.com/kb/en/documentation/

  • -
  • Go into settings -> Services and check that MariaDB is running

  • -
  • Next, start the MariaDB command line client and create a database

  • -
  • Now it’s time to create a database. Note the name is case-sensitive.
    type: CREATE DATABASE mymariadatabase;
    on the command line. Note the semicolon at the end.
    and then type: USE mymariadatabase;

  • -
  • Create a user and grant privileges
    type: CREATE USER 'rkrajcik'@'localhost' IDENTIFIED BY 'mysqlpassword';
    type: GRANT ALL PRIVILEGES ON mymariadatabase.* TO 'rkrajcik'@'localhost';

  • -
  • Databases are created in “C:\Program Files\MariaDB 10.5\data”

  • -
  • To remove a database, type: DROP DATABASE mymariadatabase;

  • -
-
-
-

Shiny Modifications.

-
    -
  • In R, type: install.packages("RMariaDB")

  • -
  • In setup.R, replace "RSQLite" with "RMariaDB" And add package “glue” to the bottom of the list if it’s not already there.

  • -
  • Add add these two lines at the bottom of setup.R

  • -
-
options(shiny.port = 1221)         # default port number for shiny
-options(shiny.host = '127.0.0.1')  # use '127.0.0.1' for local access
-

In utils.R make the following changes:

-
# Stores the database name.
-# db_name <- "database.sql"
-
-db_name <- "mymariadatabase"
-db_user <- Sys.getenv("USERNAME")
-# db_password <- "mysqlpassword"
-db_password <- rstudioapi::askForPassword("Please enter your password")
-
-db_host <- unlist(unname(options("shiny.host"))) 
-db_port <- 3703  # port for MariaDB (3306 was used by MySQL)
-

Instead of hardcoding the MariaDB user password, I opted to ask for it the first time around and save it. Note the port number for MariaDB defaults to 3306, but I chose 3703 instead as MySQL was using 3306.

-

Now for some more changes.

-

in the create_db() function inside utils.R

-
# Create a local database.
-create_db <- function(){
-  
-  # Create an empty database.
-  # con <- dbConnect(RMySQL::MySQL(), db_name)
-  
-  con <-  dbConnect(RMariaDB::MariaDB(), user = db_user,
-                    password = db_password,
-                    dbname = db_name, host = db_host, port = db_port)
-  
-  alltables = dbListTables(con)  # new line
-  
-  # create tables if there aren't any yet
-  if (is_empty(alltables)) {     # new line
-  
-    message(glue::glue("No tables defined for {db_name}, Creating them now.")) # new line
-    
-    # Set the path to the queries.
-    path <- file.path("Utils", "sql_queries")
-    
-    # Queries needed to run the first time the db is created.
-    queries <- c(
-      "create_package_table.sql",
-      "create_MaintenanceMetrics_table.sql",
-      "create_CommunityUsageMetrics_table.sql",
-      "create_TestMetrics_table.sql",
-      "create_Comments_table.sql"
-    )
-    
-    # Append path to the queries.
-    queries <- file.path(path, queries)
-    
-    # Apply each query.
-    sapply(queries, function(x){
-      res <- dbSendStatement(
-        con,
-        paste(scan(x, sep = "\n", what = "character"), collapse = ""))
-      
-      dbClearResult(res)
-    })
-  } # New line -- if (is_empty(alltables))
-  
-  dbDisconnect(con)
-}
-

Now change the code for the db_fun() and db_ins() functions like this:

-
 # con <- dbConnect(RSQLite::SQLite(), db_name)
- 
-  con <-  dbConnect(RMariaDB::MariaDB(), user = db_user, password = db_password,
-                    dbname = db_name, host = db_host, port = db_port)
-

Again in Utils.R, the Timestamp created is completely non-standard.
At least using Sys.time() resembles the CURRENT_TIMESTAMP provided in MySQL and MariaDB. I found that a UTC time value was expected and modified as follows:

-
TimeStamp<-function(){
-  # Timestamp_intial<-str_replace(Sys.time()," ", "; ")
-  # Timestamp<-paste(Timestamp_intial, Sys.timezone())
-  # return(Timestamp)
-  # use something MySQL is expecting to see...
-  # as.character(Sys.time())
-  lubridate::with_tz(Sys.time(), "UTC")  # lubridate is a tidyverse package
-}
-

I was able to confirm by going back to the MariaDB Command Line Interface:

-

Finally, update function genInfo_upload_to_DB() in Modules\dbupload.R as follows:

-
genInfo_upload_to_DB <- function(package_name, ver, title, desc, auth, main, lis, pub) {
-  tryCatch(
-    expr = {
-      # db_ins(paste0( "INSERT or REPLACE INTO package values(", "'", package_name, "',", "'", ver, "',", "'", title ,"'," , "'", desc, "',",
-      #                "'", main, "',", "'", auth, "',", "'", lis, "',", "'", pub, "',", "'',", "''", ")"))
-      db_ins(paste0( "INSERT INTO package values(", "'", package_name, "',", "'", ver, "',", "'", title ,"'," , "'", desc, "',",
-                     "'", main, "',", "'", auth, "',", "'", lis, "',", "'", pub, "',", "'',", "''", 
-                     ") ON DUPLICATE KEY UPDATE package = ", "'", package_name, "'" ))
-    },
-    error = function(e) {
-      loggit("ERROR", paste("Error in uploading the general info of the package", package_name, "info", e), app = "fileupload-DB")
-    }
-  )# End of try catch 
-
-} # End of the function
-
-
-

Setup the Tables

-

SQLite is very forgiving about specifying data types. Not so with either MySQL or MariaDB.

-

The easiest way for me to guess what the Types and lengths were needed was to take the SQLite database created and dump it using the sqlite3 utility: sqlite3 database.sqlite .dump > datadump

-

This is what the SQL statements look like now in Utils\sql_queries Note the FOREIGN KEY and REFERENCES have been removed. I did not find them necessary.

-
CREATE TABLE IF NOT EXISTS Comments (
-comm_id      CHAR(20) NOT NULL,    
-user_name    CHAR(40),   
-user_role    CHAR(40),   
-comment          VARCHAR(1000),   
-comment_type CHAR(10),   
-added_on     TIMESTAMP
-); 
-
-CREATE TABLE IF NOT EXISTS CommunityUsageMetrics (
-cum_id                              CHAR(20) NOT NULL,   
-no_of_downloads_last_year   INT,  
-month                               CHAR(20),  
-no_of_downloads                   INT,  
-ver_release                         CHAR(5),  
-position                              INT,  
-time_since_first_release    INT,  
-time_since_version_release  INT   
-); 
-
-CREATE TABLE IF NOT EXISTS MaintenanceMetrics (
-mm_id                                                CHAR(20) NOT NULL,    
-package_has_vignettes                        CHAR(5),   
-package_has_news                     CHAR(5),   
-news_is_current                              CHAR(10),   
-package_has_website                        VARCHAR(200),   
-has_bug_reports                              VARCHAR(200),   
-has_a_package_maintainer                   VARCHAR(200),   
-source_code_is_public                        VARCHAR(100),   
-exported_objects_with_documentation  VARCHAR(15),   
-status_of_last_30_reported_bugs        CHAR(15) 
-); 
-
-CREATE TABLE IF NOT EXISTS package(
-id             INTEGER AUTO_INCREMENT,
-name           CHAR(20) PRIMARY KEY NOT NULL,
-version        CHAR(10),   
-title          VARCHAR(200),   
-description    TEXT,   
-maintainer     VARCHAR(200),   
-author         VARCHAR(1000),   
-license        CHAR(50),   
-published_on   CHAR(15),   
-score          CHAR(5),
-weigthed_score INT,
-decision       CHAR(1),
-PRIMARY KEY (id)
-); 
-
-CREATE TABLE TestMetrics IF NOT EXISTS(
-tm_id           CHAR(20) NOT NULL,    
-test_coverage CHAR(10)  
-); 
-

Now run the app and build the tables!

-
- - - -
-
- -
- - - - - - - - - - - - - - - - diff --git a/docs/ConvertSQLite2MySQL.Rmd b/docs/ConvertSQLite2MySQL.Rmd deleted file mode 100644 index 3f3844f21..000000000 --- a/docs/ConvertSQLite2MySQL.Rmd +++ /dev/null @@ -1,206 +0,0 @@ ---- -title: "Converting from SQLite to MySQL" -author: "Robert Krajcik" -date: "September 2, 2020" -output: - html_document: - theme: cerulean - highlight: pygments - toc: true - toc_float: - collapsed: false - smooth_scroll: false - toc_depth: 2 ---- - -```{r setup, include=FALSE} -knitr::opts_chunk$set(echo = TRUE) -``` - -


- -## Why change? - -Perhaps you want to use a remote storage location multiple users can access the same data intead of each user having their own "silo" on their own laptop or desktop. - -Take a look at this blog by Dean Attali: -[Persistent Data Storage](https://shiny.rstudio.com/articles/persistent-data-storage.html) - -## Set up MySQL - -- Download the MySQL software from MYSQL Community Downloads: -https://dev.mysql.com/downloads/mysql/5.5.html?os=3&version=5 - -- Next, install (or get IT to install for you) the msi file you downloaded: -`mysql-installer-web-community-8.0.21.0.msi` - -- During installation, set up your root (admin) and user passwords and save them. - -- The MySQL reference guide is your friend. Keep it handy: -https://dev.mysql.com/doc/refman/8.0/en/ - -- Next, start the MySQL command line client and create a database
- ![](images/MySQL_CLC.png) - -- Now it's time to create a database. Note the name is case-sensitive.
- type: `CREATE DATABASE mysqldatabase;`
- on the command line. Note the semicolon at the end.
- and then type: `USE mysqldatabase;`
- to select it.
- - ![](images/CommandLine.png)
- -- Databases are created in "C:\\ProgramData\\MySQL\\MySQL Server 8.0\\Data" - -- To remove a database, type: `DROP DATABASE mysqldatabase;` - -## Shiny Modifications - -- In R, type: `install.packages("RMySQL")` - -- In `setup.R`, replace `"RSQLite"` with `"RMySQL"` - -- Add add these two lines at the bottom of `setup.R` -```{r, eval = FALSE} -options(shiny.port = 1221) # default port number for shiny -options(shiny.host = '127.0.0.1') # use '127.0.0.1' for local access -``` - -In `utils.R` make the following changes: -```{r, eval = FALSE} -# Stores the database name. -# db_name <- "database.sql" - -db_name <- "mysqldatabase" -db_user <- Sys.getenv("USERNAME") -# db_password <- "mysqlpassword" -db_password <- rstudioapi::askForPassword("Please enter your password") - -db_host <- unlist(unname(options("shiny.host"))) -db_port <- 3306 # port for mysql -``` -Instead of hardcoding the MySQL user password, I opted to ask for it the first time around and save it. Note the port number for MySQL is 3306. - -Now for some more changes. -in the `create_db()` function inside `utils.R` -```{r, eval = FALSE} -# Create a local database. -create_db <- function(){ - - # Create an empty database. - # con <- DBI::dbConnect(RMySQL::MySQL(), db_name) - - con <- DBI::dbConnect(RMySQL::MySQL(), user = db_user, - password = db_password, - dbname = db_name, host = db_host, port = db_port) - - alltables = dbListTables(con) - - # create tables if there aren't any yet - if (rlang::is_empty(alltables)) { - - # Set the path to the queries. - ... # code omitted - - DBI::dbClearResult(res) - }) - } # if (rlang::is_empty(alltables)) - - DBI::dbDisconnect(con) -} -``` - -Now change the code for the `db_fun()` and `db_ins()` functions like this: -```{r, eval = FALSE} - # con <- DBI::dbConnect(RSQLite::SQLite(), db_name) - - con <- DBI::dbConnect(RMySQL::MySQL(), user = db_user, password = db_password, - dbname = db_name, host = db_host, port = db_port) -``` - -One more change. Again in Utils.R The Timestamp created is completely non-standard.
-At least using Sys.time() resembles the CURRENT_TIMESTAMP provided in MySQL. -```{r, eval=FALSE} -TimeStamp<-function(){ - # Timestamp_intial<-stringr::str_replace(Sys.time()," ", "; ") - # Timestamp<-paste(Timestamp_intial, Sys.timezone()) - # return(Timestamp) - # use something MySQL is expecting to see... - Sys.time() -} -``` - -Now I am seeing typecasting warnings from specifying a timestamp type. - `unrecognized MySQL field type 7 in column 3 imported as character`
-But I understand that MariaDB doesn't have this issue. - -## Setup the Tables - -SQLite is very forgiving about specifying data types. Not so with MySQL. - -The easiest way for me to guess what the Types and lengths should be was to take the SQLite database created and dump it using the sqlite3 utility: - -`sqlite3 database.sqlite .dump > datadump` - -This is what the SQL statements look like now in `Utils\sql_queries` -Note the `FOREIGN KEY` and `REFERENCES` have been removed. I did not find them necessary. - -```{r, eval=FALSE} -CREATE TABLE IF NOT EXISTS Comments ( -comm_id CHAR(20) NOT NULL, -user_name CHAR(40), -user_role CHAR(40), -comment VARCHAR(1000), -comment_type CHAR(10), -added_on TIMESTAMP -); - -CREATE TABLE IF NOT EXISTS CommunityUsageMetrics ( -cum_id CHAR(20) NOT NULL, -no_of_downloads_last_year INT, -month CHAR(20), -no_of_downloads INT, -ver_release CHAR(5), -position INT, -time_since_first_release INT, -time_since_version_release INT -); - -CREATE TABLE IF NOT EXISTS MaintenanceMetrics ( -mm_id CHAR(20) NOT NULL, -package_has_vignettes CHAR(5), -package_has_news CHAR(5), -news_is_current CHAR(10), -package_has_website VARCHAR(200), -has_bug_reports VARCHAR(200), -has_a_package_maintainer VARCHAR(200), -source_code_is_public VARCHAR(100), -exported_objects_with_documentation VARCHAR(15), -status_of_last_30_reported_bugs CHAR(15) -); - -CREATE TABLE IF NOT EXISTS package( -id INTEGER AUTO_INCREMENT, -name CHAR(20) PRIMARY KEY NOT NULL, -version CHAR(10), -title VARCHAR(200), -description TEXT, -maintainer VARCHAR(200), -author VARCHAR(1000), -license CHAR(50), -published_on CHAR(15), -score CHAR(5), -weigthed_score INT, -decision CHAR(1), -PRIMARY KEY (id) -); - -CREATE TABLE TestMetrics IF NOT EXISTS( -tm_id CHAR(20) NOT NULL, -test_coverage CHAR(10) -); -``` - - - - diff --git a/docs/ConvertSQLite2MySQL.html b/docs/ConvertSQLite2MySQL.html deleted file mode 100644 index 079ccb73d..000000000 --- a/docs/ConvertSQLite2MySQL.html +++ /dev/null @@ -1,559 +0,0 @@ - - - - - - - - - - - - - - - -Converting from SQLite to MySQL - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
-
-
-
-
- -
- - - - - - - -




-
-

Why change?

-

Perhaps you want to use a remote storage location multiple users can access the same data intead of each user having their own “silo” on their own laptop or desktop.

-

Take a look at this blog by Dean Attali: Persistent Data Storage

-
-
-

Set up MySQL

-
    -
  • Download the MySQL software from MYSQL Community Downloads: https://dev.mysql.com/downloads/mysql/5.5.html?os=3&version=5

  • -
  • Next, install (or get IT to install for you) the msi file you downloaded: mysql-installer-web-community-8.0.21.0.msi

  • -
  • During installation, set up your root (admin) and user passwords and save them.

  • -
  • The MySQL reference guide is your friend. Keep it handy: https://dev.mysql.com/doc/refman/8.0/en/

  • -
  • Next, start the MySQL command line client and create a database

  • -
  • Now it’s time to create a database. Note the name is case-sensitive.
    type: CREATE DATABASE mysqldatabase;
    on the command line. Note the semicolon at the end.
    and then type: USE mysqldatabase;
    to select it.

    -


  • -
  • Databases are created in “C:\ProgramData\MySQL\MySQL Server 8.0\Data”

  • -
  • To remove a database, type: DROP DATABASE mysqldatabase;

  • -
-
-
-

Shiny Modifications

-
    -
  • In R, type: install.packages("RMySQL")

  • -
  • In setup.R, replace "RSQLite" with "RMySQL"

  • -
  • Add add these two lines at the bottom of setup.R

  • -
-
options(shiny.port = 1221)         # default port number for shiny
-options(shiny.host = '127.0.0.1')  # use '127.0.0.1' for local access
-

In utils.R make the following changes:

-
# Stores the database name.
-# db_name <- "database.sql"
-
-db_name <- "mysqldatabase"
-db_user <- Sys.getenv("USERNAME")
-# db_password <- "mysqlpassword"
-db_password <- rstudioapi::askForPassword("Please enter your password")
-
-db_host <- unlist(unname(options("shiny.host"))) 
-db_port <- 3306  # port for mysql
-

Instead of hardcoding the MySQL user password, I opted to ask for it the first time around and save it. Note the port number for MySQL is 3306.

-

Now for some more changes. in the create_db() function inside utils.R

-
# Create a local database.
-create_db <- function(){
-  
-  # Create an empty database.
-  # con <- dbConnect(RMySQL::MySQL(), db_name)
-
-  con <-  dbConnect(RMySQL::MySQL(), user = db_user,
-                    password = db_password,
-                    dbname = db_name, host = db_host, port = db_port)
-  
-  alltables = dbListTables(con)
-  
-  # create tables if there aren't any yet
-  if (is_empty(alltables)) {
-    
-  # Set the path to the queries.
-  ...  # code omitted
-    
-    dbClearResult(res)
-  })
-  } # if (is_empty(alltables))
-  
-  dbDisconnect(con)
-}
-

Now change the code for the db_fun() and db_ins() functions like this:

-
 # con <- dbConnect(RSQLite::SQLite(), db_name)
- 
-  con <-  dbConnect(RMySQL::MySQL(), user = db_user, password = db_password,
-                    dbname = db_name, host = db_host, port = db_port)
-

One more change. Again in Utils.R The Timestamp created is completely non-standard.
At least using Sys.time() resembles the CURRENT_TIMESTAMP provided in MySQL.

-
TimeStamp<-function(){
-  # Timestamp_intial<-str_replace(Sys.time()," ", "; ")
-  # Timestamp<-paste(Timestamp_intial, Sys.timezone())
-  # return(Timestamp)
-  # use something MySQL is expecting to see...
-  Sys.time()
-}
-

Now I am seeing typecasting warnings from specifying a timestamp type. unrecognized MySQL field type 7 in column 3 imported as character
But I understand that MariaDB doesn’t have this issue.

-
-
-

Setup the Tables

-

SQLite is very forgiving about specifying data types. Not so with MySQL.

-

The easiest way for me to guess what the Types and lengths should be was to take the SQLite database created and dump it using the sqlite3 utility:

-

sqlite3 database.sqlite .dump > datadump

-

This is what the SQL statements look like now in Utils\sql_queries Note the FOREIGN KEY and REFERENCES have been removed. I did not find them necessary.

-
CREATE TABLE IF NOT EXISTS Comments (   
-comm_id      CHAR(20) NOT NULL,    
-user_name    CHAR(40),   
-user_role    CHAR(40),   
-comment          VARCHAR(1000),   
-comment_type CHAR(10),   
-added_on     TIMESTAMP
-); 
-
-CREATE TABLE IF NOT EXISTS CommunityUsageMetrics (  
-cum_id                              CHAR(20) NOT NULL,   
-no_of_downloads_last_year   INT,  
-month                               CHAR(20),  
-no_of_downloads                   INT,  
-ver_release                         CHAR(5),  
-position                              INT,  
-time_since_first_release    INT,  
-time_since_version_release  INT   
-); 
-
-CREATE TABLE IF NOT EXISTS MaintenanceMetrics (   
-mm_id                                                CHAR(20) NOT NULL,    
-package_has_vignettes                        CHAR(5),   
-package_has_news                     CHAR(5),   
-news_is_current                              CHAR(10),   
-package_has_website                        VARCHAR(200),   
-has_bug_reports                              VARCHAR(200),   
-has_a_package_maintainer                   VARCHAR(200),   
-source_code_is_public                        VARCHAR(100),   
-exported_objects_with_documentation  VARCHAR(15),   
-status_of_last_30_reported_bugs        CHAR(15) 
-); 
-
-CREATE TABLE IF NOT EXISTS package(
-id             INTEGER AUTO_INCREMENT,
-name           CHAR(20) PRIMARY KEY NOT NULL,
-version        CHAR(10),   
-title          VARCHAR(200),   
-description    TEXT,   
-maintainer     VARCHAR(200),   
-author         VARCHAR(1000),   
-license        CHAR(50),   
-published_on   CHAR(15),   
-score          CHAR(5),
-weigthed_score INT,
-decision       CHAR(1),
-PRIMARY KEY (id)
-); 
-
-CREATE TABLE TestMetrics IF NOT EXISTS(   
-tm_id           CHAR(20) NOT NULL,    
-test_coverage CHAR(10)  
-); 
-
- - - -
-
- -
- - - - - - - - - - - - - - - - diff --git a/docs/Managing_Userids_and_Passwords.Rmd b/docs/Managing_Userids_and_Passwords.Rmd deleted file mode 100644 index 665c6bd1a..000000000 --- a/docs/Managing_Userids_and_Passwords.Rmd +++ /dev/null @@ -1,221 +0,0 @@ ---- -title: "Managing User IDs and Passwords" -author: "Robert Krajcik" -date: "`r format(Sys.time(), '%d %B, %Y')`" -output: - html_document: - theme: cerulean - highlight: pygments - toc: true - toc_float: - collapsed: false - smooth_scroll: false - toc_depth: 3 ---- - -```{r setup, include=FALSE} -# Load packages. -library(fontawesome) - -knitr::opts_chunk$set(echo = TRUE) -``` - -


- -## Introduction - -This guide will help you set up users and credentials for the Risk Assessment App. Some of these instructions apply only to the first time the app is run while others are for any time new users need to be added. - -## First time running the app - -### Keyring password - -The first time the application is run (and only then), a prompt will ask you to create a keyring password. - -
- -![](images/create_keyring.png){width=400px style="margin: 10px 0 10px 0"} - -
- -The keyring password entered here will allow a user to view/retrieve username and password values from the credentials database at a later time. As such, it is extremely important to store it in a safe place. - -### Default user - -After creating the keyring password, the login prompt appears. The app is initially set up with one username, **admin**, and a default password of **qwerty**. Type in these credentials (as seen below) to login with administrator authority. - -
- -![](images/initial_authentication_page.png){width=400px style="margin: 10px 0 10px 0"} - -
- -The user will be immediately prompted to change the password for the **admin** username: - -
- -![](images/change_password.png){width=400px style="margin: 10px 0 10px 0"} - -
- -
- -## Administrator mode - -Only users with administrator privileges can add/delete/modify user accounts. To verify you have access to the administrator mode, hover your cursor over the plus `r fa("plus")` symbol in the bottom-right corner of the app. Upon clicking, additional options should appear. If present, the Administrator mode button will appear on top, as seen below. - -
- -![](images/admin_mode_button.png){width=750px style="margin: 10px 0 10px 0"} - -
- -This button will not be appear for non-admin users. - -
- -
- -### Adding users - -Two tables are presented. The first one is used to manage users, and the second one to manage passwords. - -
- -![](images/admin_mode_tables.png){width=750px} - -
- -
- -Now would be a good time to add users! At the top of the **Users** table, click the long blue button labelled: "Add a user". - -
- -![](images/add_user_bar.png){width=750px} - -
- -
- -A prompt will appear where you can specify a user name and **optional** start & expire dates which by default are set at today's date (more on those later). A check box to grant the new user administrator authority is also checked by default. A custom password is generated which requires changing the first time the new user logs in. Here, we'll type in a example user name "PeterParker". - -
- -![](images/add_user.png){width=750px} - -
- -
- -Upon submission, a confirmation message will appear, so you can notify the user and send them his/her temporary password.
- -
- -![](images/new_user_msg.png) - -
- -## User `start` and `expire` dates - -If the **start** date is set to a future date or the **expire** date is set to *before* today's date, an "account expired" message will appear, and the log in attempt will fail. - -
- -As an administrator, you can set either or both of these dates or just leave -them blank. - -
- -![](images/account_expired_msg.png){width=400px} - -
- -
- -## Managing users - -The first table allows adding, editing, and deleting users. - -
- -![](images/users_table.png){width=750px} - -
- -
- -### Edit current user - -Edit a user information by clicking on the blue *edit* button, found on the right-hand side of the table. - -
- -### Delete a user - -Delete any user by clicking on the red *remove* button, also on the right-hand side of the table. - -
- - -## Replace initial `Admin` user - -As an administrator, it's recommended you replace your initial `admin` user ID with one unique to you. Note that there must always be at least one admin user, so **you cannot delete yourself** at first. If you want to delete the initial `admin` user you will need to create another user ID first with administrative privileges, as described below. - - -Click the blue "Add a user" button and make sure to check the `Admin` box. The temporary password can be overridden by un-checking the "ask to change password" box. - -
- -
- -![](images/new_admin.png) -
- -
- -After completing the form, sign in using your new credentials and delete the original `admin` user by clicking the red remove button. - -
- - -## Password management - -The second table allows for password management. - -
- -![](images/password_table.png) - -
- -Click on the blue *Change password* button to force -corresponding user to change his/her password on the next log-in. - -Click on the orange *Reset password* button to generate a temporary password. You are responsible for delivering such new password -to the user. - -
- -### Additional column definitions - -- Must change column: Indicates whether the user has to change his/her password -next log-in. -- Have changed column: Indicates the user has already changed his/her password. -- Date change column: Indicates the date the password was updated. - -
- -## Have an issue? - -That's all for the tutorial. If you have any issues or feature requests as it pertains to managing user IDs and passwords in the app, please open a new issue on our [Github repo](https://github.com/pharmaR/risk_assessment/issues). Merry managing! - - - -
- -
- -
- -
diff --git a/docs/Managing_Userids_and_Passwords.html b/docs/Managing_Userids_and_Passwords.html deleted file mode 100644 index 7da2511b4..000000000 --- a/docs/Managing_Userids_and_Passwords.html +++ /dev/null @@ -1,449 +0,0 @@ - - - - - - - - - - - - - - -Managing User IDs and Passwords - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - -
-
-
-
-
- -
- - - - - - - -




-
-

Introduction

-

This guide will help you set up users and credentials for the Risk Assessment App. Some of these instructions apply only to the first time the app is run while others are for any time new users need to be added.

-
-
-

First time running the app

-
-

Keyring password

-

The first time the application is run (and only then), a prompt will ask you to create a keyring password.

-
-

-
-

The keyring password entered here will allow a user to view/retrieve username and password values from the credentials database at a later time. As such, it is extremely important to store it in a safe place.

-
-
-

Default user

-

After creating the keyring password, the login prompt appears. The app is initially set up with one username, admin, and a default password of qwerty. Type in these credentials (as seen below) to login with administrator authority.

-
-

-
-

The user will be immediately prompted to change the password for the admin username:

-
-

-
-


-
-
-
-

Administrator mode

-

Only users with administrator privileges can add/delete/modify user accounts. To verify you have access to the administrator mode, hover your cursor over the plus symbol in the bottom-right corner of the app. Upon clicking, additional options should appear. If present, the Administrator mode button will appear on top, as seen below.

-
-

-
-

This button will not be appear for non-admin users.

-


-


-
-

Adding users

-

Two tables are presented. The first one is used to manage users, and the second one to manage passwords.

-
-

-
-


-

Now would be a good time to add users! At the top of the Users table, click the long blue button labelled: “Add a user”.

-
-

-
-


-

A prompt will appear where you can specify a user name and optional start & expire dates which by default are set at today’s date (more on those later). A check box to grant the new user administrator authority is also checked by default. A custom password is generated which requires changing the first time the new user logs in. Here, we’ll type in a example user name “PeterParker”.

-
-

-
-


-

Upon submission, a confirmation message will appear, so you can notify the user and send them his/her temporary password.

-
-

-
-
-
-
-

User start and expire dates

-

If the start date is set to a future date or the expire date is set to before today’s date, an “account expired” message will appear, and the log in attempt will fail.

-


-

As an administrator, you can set either or both of these dates or just leave them blank.

-
-

-


-
-
-
-

Managing users

-

The first table allows adding, editing, and deleting users.

-
-

-
-


-
-

Edit current user

-

Edit a user information by clicking on the blue edit button, found on the right-hand side of the table.

-


-
-
-

Delete a user

-

Delete any user by clicking on the red remove button, also on the right-hand side of the table.

-


-
-
-
-

Replace initial Admin user

-

As an administrator, it’s recommended you replace your initial admin user ID with one unique to you. Note that there must always be at least one admin user, so you cannot delete yourself at first. If you want to delete the initial admin user you will need to create another user ID first with administrative privileges, as described below.

-

Click the blue “Add a user” button and make sure to check the Admin box. The temporary password can be overridden by un-checking the “ask to change password” box.

-


-
- -
-


-

After completing the form, sign in using your new credentials and delete the original admin user by clicking the red remove button.

-


-
-
-

Password management

-

The second table allows for password management.

-
-

-
-

Click on the blue Change password button to force corresponding user to change his/her password on the next log-in.

-

Click on the orange Reset password button to generate a temporary password. You are responsible for delivering such new password to the user.

-


-
-

Additional column definitions

-
    -
  • Must change column: Indicates whether the user has to change his/her password next log-in.
  • -
  • Have changed column: Indicates the user has already changed his/her password.
  • -
  • Date change column: Indicates the date the password was updated.
  • -
-


-
-
-
-

Have an issue?

-

That’s all for the tutorial. If you have any issues or feature requests as it pertains to managing user IDs and passwords in the app, please open a new issue on our Github repo. Merry managing!

-


-


-


-


-
- - - -
-
- -
- - - - - - - - - - - - - - - - diff --git a/docs/Using_SQLite_Command_Line.html b/docs/Using_SQLite_Command_Line.html deleted file mode 100644 index d48359c2b..000000000 --- a/docs/Using_SQLite_Command_Line.html +++ /dev/null @@ -1,416 +0,0 @@ - - - - - - - - - - - - - -Using SQLite Command Line - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - - - -
-

About SQLite

-

SQLite is a software library that provides a relational database management system. The lite in SQLite means lightweight in terms of setup, database administration, and required resources.

-

SQLite has the following noticeable features: self-contained, serverless, zero-configuration, transactional.

-

For more information, see What is SQLite

-
-
-

Why SQLite?

-

For one obvious reason – all the Risk Assessment App data is stored in a SQLite database. Also, one of SQLite’s advantages is that it can run nearly anywhere. This vignette will provide you with the means of accessing the database outside of the Risk Assessment App.

-
-
-

Download SQLite tools

-

Open the download page SQLite Download Page

-

To work with SQLite on Windows,
you download the command-line shell program as shown in the screenshot below.

-


If you are using a Mac,
you need to download this one:

In either case, the downloaded file is in ZIP format and its size is quite small.

-
-
-

Run SQLite tools

-

Installing SQLite is simple and straightforward.

-

Create a new folder e.g., C:\sqlite (No IT support is needed).

-

Extract the content of the .zip file that you downloaded in the previous section to the C:\sqlite folder. You should see three programs as shown below:

-



-
-
-

Open the command line window.

-

On Windows, type “cmd” in the search bar.

-



-
- -
-

Command Line Shell

-

You can also temporarily add C:\sqlite to the Windows path.

-

set PATH=%PATH%;C:\sqlite

-

Verify by typing

-

echo %PATH%

-

Then when you are in the risk_assessment directory, you can just enter the following on the command line:

-

sqlite3 database.sqlite and then you will see

-
SQLite version 3.33.0 2020-08-14 13:23:32
-Enter ".help" for usage hints.
-sqlite> 
-

You can also use the system2 command to execute SQLite commands on the RStudio command line.

-
> system2("C:/sqlite/sqlite3", args =c("database.sqlite", ".tables", ".quit"))
-comments                 metric                   package_metrics        
-community_usage_metrics  package     
-

And you can build queries or commands for SQLite and execute them.

-
> table_name <- "package"
-> query <- glue::glue("select * from { table_name } limit 1;")
-> frst_row <- system2("C:/sqlite/sqlite3", args ="database.sqlite", input = query, stdout = TRUE)
-> 
-> frst_row
-[1] "1|glue|1.6.2|glue: Interpreted String Literals|An implementation of interpreted string literals, inspired by   Pythons Literal String Interpolation   <https://www.python.org/dev/peps/pep-0498/> and Docstrings   <https://www.python.org/dev/peps/pep-0257/> and Julias Triple-Quoted   String Literals   <https://docs.julialang.org/en/v1.3/manual/strings/#Triple-Quoted-String-Literals-1>.|Jennifer Bryan  <jenny at rstudio.com>|Jim Hester  [aut], Jennifer Bryan    [aut, cre], RStudio [cph, fnd]|MIT + file LICENSE|2022-02-24|0.11|||2022-02-24"
-

For more info, see Command Line Shell for SQLite

-



-
-
-

SQLiteStudio

-

The SQLiteStudio tool is a free GUI tool for managing SQLite databases. It is free, portable, intuitive, and cross-platform. SQLite tool also provides some of the most important features to work with SQLite databases such as importing, exporting data in various formats including CSV, XML, and JSON.

-

Visit SQLite Studio

-

You can download the SQLiteStudio installer or its portable version by visiting the download page. Then, you can extract (or install) the download file to a folder e.g., C: and launch it.

-

The following picture illustrates how to launch the SQLiteStudio:

-

-
- - - - -
- - - - - - - - - - - - - - - diff --git a/docs/images/CommandLine.png b/docs/images/CommandLine.png deleted file mode 100644 index 3aade0811..000000000 Binary files a/docs/images/CommandLine.png and /dev/null differ diff --git a/docs/images/Command_Prompt.png b/docs/images/Command_Prompt.png deleted file mode 100644 index 4c3e3ff02..000000000 Binary files a/docs/images/Command_Prompt.png and /dev/null differ diff --git a/docs/images/MariaDB_CLI.png b/docs/images/MariaDB_CLI.png deleted file mode 100644 index dd8f6dea5..000000000 Binary files a/docs/images/MariaDB_CLI.png and /dev/null differ diff --git a/docs/images/MySQL_CLC.png b/docs/images/MySQL_CLC.png deleted file mode 100644 index cf07f6865..000000000 Binary files a/docs/images/MySQL_CLC.png and /dev/null differ diff --git a/docs/images/SQLiteStudio.png b/docs/images/SQLiteStudio.png deleted file mode 100644 index b70642569..000000000 Binary files a/docs/images/SQLiteStudio.png and /dev/null differ diff --git a/docs/images/SQLite_Precompiled_Binaries_Mac.png b/docs/images/SQLite_Precompiled_Binaries_Mac.png deleted file mode 100644 index 070959401..000000000 Binary files a/docs/images/SQLite_Precompiled_Binaries_Mac.png and /dev/null differ diff --git a/docs/images/SQLite_Precompiled_Binaries_Win.png b/docs/images/SQLite_Precompiled_Binaries_Win.png deleted file mode 100644 index 46866590b..000000000 Binary files a/docs/images/SQLite_Precompiled_Binaries_Win.png and /dev/null differ diff --git a/docs/images/SQLite_files.png b/docs/images/SQLite_files.png deleted file mode 100644 index b36d76bfe..000000000 Binary files a/docs/images/SQLite_files.png and /dev/null differ diff --git a/docs/images/SelectFromComments.png b/docs/images/SelectFromComments.png deleted file mode 100644 index c667b69bc..000000000 Binary files a/docs/images/SelectFromComments.png and /dev/null differ diff --git a/docs/images/Services.png b/docs/images/Services.png deleted file mode 100644 index de7c9b9e9..000000000 Binary files a/docs/images/Services.png and /dev/null differ diff --git a/docs/images/account_expired_msg.png b/docs/images/account_expired_msg.png deleted file mode 100644 index 2372972c5..000000000 Binary files a/docs/images/account_expired_msg.png and /dev/null differ diff --git a/docs/images/add_user.png b/docs/images/add_user.png deleted file mode 100644 index caa5a831f..000000000 Binary files a/docs/images/add_user.png and /dev/null differ diff --git a/docs/images/add_user_bar.png b/docs/images/add_user_bar.png deleted file mode 100644 index 63efbc0fe..000000000 Binary files a/docs/images/add_user_bar.png and /dev/null differ diff --git a/docs/images/add_user_old.png b/docs/images/add_user_old.png deleted file mode 100644 index 5ffc42ff4..000000000 Binary files a/docs/images/add_user_old.png and /dev/null differ diff --git a/docs/images/admin_mode_button.png b/docs/images/admin_mode_button.png deleted file mode 100644 index 9e4163955..000000000 Binary files a/docs/images/admin_mode_button.png and /dev/null differ diff --git a/docs/images/admin_mode_tables.png b/docs/images/admin_mode_tables.png deleted file mode 100644 index 7d60fbf2e..000000000 Binary files a/docs/images/admin_mode_tables.png and /dev/null differ diff --git a/docs/images/authentication_page.png b/docs/images/authentication_page.png deleted file mode 100644 index ae495d0e7..000000000 Binary files a/docs/images/authentication_page.png and /dev/null differ diff --git a/docs/images/bottom_right.png b/docs/images/bottom_right.png deleted file mode 100644 index 315802f87..000000000 Binary files a/docs/images/bottom_right.png and /dev/null differ diff --git a/docs/images/create_keyring.png b/docs/images/create_keyring.png deleted file mode 100644 index 170e112c3..000000000 Binary files a/docs/images/create_keyring.png and /dev/null differ diff --git a/docs/images/new_admin.png b/docs/images/new_admin.png deleted file mode 100644 index e094b5921..000000000 Binary files a/docs/images/new_admin.png and /dev/null differ diff --git a/docs/images/password_success.png b/docs/images/password_success.png deleted file mode 100644 index ffd436b77..000000000 Binary files a/docs/images/password_success.png and /dev/null differ diff --git a/docs/images/password_table.png b/docs/images/password_table.png deleted file mode 100644 index 3cddad70e..000000000 Binary files a/docs/images/password_table.png and /dev/null differ diff --git a/docs/images/users_table.png b/docs/images/users_table.png deleted file mode 100644 index 964c1b7dc..000000000 Binary files a/docs/images/users_table.png and /dev/null differ diff --git a/inst/WORDLIST b/inst/WORDLIST index 91170be19..2c8e5df81 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,5 +1,76 @@ -Cytel +Aravind +CMD +Devs +Imran +JSON Lifecycle +MetricBox +Munshi +PR's +PeterParker +RSPM +RStudio +Reddy +Reweighting +Rstudio +SQLiteStudio +ShinyProxy +Sys +UI +Userids +addComment +admin’ +arg +auth biopharmaceutical +bs +bslib's +cmd +databse +dev +docx +dropdown +env +eproducible +fontawesome +funder +getTimeStamp +github +golem +gui +ing +introJS +introjs +io +ironments +labelled +lockfile +macOS +nonadmin +nonadmin’ +onboarding +packagization +param +pharmar +pkgs +plotly +pre +px +renv repo +repo's +repo’s riskmetric +serverless +shinyapps +showComments +showHelperMessage +sqlite +tibble +transactional +ui +un +userid +viewComment +www +’s diff --git a/inst/app/www/.gitignore b/inst/app/www/.gitignore index def3c4ca8..2b654ea12 100644 --- a/inst/app/www/.gitignore +++ b/inst/app/www/.gitignore @@ -1,2 +1,3 @@ ReportDocx.knit.md ReportHtml.knit.md +ReportPdf.knit.md diff --git a/inst/app/www/css/main.css b/inst/app/www/css/main.css index a0df43391..cbe4236f3 100644 --- a/inst/app/www/css/main.css +++ b/inst/app/www/css/main.css @@ -12,4 +12,25 @@ text-align: center; padding-bottom: 10px; margin-top: 70px; -} \ No newline at end of file +} + +#raa-logo img { + position: absolute; + top: 0px; + right: 0px; + padding-top: 2.75em; + padding-right: .75em; + height: 7em; +} + +#upload_package-rem_pkg_btn { + height: calc(1.5em + 1.5rem + 2px); + margin-top: 32px; + background-color:#3399ff; + border-color:#3399ff; +} + +#upload_package-rem_pkg_btn:active, +#upload_package-rem_pkg_btn:focus { +box-shadow: 0 0 0 0.25rem rgb(51, 153, 255, 50%); +} diff --git a/inst/app/www/css/slider.css b/inst/app/www/css/slider.css new file mode 100644 index 000000000..c12945d5e --- /dev/null +++ b/inst/app/www/css/slider.css @@ -0,0 +1,47 @@ +[risk=low] .irs--shiny .irs-bar { + border-top: 1px solid #06B756FF; + border-bottom: 1px solid #06B756FF; + background: #06B756FF; +} + +[risk=low] .irs--shiny .irs-single { + background-color: #06B756FF; +} + +[risk=medium] .irs--shiny .irs-bar { + border-top: 1px solid #A99D04FF; + border-bottom: 1px solid #A99D04FF; + background: #A99D04FF; +} + +[risk=medium] .irs--shiny .irs-from, +[risk=medium] .irs--shiny .irs-to { + background-color: #A99D04FF; +} + +[risk=high] .irs--shiny .irs-line { + background: #A63E24FF; + border: 1px solid #A63E24FF; +} + +[risk=high] .irs--shiny .irs-bar { + background: linear-gradient(to bottom, #DDD -50%, #FFF 150%); + border: 1px solid #cccccc; +} + +[risk=high] .irs--shiny .irs-single { + background-color: #A63E24FF; +} + +.btn-dropdown-input .btn.dropdown-toggle:after { + content: none; +} + +.btn-dropdown-input .shiny-input-checkboxgroup .control-label { + font-size: x-large; + font-weight: bold; +} + +.btn-dropdown-input ul { + border: 1px solid; +} diff --git a/inst/app/www/favicon.ico b/inst/app/www/favicon.ico index 4c0982c02..17923e229 100644 Binary files a/inst/app/www/favicon.ico and b/inst/app/www/favicon.ico differ diff --git a/inst/app/www/raa-alt-image.png b/inst/app/www/raa-alt-image.png new file mode 100644 index 000000000..6097ebadc Binary files /dev/null and b/inst/app/www/raa-alt-image.png differ diff --git a/inst/app/www/raa-image.png b/inst/app/www/raa-image.png new file mode 100644 index 000000000..0690df8a4 Binary files /dev/null and b/inst/app/www/raa-image.png differ diff --git a/inst/app/www/raa_alt_favicon.ico b/inst/app/www/raa_alt_favicon.ico new file mode 100644 index 000000000..1ffb09826 Binary files /dev/null and b/inst/app/www/raa_alt_favicon.ico differ diff --git a/inst/app/www/raa_hex_favicon.ico b/inst/app/www/raa_hex_favicon.ico new file mode 100644 index 000000000..17923e229 Binary files /dev/null and b/inst/app/www/raa_hex_favicon.ico differ diff --git a/inst/app/www/reportDocx.Rmd b/inst/app/www/reportDocx.Rmd index db6c1843b..57a8d3663 100644 --- a/inst/app/www/reportDocx.Rmd +++ b/inst/app/www/reportDocx.Rmd @@ -31,6 +31,7 @@ library(ggplot2) library(plotly) knitr::opts_chunk$set(echo = F, fig.width = 5.5, fig.height = 3.4) +cm_ind <- nrow(params$com_metrics) != 0 ``` @@ -64,6 +65,7 @@ tagList( 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('Risk Score:'), br(), getElement(params$pkg, 'score'), br(), br(), strong('Overall Risk:'), br(), ifelse(params$pkg[['decision']] == '', 'Pending', params$pkg[['decision']]) ) ``` @@ -92,7 +94,9 @@ params$maint_metrics %>% dplyr::mutate( `Metric Name` = title, `Metric Description` = desc, - `Metric Value` = value + `Metric Value` = dplyr::case_when(!(name %in% c('has_bug_reports_url', 'news_current')) ~ value, + value %in% c("TRUE","1") ~ 'Yes', + TRUE ~ 'No') ) %>% dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`) %>% knitr::kable(format = 'pandoc') @@ -117,6 +121,10 @@ tagList(br(), h2("Community Usage Metrics")) ```{r community_metrics_table, warning=FALSE, message=FALSE, error=FALSE, results='HIDE', 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;") +} else { params$com_metrics %>% dplyr::mutate( `Metric Name` = title, @@ -125,10 +133,11 @@ params$com_metrics %>% ) %>% dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`) %>% knitr::kable(format = 'pandoc') +} ``` -```{r community_metrics_plot_title} +```{r community_metrics_plot_title, eval=cm_ind} tagList( br(), h2('Number of Downloads by Month/Year') @@ -136,7 +145,7 @@ tagList( ``` -```{r community_metrics_plot, fig.width=10, fig.height=5} +```{r community_metrics_plot, fig.width=10, fig.height=5, eval=cm_ind} d <- params$com_metrics_raw %>% dplyr::mutate(day_month_year = glue::glue('1-{month}-{year}')) %>% dplyr::mutate(day_month_year = as.Date(day_month_year, "%d-%m-%Y")) %>% @@ -158,7 +167,7 @@ ggplot(data = d, aes(x = day_month_year, y = downloads)) + ``` -```{r community_metrics_comments} +```{r community_metrics_comments, eval=cm_ind} tagList( br(), h2('Comments'), @@ -177,7 +186,7 @@ tagList(br(), h2('About Report')) ```{r about_report} tagList( - strong('Risk Assessment App Version:'), br(), getElement(params, 'app_version'), br(), br(), + 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(), strong('Metric Weights:') diff --git a/inst/app/www/reportHtml.Rmd b/inst/app/www/reportHtml.Rmd index 8cc604497..6926aa7d7 100644 --- a/inst/app/www/reportHtml.Rmd +++ b/inst/app/www/reportHtml.Rmd @@ -25,6 +25,14 @@ params: downloads_plot_data: NA --- + + ```{r setup, include=FALSE} library(knitr) library(shiny) @@ -38,6 +46,8 @@ knitr::opts_chunk$set(echo = F, fig.width = 5.5, fig.height = 3.4) 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")) @@ -45,7 +55,11 @@ createCard <- function(title, desc, value, is_perc = FALSE, is_url = FALSE, else if(is_perc) value <- glue::glue('{round(as.numeric(value), 1)}%') else if(is_url) - value <- a(glue::glue('{stringr::str_sub(value, 1, 29)}...'), href = value) + value <- a(ifelse(nchar(value) <= val_max_nchar, value, + glue::glue('{stringr::str_sub(value, 1, (val_max_nchar - 3))}...') + ), href = value) + # unfortunately, adding the href can sometimes force the footer to fall + # outside the card when val_max_nchar is too large. else if(value %in% c('TRUE', 'FALSE')) value <- ifelse(value == 'TRUE', 'Yes', 'No') @@ -60,19 +74,22 @@ createCard <- function(title, desc, value, is_perc = FALSE, is_url = FALSE, icon_name <- "percent" icon_class <- "text-info" } - - card_style = "max-width: 400px; max-height: 250px; overflow-y: scroll;" - +# 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, + size_min = .85, size_max = 1.5) + body_p_style = glue::glue('font-size: {auto_font_out}vw') + div(class="card mb-3 text-center border-info", style=card_style, div(class ="row no-gutters", div(class="col-md-4 text-center border-info", - icon(icon_name, class=icon_class, + icon(icon_name, class=icon_class, verify_fa = FALSE, style="padding-top: 40%; font-size:60px; padding-left: 20%;")), div(class="col-md-8", h5(class="card-header bg-transparent", style="font-size: 1vw", title), div(class="card-body text-info", - p(class="card-title", style="font-size: 1.5vw", value))), + p(class="card-title", style=body_p_style, value))), div(class="card-footer bg-transparent", desc) ) ) @@ -88,7 +105,9 @@ createGrid <- function(metrics){ lapply(X = 1:col_length, function(i){ createCard(title = metrics$title[i], desc = metrics$desc[i], - value = metrics$value[i], + value = dplyr::case_when(metrics$name[i] != 'has_bug_reports_url' ~ metrics$value[i], + metrics$value[i] == "1" ~ 'TRUE', + TRUE ~ 'FALSE'), is_perc = metrics$is_perc[i] == 1, is_url = metrics$is_url[i] == 1, succ_icon = metrics$succ_icon[i], @@ -99,7 +118,9 @@ createGrid <- function(metrics){ lapply(X = (col_length + 1):(2*col_length), function(i){ createCard(title = metrics$title[i], desc = metrics$desc[i], - value = metrics$value[i], + value = dplyr::case_when(metrics$name[i] != 'has_bug_reports_url' ~ metrics$value[i], + metrics$value[i] == "1" ~ 'TRUE', + TRUE ~ 'FALSE'), is_perc = metrics$is_perc[i] == 1, is_url = metrics$is_url[i] == 1, succ_icon = metrics$succ_icon[i], @@ -110,7 +131,9 @@ createGrid <- function(metrics){ lapply(X = (2*col_length + 1):nrow(metrics), function(i){ createCard(title = metrics$title[i], desc = metrics$desc[i], - value = metrics$value[i], + value = dplyr::case_when(metrics$name[i] != 'has_bug_reports_url' ~ metrics$value[i], + metrics$value[i] == "1" ~ 'TRUE', + TRUE ~ 'FALSE'), is_perc = metrics$is_perc[i] == 1, is_url = metrics$is_url[i] == 1, succ_icon = metrics$succ_icon[i], @@ -123,9 +146,20 @@ createGrid <- function(metrics){
+```{css, echo=FALSE} +#raa-logo img { + position: absolute; + top: 0px; + right: 0px; + padding-top: .75em; + padding-right: 6em; + height: 6em; +} +``` + ```{r general_pkg_info} h5('General Information') - +div(id = "raa-logo", img(src="raa-image.png")) tagList( h6('Package:'), params$pkg$name, h6('Version:'), params$pkg$version, @@ -135,6 +169,7 @@ tagList( h6('Maintainer:'), params$pkg$maintainer, h6('License:'), params$pkg$license, h6('Published:'), params$pkg$published, + h6('Risk Score:'), params$pkg$score, h6('Overall Risk:'), ifelse(params$pkg$decision == '', 'Pending', params$pkg$decision) ) ``` @@ -179,6 +214,11 @@ tagList( tagList( br(), h5("Community Usage Metrics", style = "text-align: center;"), + if (nrow(params$com_metrics) == 0) { + h6(glue::glue("Community Usage Metrics not avaiable for {params$pkg$name}"), + style = "text-align: center; color: gray; padding-top: 50px;") + } else { + tagList( br(), br(), createGrid(metrics = params$com_metrics), br(), br(), @@ -192,7 +232,8 @@ tagList( HTML(showComments( pkg_name = params$pkg$name, comments = params$cm_comments)) - ) + )) + } ) ``` @@ -204,7 +245,7 @@ tagList( h5('About the Report') tagList( - h6('Risk Assessment App Version:'), params$app_version, + h6('{riskassessment} App Version:'), params$app_version, h6('riskmetric Version:'), params$riskmetric_version, h6('Generated on:'), format(Sys.time(), usetz = TRUE), h6('Metric Weights:') diff --git a/www/reportDocx.Rmd b/inst/app/www/reportPdf.Rmd similarity index 79% rename from www/reportDocx.Rmd rename to inst/app/www/reportPdf.Rmd index fc666115c..4daeea46a 100644 --- a/www/reportDocx.Rmd +++ b/inst/app/www/reportPdf.Rmd @@ -5,7 +5,7 @@ author: "Author (Role): `r params$user_name` (`r params$user_role `)" date: "Report Date: `r format(Sys.time(), '%B %d, %Y')`" always_allow_html: true output: - word_document: + pdf_document: md_extensions: +raw_html-markdown_in_html_blocks pandoc_args: ['--lua-filter', 'read_html.lua'] params: @@ -25,10 +25,13 @@ params: --- ```{r setup, include=FALSE} +library(knitr) library(shiny) -library(dplyr) +library(ggplot2) +library(plotly) knitr::opts_chunk$set(echo = F, fig.width = 5.5, fig.height = 3.4) +cm_ind <- nrow(params$com_metrics) != 0 ``` @@ -62,6 +65,7 @@ tagList( 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('Risk Score:'), br(), getElement(params$pkg, 'score'), br(), br(), strong('Overall Risk:'), br(), ifelse(params$pkg[['decision']] == '', 'Pending', params$pkg[['decision']]) ) ``` @@ -90,7 +94,9 @@ params$maint_metrics %>% dplyr::mutate( `Metric Name` = title, `Metric Description` = desc, - `Metric Value` = value + `Metric Value` = dplyr::case_when(!(name %in% c('has_bug_reports_url', 'news_current')) ~ value, + value %in% c("TRUE","1") ~ 'Yes', + TRUE ~ 'No') ) %>% dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`) %>% knitr::kable(format = 'pandoc') @@ -115,6 +121,10 @@ tagList(br(), h2("Community Usage Metrics")) ```{r community_metrics_table, warning=FALSE, message=FALSE, error=FALSE, results='HIDE', 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;") +} else { params$com_metrics %>% dplyr::mutate( `Metric Name` = title, @@ -123,10 +133,11 @@ params$com_metrics %>% ) %>% dplyr::select(`Metric Name`, `Metric Description`, `Metric Value`) %>% knitr::kable(format = 'pandoc') +} ``` -```{r community_metrics_plot_title} +```{r community_metrics_plot_title, eval=cm_ind} tagList( br(), h2('Number of Downloads by Month/Year') @@ -134,7 +145,7 @@ tagList( ``` -```{r community_metrics_plot, fig.width=10, fig.height=5} +```{r community_metrics_plot, fig.width=10, fig.height=5, eval=cm_ind} d <- params$com_metrics_raw %>% dplyr::mutate(day_month_year = glue::glue('1-{month}-{year}')) %>% dplyr::mutate(day_month_year = as.Date(day_month_year, "%d-%m-%Y")) %>% @@ -144,20 +155,19 @@ d <- params$com_metrics_raw %>% mo <- ceiling(nrow(d) / 9) -ggplot2::ggplot(data = d, ggplot2::aes(x = day_month_year, y = downloads)) + - ggplot2::geom_point() + - ggplot2::geom_line() + - ggplot2::scale_x_date(date_breaks = glue::glue("{mo} months"), date_labels = "%m-%Y") + - ggplot2::labs( +ggplot(data = d, aes(x = day_month_year, y = downloads)) + + geom_point() + + geom_line() + + scale_x_date(date_breaks = glue::glue("{mo} months"), date_labels = "%m-%Y") + + labs( x = 'Month/Year', y = 'Downloads' ) + - ggplot2::theme(text = ggplot2::element_text(size = 16), - axis.text = ggplot2::element_text(size=16))# angle = 30, vjust = 0.5, hjust=1)) + theme(text = element_text(size = 16), axis.text = element_text(size=16))# angle = 30, vjust = 0.5, hjust=1)) ``` -```{r community_metrics_comments} +```{r community_metrics_comments, eval=cm_ind} tagList( br(), h2('Comments'), @@ -176,7 +186,7 @@ tagList(br(), h2('About Report')) ```{r about_report} tagList( - strong('Risk Assessment App Version:'), br(), getElement(params, 'app_version'), br(), br(), + 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(), strong('Metric Weights:') diff --git a/inst/app/www/sql_queries/initialize_metric_table.sql b/inst/app/www/sql_queries/initialize_metric_table.sql index fdbad3836..1ce66d85a 100644 --- a/inst/app/www/sql_queries/initialize_metric_table.sql +++ b/inst/app/www/sql_queries/initialize_metric_table.sql @@ -4,7 +4,7 @@ VALUES ('has_vignettes', 'Vignettes', 'Number of vignettes', 0, 0, 'maintenance', 1), ('has_news', 'NEWS file', 'Number of NEWS files', 0, 0, 'maintenance', 1), ('news_current', 'NEWS current', 'NEWS contains current version', 0, 0, 'maintenance', 1), -('has_bug_reports_url', 'Report Bugs', 'Public url to report bugs', 0, 1, 'maintenance', 1), +('has_bug_reports_url', 'Report Bugs', 'URL to report bugs exists', 0, 0, 'maintenance', 1), ('has_website', 'Website', 'Package public website', 0, 1, 'maintenance', 1), ('has_maintainer', 'Maintainer', 'Package maintainers', 0, 0, 'maintenance', 1), ('has_source_control', 'Source Control', 'Package source control url', 0, 1, 'maintenance', 1), diff --git a/inst/testdata/skeleton.sqlite b/inst/testdata/skeleton.sqlite new file mode 100644 index 000000000..76fb17d6e Binary files /dev/null and b/inst/testdata/skeleton.sqlite differ diff --git a/inst/testdata/upload_format.csv b/inst/testdata/upload_format.csv new file mode 100644 index 000000000..935371538 --- /dev/null +++ b/inst/testdata/upload_format.csv @@ -0,0 +1,2 @@ +package,version +dplyr,1.0.0 diff --git a/inst/testdata/upload_format.database b/inst/testdata/upload_format.database new file mode 100644 index 000000000..a914492ca Binary files /dev/null and b/inst/testdata/upload_format.database differ diff --git a/man/addCommentServer.Rd b/man/addCommentServer.Rd index bba2105f8..07af7799a 100644 --- a/man/addCommentServer.Rd +++ b/man/addCommentServer.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/addComment.R +% Please edit documentation in R/mod_addComment.R \name{addCommentServer} \alias{addCommentServer} \title{addComment module's server logic} @@ -15,8 +15,9 @@ addCommentServer(id, metric_abrv, user_name, user_role, pkg_name) \item{user_role}{placeholder} -\item{pkg_name}{placeholder} +\item{pkg_name}{string name of the package} } \description{ addComment module's server logic } +\keyword{internal} diff --git a/man/addCommentUI.Rd b/man/addCommentUI.Rd index d66e95217..f09e9e449 100644 --- a/man/addCommentUI.Rd +++ b/man/addCommentUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/addComment.R +% Please edit documentation in R/mod_addComment.R \name{addCommentUI} \alias{addCommentUI} \title{The UI for the 'addComment' module} @@ -13,3 +13,4 @@ addCommentUI(id) Module to display comments for the specified metric. The comments will update as the user inserts more comments. } +\keyword{internal} diff --git a/man/add_shinymanager_auth.Rd b/man/add_shinymanager_auth.Rd new file mode 100644 index 000000000..11fc13552 --- /dev/null +++ b/man/add_shinymanager_auth.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils_startup.R +\name{add_shinymanager_auth} +\alias{add_shinymanager_auth} +\title{Add an Authentication Screen} +\usage{ +add_shinymanager_auth(app_ui, app_ver, login_note) +} +\arguments{ +\item{app_ui}{The \code{app_ui} function for the application.} + +\item{app_ver}{See identical param in \code{\link[=run_app]{run_app()}}.} + +\item{login_note}{See identical param in \code{\link[=run_app]{run_app()}}.} +} +\description{ +Adds an authentication screen via \code{\link[shinymanager:secure-app]{shinymanager::secure_app()}}. +} +\keyword{internal} diff --git a/man/add_tags.Rd b/man/add_tags.Rd index 691d1877d..095fa71cb 100644 --- a/man/add_tags.Rd +++ b/man/add_tags.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R +% Please edit documentation in R/utils_startup.R \name{add_tags} \alias{add_tags} \title{The 'Add tags' function} @@ -14,3 +14,4 @@ add_tags(ui, ...) \description{ The 'Add tags' function } +\keyword{internal} diff --git a/man/app_theme.Rd b/man/app_theme.Rd index 70ceff8c1..02ccdf435 100644 --- a/man/app_theme.Rd +++ b/man/app_theme.Rd @@ -1,21 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils_initialize.R -\docType{data} +% Please edit documentation in R/utils_startup.R \name{app_theme} \alias{app_theme} \title{Application Theme} -\format{ -An object of class \code{bs_bootswatch_lux} (inherits from \code{bs_version_5}, \code{bs_theme}, \code{sass_bundle}) of length 1. -} \usage{ -app_theme +app_theme() } \value{ an bs_theme object of several classes } \description{ -This sets the Risk Assessment Application theme object using +This sets the \code{riskassessment} Application theme object using bslib's bs_theme() function. The app_theme object gets used in run_app.R, in addition to app_ui.R } -\keyword{datasets} +\keyword{internal} diff --git a/man/assessmentInfoServer.Rd b/man/assessmentInfoServer.Rd index 88a0b1edf..fa5b8f72c 100644 --- a/man/assessmentInfoServer.Rd +++ b/man/assessmentInfoServer.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/assessmentInfo.R +% Please edit documentation in R/mod_assessmentInfo.R \name{assessmentInfoServer} \alias{assessmentInfoServer} \title{Server Logic for 'Assessment Info' Module} @@ -14,3 +14,4 @@ assessmentInfoServer(id, metric_weights) \description{ Server Logic for 'Assessment Info' Module } +\keyword{internal} diff --git a/man/assessmentInfoUI.Rd b/man/assessmentInfoUI.Rd index b5798808e..7347565ff 100644 --- a/man/assessmentInfoUI.Rd +++ b/man/assessmentInfoUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/assessmentInfo.R +% Please edit documentation in R/mod_assessmentInfo.R \name{assessmentInfoUI} \alias{assessmentInfoUI} \title{UI for 'Assessment Info' Module} @@ -12,3 +12,4 @@ assessmentInfoUI(id) \description{ UI for 'Assessment Info' Module } +\keyword{internal} diff --git a/man/auto_font.Rd b/man/auto_font.Rd new file mode 100644 index 000000000..620fb1f28 --- /dev/null +++ b/man/auto_font.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{auto_font} +\alias{auto_font} +\title{Automatic font re-sizer} +\usage{ +auto_font(txt, txt_max = 45, size_min = 0.75, size_max = 1.5, num_bins = NULL) +} +\arguments{ +\item{txt}{a string} + +\item{txt_max}{an integer to specify a length of text that is considered "to +long" to continue to toggle the font size} + +\item{size_min}{an integer specifying the smallest font size you'd like to +see in the output} + +\item{size_max}{integer specifying the largest font size you'd like to see in +the output} + +\item{num_bins}{when not NULL (the default), accepts an integer that bins a +continuous font size into a categorical one.} +} +\description{ +A function that adjusts the number (to be used as font size) that is +proportional to the length of a text string. So the longer the text string, +the smaller the font. Used in MetricBox.R. +} +\keyword{internal} diff --git a/man/build_comm_cards.Rd b/man/build_comm_cards.Rd index 513a56510..e2eadaf55 100644 --- a/man/build_comm_cards.Rd +++ b/man/build_comm_cards.Rd @@ -12,3 +12,4 @@ build_comm_cards(data) \description{ The 'Build Community Cards' function } +\keyword{internal} diff --git a/man/build_comm_plotly.Rd b/man/build_comm_plotly.Rd index 47858dea5..d25e78fd6 100644 --- a/man/build_comm_plotly.Rd +++ b/man/build_comm_plotly.Rd @@ -2,13 +2,24 @@ % Please edit documentation in R/utils.R \name{build_comm_plotly} \alias{build_comm_plotly} -\title{The 'Build Community plot' function} +\title{Build a plotly of community usage metrics} \usage{ -build_comm_plotly(data) +build_comm_plotly(data = NULL, pkg_name = NULL) } \arguments{ -\item{data}{a data.frame} +\item{data}{a data.frame containing monthly download data, built using \code{generate_comm_data()}. This argument is optional, but if \code{NULL}, a \code{pkg_name} must be provided.} + +\item{pkg_name}{a string of a package name. This parameter is optional. If \code{pkg_name} is provided, the data argument should be \code{NULL}.} +} +\value{ +a plotly object + +an interactive plotly object } \description{ -The 'Build Community plot' function +Responsible for building an interactive \code{{plotly}} graphic containing the trend line for number of CRAN pkg downloads by month. +} +\examples{ +metricGraph <- build_comm_plotly(pkg_name = "ggplot2") } +\keyword{reproduce} diff --git a/man/communityMetricsServer.Rd b/man/communityMetricsServer.Rd index a8665509e..fd5b8233d 100644 --- a/man/communityMetricsServer.Rd +++ b/man/communityMetricsServer.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/communityMetrics.R +% Please edit documentation in R/mod_communityMetrics.R \name{communityMetricsServer} \alias{communityMetricsServer} \title{Community Usage Metrics server logic} @@ -18,3 +18,4 @@ communityMetricsServer(id, selected_pkg, community_metrics, user) \description{ Community Usage Metrics server logic } +\keyword{internal} diff --git a/man/communityMetricsUI.Rd b/man/communityMetricsUI.Rd index 5c4b519ff..7b3385060 100644 --- a/man/communityMetricsUI.Rd +++ b/man/communityMetricsUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/communityMetrics.R +% Please edit documentation in R/mod_communityMetrics.R \name{communityMetricsUI} \alias{communityMetricsUI} \title{Community Usage Metrics UI function} @@ -12,3 +12,4 @@ communityMetricsUI(id) \description{ Community Usage Metrics UI function } +\keyword{internal} diff --git a/man/create_credentials_db.Rd b/man/create_credentials_db.Rd index e0cc7cbe1..c4b20362c 100644 --- a/man/create_credentials_db.Rd +++ b/man/create_credentials_db.Rd @@ -1,14 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R +% Please edit documentation in R/utils_startup.R \name{create_credentials_db} \alias{create_credentials_db} \title{Create credentials database} \usage{ -create_credentials_db(db_name = credentials_name) +create_credentials_db(db_name) } \arguments{ -\item{db_name}{a string} +\item{db_name}{A string denoting the name of the database} } \description{ -Note: the credentials_name object is assigned in data-raw/internal-data.R +Note: the credentials_db_name object is assigned by the deployment user in R/run_app.R } +\keyword{internal} diff --git a/man/create_credentials_dev_db.Rd b/man/create_credentials_dev_db.Rd new file mode 100644 index 000000000..44368df99 --- /dev/null +++ b/man/create_credentials_dev_db.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils_startup.R +\name{create_credentials_dev_db} +\alias{create_credentials_dev_db} +\title{Create credentials dev database} +\usage{ +create_credentials_dev_db(db_name) +} +\arguments{ +\item{db_name}{A string denoting the name of the database} +} +\description{ +Create credentials dev database +} +\keyword{internal} diff --git a/man/create_db.Rd b/man/create_db.Rd index f19ba6a0d..f5a793d96 100644 --- a/man/create_db.Rd +++ b/man/create_db.Rd @@ -1,14 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R +% Please edit documentation in R/utils_startup.R \name{create_db} \alias{create_db} \title{Create package database} \usage{ -create_db(db_name = database_name) +create_db(db_name) } \arguments{ -\item{db_name}{a string} +\item{db_name}{A string denoting the name of the database} } \description{ -Note: the database_name object is assigned in data-raw/internal-data.R +Note: the database_name object is assigned by deployment users in R/run_app.R } +\keyword{internal} diff --git a/man/databaseViewServer.Rd b/man/databaseViewServer.Rd index d53bbfb52..301d1fd5d 100644 --- a/man/databaseViewServer.Rd +++ b/man/databaseViewServer.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/databaseView.R +% Please edit documentation in R/mod_databaseView.R \name{databaseViewServer} \alias{databaseViewServer} \title{Server logic for 'Database View' module} @@ -14,7 +14,10 @@ databaseViewServer(id, user, uploaded_pkgs, metric_weights, changes) \item{uploaded_pkgs}{a vector of uploaded package names} \item{metric_weights}{a reactive data.frame holding metric weights} + +\item{changes}{a reactive value integer count} } \description{ Server logic for 'Database View' module } +\keyword{internal} diff --git a/man/databaseViewUI.Rd b/man/databaseViewUI.Rd index 6fd9ba4aa..9c0def08d 100644 --- a/man/databaseViewUI.Rd +++ b/man/databaseViewUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/databaseView.R +% Please edit documentation in R/mod_databaseView.R \name{databaseViewUI} \alias{databaseViewUI} \title{UI for 'Database View' module} @@ -12,3 +12,4 @@ databaseViewUI(id) \description{ UI for 'Database View' module } +\keyword{internal} diff --git a/man/dbSelect.Rd b/man/dbSelect.Rd deleted file mode 100644 index 851872c09..000000000 --- a/man/dbSelect.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{dbSelect} -\alias{dbSelect} -\title{Select data from database} -\usage{ -dbSelect(query, db_name = database_name) -} -\arguments{ -\item{query}{a sql query as a string} - -\item{db_name}{a string} -} -\description{ -Select data from database -} diff --git a/man/dbUpdate.Rd b/man/dbUpdate.Rd deleted file mode 100644 index f47a5d377..000000000 --- a/man/dbUpdate.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{dbUpdate} -\alias{dbUpdate} -\title{dbUpdate} -\usage{ -dbUpdate(command, db_name = database_name) -} -\arguments{ -\item{command}{a string} - -\item{db_name}{a string} -} -\description{ -Deletes, updates or inserts queries. -} diff --git a/man/figures/hex-riskassessment-aspconfig.png b/man/figures/hex-riskassessment-aspconfig.png new file mode 100644 index 000000000..64c35ec4f Binary files /dev/null and b/man/figures/hex-riskassessment-aspconfig.png differ diff --git a/man/figures/hex-riskmetric-aspconfig.png b/man/figures/hex-riskmetric-aspconfig.png new file mode 100644 index 000000000..9fcd328e1 Binary files /dev/null and b/man/figures/hex-riskmetric-aspconfig.png differ diff --git a/man/figures/raa-alt-image.png b/man/figures/raa-alt-image.png new file mode 100644 index 000000000..6097ebadc Binary files /dev/null and b/man/figures/raa-alt-image.png differ diff --git a/man/figures/raa-image.png b/man/figures/raa-image.png new file mode 100644 index 000000000..0690df8a4 Binary files /dev/null and b/man/figures/raa-image.png differ diff --git a/man/figures/youtube-play-button.png b/man/figures/youtube-play-button.png new file mode 100644 index 000000000..4a90e22df Binary files /dev/null and b/man/figures/youtube-play-button.png differ diff --git a/man/generate_comm_data.Rd b/man/generate_comm_data.Rd new file mode 100644 index 000000000..e44b5f72a --- /dev/null +++ b/man/generate_comm_data.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{generate_comm_data} +\alias{generate_comm_data} +\title{Generate Community Usage Data} +\usage{ +generate_comm_data(pkg_name) +} +\arguments{ +\item{pkg_name}{A string containing the name of a package.} +} +\value{ +A tibble of community usage metrics + +a data.frame which includes downloads per month for the given pkg +} +\description{ +Extracts community usage metrics for a given package. +} +\examples{ +if( interactive()) { +ggplot_comm_df <- generate_comm_data("ggplot2") +head(ggplot_comm_df) +} +} +\keyword{reproduce} diff --git a/man/getTimeStamp.Rd b/man/getTimeStamp.Rd index 8061dcf9d..1851528e3 100644 --- a/man/getTimeStamp.Rd +++ b/man/getTimeStamp.Rd @@ -9,3 +9,4 @@ getTimeStamp() \description{ Retrieves Sys.time(), but transforms slightly } +\keyword{internal} diff --git a/man/get_cm_comments.Rd b/man/get_cm_comments.Rd deleted file mode 100644 index 93a89e7bb..000000000 --- a/man/get_cm_comments.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{get_cm_comments} -\alias{get_cm_comments} -\title{The 'Get Community Usage Metrics Comments' function} -\usage{ -get_cm_comments(pkg_name) -} -\arguments{ -\item{pkg_name}{string} -} -\description{ -Retrieve the Community Metrics comments for a specific package -} diff --git a/man/get_comm_data.Rd b/man/get_comm_data.Rd deleted file mode 100644 index 3a7e05827..000000000 --- a/man/get_comm_data.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{get_comm_data} -\alias{get_comm_data} -\title{The 'Get Communnity Data' function} -\usage{ -get_comm_data(pkg_name) -} -\arguments{ -\item{pkg_name}{string} -} -\description{ -Get all community metric data on a specific package -} diff --git a/man/get_date_span.Rd b/man/get_date_span.Rd index 80649bc0e..cc84d282c 100644 --- a/man/get_date_span.Rd +++ b/man/get_date_span.Rd @@ -14,3 +14,4 @@ get_date_span(start, end = Sys.Date()) \description{ Function accepts a start date and optional end date and will } +\keyword{internal} diff --git a/man/get_latest_pkg_info.Rd b/man/get_latest_pkg_info.Rd index b69cc066e..a7d22219d 100644 --- a/man/get_latest_pkg_info.Rd +++ b/man/get_latest_pkg_info.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dbupload.R +% Please edit documentation in R/utils.R \name{get_latest_pkg_info} \alias{get_latest_pkg_info} \title{Get the package general information from CRAN/local} @@ -7,8 +7,9 @@ get_latest_pkg_info(pkg_name) } \arguments{ -\item{pkg_name}{the package name} +\item{pkg_name}{string name of the package} } \description{ Get the package general information from CRAN/local } +\keyword{internal} diff --git a/man/get_metric_weights.Rd b/man/get_metric_weights.Rd deleted file mode 100644 index 371caebe4..000000000 --- a/man/get_metric_weights.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{get_metric_weights} -\alias{get_metric_weights} -\title{get_metric_weights} -\usage{ -get_metric_weights() -} -\description{ -Retrieves metric name and current weight from metric table -} diff --git a/man/get_mm_comments.Rd b/man/get_mm_comments.Rd deleted file mode 100644 index 27f390c19..000000000 --- a/man/get_mm_comments.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{get_mm_comments} -\alias{get_mm_comments} -\title{The 'Get Maintenance Metrics Comments' function} -\usage{ -get_mm_comments(pkg_name) -} -\arguments{ -\item{pkg_name}{string} -} -\description{ -Retrieves the Maint Metrics comments for a specific package -} diff --git a/man/get_mm_data.Rd b/man/get_mm_data.Rd deleted file mode 100644 index 0669831a3..000000000 --- a/man/get_mm_data.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{get_mm_data} -\alias{get_mm_data} -\title{The 'Get Maintenance Metrics Data' function} -\usage{ -get_mm_data(pkg_id) -} -\arguments{ -\item{pkg_id}{string} -} -\description{ -Pull the maint metrics data for a specific package id, and create -necessary columns for Cards UI -} diff --git a/man/get_overall_comments.Rd b/man/get_overall_comments.Rd deleted file mode 100644 index dcdcdbf36..000000000 --- a/man/get_overall_comments.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{get_overall_comments} -\alias{get_overall_comments} -\title{The 'Get Overall Comments' function} -\usage{ -get_overall_comments(pkg_name) -} -\arguments{ -\item{pkg_name}{string} -} -\description{ -Retrieves the overall comments for a specific package -} diff --git a/man/get_pkg_info.Rd b/man/get_pkg_info.Rd deleted file mode 100644 index 59dda5f94..000000000 --- a/man/get_pkg_info.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{get_pkg_info} -\alias{get_pkg_info} -\title{The 'Get Package Info' function} -\usage{ -get_pkg_info(pkg_name) -} -\arguments{ -\item{pkg_name}{string} -} -\description{ -Get all general info on a specific package -} diff --git a/man/initialize_raa.Rd b/man/initialize_raa.Rd index 68bb834c4..4285b22c2 100644 --- a/man/initialize_raa.Rd +++ b/man/initialize_raa.Rd @@ -1,16 +1,21 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils_initialize.R +% Please edit documentation in R/utils_startup.R \name{initialize_raa} \alias{initialize_raa} -\title{Initialize the Risk Assessment Application} +\title{Initialize \code{riskassessment} Application Settings} \usage{ -initialize_raa() +initialize_raa(assess_db, cred_db) +} +\arguments{ +\item{assess_db}{A string denoting the name of the assessment database.} + +\item{cred_db}{A string denoting the name of the credentials database.} } \value{ There is no return value. The function is run for its side effects. } \description{ -This sets up the environment when running the Risk Assessment +This sets up the environment when running the \code{riskassessment} Application. It sets the log file, initializes the package database if missing, and initializes the credentials database if missing. } diff --git a/man/insert_community_metrics_to_db.Rd b/man/insert_community_metrics_to_db.Rd deleted file mode 100644 index 247600a63..000000000 --- a/man/insert_community_metrics_to_db.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dbupload.R -\name{insert_community_metrics_to_db} -\alias{insert_community_metrics_to_db} -\title{Generate community usage metrics and upload data into DB} -\usage{ -insert_community_metrics_to_db(pkg_name) -} -\description{ -Generate community usage metrics and upload data into DB -} diff --git a/man/insert_maintenance_metrics_to_db.Rd b/man/insert_maintenance_metrics_to_db.Rd deleted file mode 100644 index b49f4636a..000000000 --- a/man/insert_maintenance_metrics_to_db.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dbupload.R -\name{insert_maintenance_metrics_to_db} -\alias{insert_maintenance_metrics_to_db} -\title{The 'Insert MM to DB' Function} -\usage{ -insert_maintenance_metrics_to_db(pkg_name) -} -\description{ -Get the maintenance and testing metrics info and upload into DB. -} diff --git a/man/insert_pkg_info_to_db.Rd b/man/insert_pkg_info_to_db.Rd deleted file mode 100644 index 9955b1dec..000000000 --- a/man/insert_pkg_info_to_db.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dbupload.R -\name{insert_pkg_info_to_db} -\alias{insert_pkg_info_to_db} -\title{Call function to get and upload info from CRAN/local to db.} -\usage{ -insert_pkg_info_to_db(pkg_name) -} -\description{ -Call function to get and upload info from CRAN/local to db. -} diff --git a/man/introJSServer.Rd b/man/introJSServer.Rd index 407973398..39a19dfeb 100644 --- a/man/introJSServer.Rd +++ b/man/introJSServer.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/introJS.R +% Please edit documentation in R/mod_introJS.R \name{introJSServer} \alias{introJSServer} \title{Server logic for introJS module} @@ -17,3 +17,4 @@ that populate this argument for the app} \description{ Server logic for introJS module } +\keyword{internal} diff --git a/man/introJSUI.Rd b/man/introJSUI.Rd index f7db32d51..9dbde1d17 100644 --- a/man/introJSUI.Rd +++ b/man/introJSUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/introJS.R +% Please edit documentation in R/mod_introJS.R \name{introJSUI} \alias{introJSUI} \title{UI for Module to display introJS button and functionality.} @@ -12,3 +12,4 @@ introJSUI(id) \description{ UI for Module to display introJS button and functionality. } +\keyword{internal} diff --git a/man/maintenanceMetricsServer.Rd b/man/maintenanceMetricsServer.Rd index 77658a91c..97cde9213 100644 --- a/man/maintenanceMetricsServer.Rd +++ b/man/maintenanceMetricsServer.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/maintenanceMetrics.R +% Please edit documentation in R/mod_maintenanceMetrics.R \name{maintenanceMetricsServer} \alias{maintenanceMetricsServer} \title{Maintenance Metrics module's server logic} @@ -18,3 +18,4 @@ maintenanceMetricsServer(id, selected_pkg, maint_metrics, user) \description{ Maintenance Metrics module's server logic } +\keyword{internal} diff --git a/man/maintenanceMetricsUI.Rd b/man/maintenanceMetricsUI.Rd index 5a0bf95ce..c3639fe95 100644 --- a/man/maintenanceMetricsUI.Rd +++ b/man/maintenanceMetricsUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/maintenanceMetrics.R +% Please edit documentation in R/mod_maintenanceMetrics.R \name{maintenanceMetricsUI} \alias{maintenanceMetricsUI} \title{Maintenance Metrics module's UI.} @@ -12,3 +12,4 @@ maintenanceMetricsUI(id) \description{ Maintenance Metrics module's UI. } +\keyword{internal} diff --git a/man/metricBoxServer.Rd b/man/metricBoxServer.Rd index 5b4f0e413..6351ffbb4 100644 --- a/man/metricBoxServer.Rd +++ b/man/metricBoxServer.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/metricBox.R +% Please edit documentation in R/mod_metricBox.R \name{metricBoxServer} \alias{metricBoxServer} \title{Server logic for the 'Metric Box' module} @@ -25,15 +25,17 @@ metricBoxServer( \item{value}{metric value.} -\item{is_perc}{whether the value is a percentage.} +\item{is_perc}{logical is the value is a percentage?} + +\item{is_url}{logical is the value a url} \item{succ_icon}{icon used if is_true.} \item{unsucc_icon}{icon used if not is_true.} -\item{is_true}{whether the metric is TRUE. If true, then the succ_icon will -be used; if false, then the unsucc_icon will be used.} +\item{icon_class}{string type of icon} } \description{ Server logic for the 'Metric Box' module } +\keyword{internal} diff --git a/man/metricBoxUI.Rd b/man/metricBoxUI.Rd index a9b79e615..6dbdf0af2 100644 --- a/man/metricBoxUI.Rd +++ b/man/metricBoxUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/metricBox.R +% Please edit documentation in R/mod_metricBox.R \name{metricBoxUI} \alias{metricBoxUI} \title{The UI for the 'Metric Box' module} @@ -12,3 +12,4 @@ metricBoxUI(id) \description{ The UI for the 'Metric Box' module } +\keyword{internal} diff --git a/man/metricGridServer.Rd b/man/metricGridServer.Rd index 6b6d844d5..8d134a8be 100644 --- a/man/metricGridServer.Rd +++ b/man/metricGridServer.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/metricGrid.R +% Please edit documentation in R/mod_metricGrid.R \name{metricGridServer} \alias{metricGridServer} \title{Metric Grid module's server logic} @@ -14,3 +14,4 @@ metricGridServer(id, metrics) \description{ Metric Grid module's server logic } +\keyword{internal} diff --git a/man/metricGridUI.Rd b/man/metricGridUI.Rd index 74198837d..a2b03f116 100644 --- a/man/metricGridUI.Rd +++ b/man/metricGridUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/metricGrid.R +% Please edit documentation in R/mod_metricGrid.R \name{metricGridUI} \alias{metricGridUI} \title{Metric Grid module's UI.} @@ -12,3 +12,4 @@ metricGridUI(id) \description{ Metric Grid module's UI. } +\keyword{internal} diff --git a/man/pipe.Rd b/man/pipe.Rd deleted file mode 100644 index a648c2969..000000000 --- a/man/pipe.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils-pipe.R -\name{\%>\%} -\alias{\%>\%} -\title{Pipe operator} -\usage{ -lhs \%>\% rhs -} -\arguments{ -\item{lhs}{A value or the magrittr placeholder.} - -\item{rhs}{A function call using the magrittr semantics.} -} -\value{ -The result of calling \code{rhs(lhs)}. -} -\description{ -See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. -} -\keyword{internal} diff --git a/man/reportPreviewServer.Rd b/man/reportPreviewServer.Rd index c74076040..4257a511b 100644 --- a/man/reportPreviewServer.Rd +++ b/man/reportPreviewServer.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/reportPreview.R +% Please edit documentation in R/mod_reportPreview.R \name{reportPreviewServer} \alias{reportPreviewServer} \title{Server logic for 'Report Preview' module} @@ -44,3 +44,4 @@ reportPreviewServer( \description{ Server logic for 'Report Preview' module } +\keyword{internal} diff --git a/man/reportPreviewUI.Rd b/man/reportPreviewUI.Rd index 844bdd6f0..d1e3956b4 100644 --- a/man/reportPreviewUI.Rd +++ b/man/reportPreviewUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/reportPreview.R +% Please edit documentation in R/mod_reportPreview.R \name{reportPreviewUI} \alias{reportPreviewUI} \title{UI for 'Report Preview' module} @@ -12,3 +12,4 @@ reportPreviewUI(id) \description{ UI for 'Report Preview' module } +\keyword{internal} diff --git a/man/reweightViewServer.Rd b/man/reweightViewServer.Rd index 26dd2adc2..62e4da25c 100644 --- a/man/reweightViewServer.Rd +++ b/man/reweightViewServer.Rd @@ -1,16 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/reweightView.R +% Please edit documentation in R/mod_reweightView.R \name{reweightViewServer} \alias{reweightViewServer} \title{Server logic for the 'Re-weight View' module} \usage{ -reweightViewServer(id, user) +reweightViewServer(id, user, decision_list) } \arguments{ \item{id}{the module id} \item{user}{the user name} + +\item{decision_list}{the list containing the decision automation criteria} } \description{ Server logic for the 'Re-weight View' module } +\keyword{internal} diff --git a/man/reweightViewUI.Rd b/man/reweightViewUI.Rd index 3e9a849c0..75df1536b 100644 --- a/man/reweightViewUI.Rd +++ b/man/reweightViewUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/reweightView.R +% Please edit documentation in R/mod_reweightView.R \name{reweightViewUI} \alias{reweightViewUI} \title{UI for the 'Re-weight View' module} @@ -12,3 +12,4 @@ reweightViewUI(id) \description{ UI for the 'Re-weight View' module } +\keyword{internal} diff --git a/man/riskassessment-package.Rd b/man/riskassessment-package.Rd index c4268679c..abcf66b48 100644 --- a/man/riskassessment-package.Rd +++ b/man/riskassessment-package.Rd @@ -6,7 +6,7 @@ \alias{riskassessment-package} \title{The \code{riskassessment} package} \description{ -The Risk Assessment App is an interactive web application serving as a front +The \code{riskassessment} App is an interactive web application serving as a front end application for the \code{riskmetric} R package. \code{riskmetric} is a framework to quantify risk by assessing a number of metrics meant to evaluate development best practices, code documentation, community engagement, and @@ -16,8 +16,8 @@ context for validation within regulated industries. \seealso{ Useful links: \itemize{ - \item \url{https://github.com/pharmaR/risk_assessment} - \item Report bugs at \url{https://github.com/pharmaR/risk_assessment/issues} + \item \url{https://github.com/pharmaR/riskassessment} + \item Report bugs at \url{https://github.com/pharmaR/riskassessment/issues} } } @@ -28,10 +28,20 @@ Authors: \itemize{ \item Robert Krajcik \email{robert.krajcik@biogen.com} \item Jeff Thompson \email{jeff.thompson51317@gmail.com} + \item Lars Andersen \email{lars.andersen@boehringer-ingelheim.com} + \item Andrew Borgman \email{andrew.borgman@biogen.com} \item Marly Gotti \email{marly.cormar@biogen.com} \item Maya Gans \email{maya.gans@biogen.com} \item Aravind Reddy Kallem - \item Fission Labs India Pvt Ltd + \item Fission Labs India Pvt Ltd +} + +Other contributors: +\itemize{ + \item Munshi Imran Hossain [contributor] + \item Scott Schumacker \email{scottschu97@gmail.com} [contributor] + \item PSI special interest group Application and Implementation of Methodologies in Statistics [copyright holder, funder] + \item R Validation Hub [copyright holder, funder] } } diff --git a/man/run_app.Rd b/man/run_app.Rd index 06eeb1215..accc5cb58 100644 --- a/man/run_app.Rd +++ b/man/run_app.Rd @@ -9,6 +9,10 @@ run_app( options = list(), enableBookmarking = NULL, uiPattern = "/", + app_ver = NULL, + login_note = NULL, + credentials_db_name = NULL, + assessment_db_name = NULL, ... ) } @@ -33,8 +37,24 @@ request to determine whether the \code{ui} should be used to handle the request. Note that the entire request path must match the regular expression in order for the match to be considered successful.} -\item{...}{arguments to pass to golem_opts. -See \code{?golem::get_golem_options} for more details.} +\item{app_ver}{a "global" variable that is passed to several modules & +reports which details the installed package version when not specified. It +can be overwritten to include a specific version name as a text string.} + +\item{login_note}{a text string to display underneath the auth screen's login +button, provided to guide users} + +\item{credentials_db_name}{a text string that names the credentials databse. +Please make sure name ends with '.sqlite'. For example: 'cred_db.sqlite'.} + +\item{assessment_db_name}{text string that names the credentials databse. +Please make sure name ends with '.sqlite'. For example: 'assess_db.sqlite'.} + +\item{...}{arguments to pass to golem_opts. See \code{?golem::get_golem_options} +for more details.} +} +\value{ +a shiny app object } \description{ Run the Shiny Application diff --git a/man/showComments.Rd b/man/showComments.Rd index 33baaaec9..cf367de97 100644 --- a/man/showComments.Rd +++ b/man/showComments.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fct_helpers.R +% Please edit documentation in R/utils.R \name{showComments} \alias{showComments} \title{showComments} @@ -7,8 +7,14 @@ showComments(pkg_name, comments) } \arguments{ -\item{pkg_name}{a data.frame} +\item{pkg_name}{string name of the package} + +\item{comments}{data.frame comments table entry} +} +\value{ +a formatted string of comments } \description{ Displays formatted comments } +\keyword{internal} diff --git a/man/showHelperMessage.Rd b/man/showHelperMessage.Rd index 46bc6e552..23bba1f0c 100644 --- a/man/showHelperMessage.Rd +++ b/man/showHelperMessage.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fct_helpers.R +% Please edit documentation in R/utils.R \name{showHelperMessage} \alias{showHelperMessage} \title{showHelperMessage} @@ -13,3 +13,4 @@ showHelperMessage(message = "Please select a package") Displays a helper message. By default, it informs the user that he should select a package. } +\keyword{internal} diff --git a/man/sidebarServer.Rd b/man/sidebarServer.Rd index 3a55a4897..832e54c4a 100644 --- a/man/sidebarServer.Rd +++ b/man/sidebarServer.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/sidebar.R +% Please edit documentation in R/mod_sidebar.R \name{sidebarServer} \alias{sidebarServer} \title{Sidebar Server Logic} @@ -17,3 +17,4 @@ sidebarServer(id, user, uploaded_pkgs) Also known as the 'Control Panel', and rightfully so, as it controls most components of the app, central to it's function } +\keyword{internal} diff --git a/man/sidebarUI.Rd b/man/sidebarUI.Rd index 3dfc2f353..e20d02526 100644 --- a/man/sidebarUI.Rd +++ b/man/sidebarUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/sidebar.R +% Please edit documentation in R/mod_sidebar.R \name{sidebarUI} \alias{sidebarUI} \title{Sidebar UI} @@ -8,12 +8,9 @@ sidebarUI(id) } \arguments{ \item{id}{a module id} - -\item{user}{a username} - -\item{uploaded_pkgs}{a vector of packages} } \description{ Also known as the 'Control Panel', and rightfully so, as it controls most components of the app, central to it's function } +\keyword{internal} diff --git a/man/update_metric_weight.Rd b/man/update_metric_weight.Rd deleted file mode 100644 index fcc46ede6..000000000 --- a/man/update_metric_weight.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{update_metric_weight} -\alias{update_metric_weight} -\title{update_metric_weight} -\usage{ -update_metric_weight(metric_name, metric_weight) -} -\arguments{ -\item{metric_name}{a weight, as a string or double} -} -\description{ -update_metric_weight -} diff --git a/man/uploadPackageServer.Rd b/man/uploadPackageServer.Rd index f3af8c8b0..80cf6f642 100644 --- a/man/uploadPackageServer.Rd +++ b/man/uploadPackageServer.Rd @@ -1,14 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/uploadPackage.R +% Please edit documentation in R/mod_uploadPackage.R \name{uploadPackageServer} \alias{uploadPackageServer} \title{Server logic for the 'Upload Package' module} \usage{ -uploadPackageServer(id) +uploadPackageServer(id, user) } \arguments{ \item{id}{a module id} + +\item{user}{a username} } \description{ Server logic for the 'Upload Package' module } +\keyword{internal} diff --git a/man/uploadPackageUI.Rd b/man/uploadPackageUI.Rd index 7e6124401..19d6198d2 100644 --- a/man/uploadPackageUI.Rd +++ b/man/uploadPackageUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/uploadPackage.R +% Please edit documentation in R/mod_uploadPackage.R \name{uploadPackageUI} \alias{uploadPackageUI} \title{'Upload Package' UI} @@ -12,3 +12,4 @@ uploadPackageUI(id) \description{ 'Upload Package' UI } +\keyword{internal} diff --git a/man/upload_package_to_db.Rd b/man/upload_package_to_db.Rd deleted file mode 100644 index c8bfccd37..000000000 --- a/man/upload_package_to_db.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dbupload.R -\name{upload_package_to_db} -\alias{upload_package_to_db} -\title{Upload the general info into DB.} -\usage{ -upload_package_to_db( - name, - version, - title, - description, - authors, - maintainers, - license, - published_on -) -} -\description{ -Upload the general info into DB. -} diff --git a/man/viewCommentsServer.Rd b/man/viewCommentsServer.Rd index 904ba0b48..3ebaaccf9 100644 --- a/man/viewCommentsServer.Rd +++ b/man/viewCommentsServer.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/viewComments.R +% Please edit documentation in R/mod_viewComments.R \name{viewCommentsServer} \alias{viewCommentsServer} \title{viewComment module's server logic} @@ -7,14 +7,15 @@ viewCommentsServer(id, pkg_name, comments, label = "Current Comments") } \arguments{ -\item{id}{a module id name} +\item{id}{the module id name} -\item{pkg_name}{placeholder} +\item{pkg_name}{string name of the package} -\item{comments}{placeholder} +\item{comments}{data.frame comments table entry} -\item{label}{placeholder} +\item{label}{string default: Current Comments} } \description{ viewComment module's server logic } +\keyword{internal} diff --git a/man/viewCommentsUI.Rd b/man/viewCommentsUI.Rd index 008da71bd..248444956 100644 --- a/man/viewCommentsUI.Rd +++ b/man/viewCommentsUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/viewComments.R +% Please edit documentation in R/mod_viewComments.R \name{viewCommentsUI} \alias{viewCommentsUI} \title{The UI for the 'viewComment' module} @@ -13,3 +13,4 @@ viewCommentsUI(id) Module to display comments for the specified metric. The comments will update as the user inserts more comments. } +\keyword{internal} diff --git a/man/weight_risk_comment.Rd b/man/weight_risk_comment.Rd deleted file mode 100644 index 8b0e943bc..000000000 --- a/man/weight_risk_comment.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{weight_risk_comment} -\alias{weight_risk_comment} -\title{weight_risk_comment} -\usage{ -weight_risk_comment(pkg_name) -} -\arguments{ -\item{pkg_name}{a package name, as a string} -} -\description{ -Used to add a comment on every tab saying how the risk and weights changed, -and that the overall comment & final decision may no longer be applicable. -} diff --git a/renv.lock b/renv.lock new file mode 100644 index 000000000..b3edabe97 --- /dev/null +++ b/renv.lock @@ -0,0 +1,2488 @@ +{ + "R": { + "Version": "4.1.2", + "Repositories": [ + { + "Name": "CRAN", + "URL": "https://packagemanager.rstudio.com/cran/2023-02-01" + } + ] + }, + "Packages": { + "AsioHeaders": { + "Package": "AsioHeaders", + "Version": "1.16.1-1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "9305444d113b052089eba3694047d42d", + "Requirements": [] + }, + "BiocManager": { + "Package": "BiocManager", + "Version": "1.30.18", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b1a93bed5debda5775636086fdca017b", + "Requirements": [] + }, + "DBI": { + "Package": "DBI", + "Version": "1.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "dcd1743af4336156873e3ce3c950b8b9", + "Requirements": [] + }, + "DT": { + "Package": "DT", + "Version": "0.23", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "d8f1498dc47763ce4647c8d03214d30b", + "Requirements": [ + "crosstalk", + "htmltools", + "htmlwidgets", + "jquerylib", + "jsonlite", + "magrittr", + "promises" + ] + }, + "MASS": { + "Package": "MASS", + "Version": "7.3-57", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "71476c1d88d1ebdf31580e5a257d5d31", + "Requirements": [] + }, + "Matrix": { + "Package": "Matrix", + "Version": "1.4-1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "699c47c606293bdfbc9fd78a93c9c8fe", + "Requirements": [ + "lattice" + ] + }, + "R.methodsS3": { + "Package": "R.methodsS3", + "Version": "1.8.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "4bf6453323755202d5909697b6f7c109", + "Requirements": [] + }, + "R.oo": { + "Package": "R.oo", + "Version": "1.24.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "5709328352717e2f0a9c012be8a97554", + "Requirements": [ + "R.methodsS3" + ] + }, + "R.utils": { + "Package": "R.utils", + "Version": "2.11.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "a7ecb8e60815c7a18648e84cd121b23a", + "Requirements": [ + "R.methodsS3", + "R.oo" + ] + }, + "R6": { + "Package": "R6", + "Version": "2.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "470851b6d5d0ac559e9d01bb352b4021", + "Requirements": [] + }, + "RColorBrewer": { + "Package": "RColorBrewer", + "Version": "1.1-3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "45f0398006e83a5b10b72a90663d8d8c", + "Requirements": [] + }, + "RSQLite": { + "Package": "RSQLite", + "Version": "2.2.14", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "086113da6af75461b8dc8d916dcf9620", + "Requirements": [ + "DBI", + "Rcpp", + "bit64", + "blob", + "memoise", + "pkgconfig", + "plogr" + ] + }, + "Rcpp": { + "Package": "Rcpp", + "Version": "1.0.8.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "32e79b908fda56ee57fe518a8d37b864", + "Requirements": [] + }, + "askpass": { + "Package": "askpass", + "Version": "1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "e8a22846fff485f0be3770c2da758713", + "Requirements": [ + "sys" + ] + }, + "assertthat": { + "Package": "assertthat", + "Version": "0.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "50c838a310445e954bc13f26f26a6ecf", + "Requirements": [] + }, + "attachment": { + "Package": "attachment", + "Version": "0.2.5", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "32c42cee438011deea573f878a210892", + "Requirements": [ + "cli", + "desc", + "glue", + "knitr", + "magrittr", + "rmarkdown", + "roxygen2", + "stringr", + "withr" + ] + }, + "attempt": { + "Package": "attempt", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "d7421bb5dfeb2676b9e4a5a60c2fcfd2", + "Requirements": [ + "rlang" + ] + }, + "backports": { + "Package": "backports", + "Version": "1.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c39fbec8a30d23e721980b8afb31984c", + "Requirements": [] + }, + "base64enc": { + "Package": "base64enc", + "Version": "0.1-3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "543776ae6848fde2f48ff3816d0628bc", + "Requirements": [] + }, + "billboarder": { + "Package": "billboarder", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "0177b70810cfa18bbc4b619dd576b7b0", + "Requirements": [ + "ggplot2", + "htmltools", + "htmlwidgets", + "jsonlite", + "magrittr", + "rlang", + "scales", + "shiny" + ] + }, + "bit": { + "Package": "bit", + "Version": "4.0.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f36715f14d94678eea9933af927bc15d", + "Requirements": [] + }, + "bit64": { + "Package": "bit64", + "Version": "4.0.5", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "9fe98599ca456d6552421db0d6772d8f", + "Requirements": [ + "bit" + ] + }, + "blob": { + "Package": "blob", + "Version": "1.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "10d231579bc9c06ab1c320618808d4ff", + "Requirements": [ + "rlang", + "vctrs" + ] + }, + "brew": { + "Package": "brew", + "Version": "1.0-7", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "38875ea52350ff4b4c03849fc69736c8", + "Requirements": [] + }, + "brio": { + "Package": "brio", + "Version": "1.1.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "976cf154dfb043c012d87cddd8bca363", + "Requirements": [] + }, + "broom": { + "Package": "broom", + "Version": "0.8.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "fe13cb670e14da57fd7a466578db8ce5", + "Requirements": [ + "backports", + "dplyr", + "ellipsis", + "generics", + "ggplot2", + "glue", + "purrr", + "rlang", + "stringr", + "tibble", + "tidyr" + ] + }, + "bslib": { + "Package": "bslib", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "56ae7e1987b340186a8a5a157c2ec358", + "Requirements": [ + "htmltools", + "jquerylib", + "jsonlite", + "rlang", + "sass" + ] + }, + "cachem": { + "Package": "cachem", + "Version": "1.0.6", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "648c5b3d71e6a37e3043617489a0a0e9", + "Requirements": [ + "fastmap", + "rlang" + ] + }, + "callr": { + "Package": "callr", + "Version": "3.7.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "461aa75a11ce2400245190ef5d3995df", + "Requirements": [ + "R6", + "processx" + ] + }, + "cellranger": { + "Package": "cellranger", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f61dbaec772ccd2e17705c1e872e9e7c", + "Requirements": [ + "rematch", + "tibble" + ] + }, + "checkhelper": { + "Package": "checkhelper", + "Version": "0.0.1.9000", + "Source": "GitHub", + "RemoteType": "github", + "RemoteHost": "api.github.com", + "RemoteRepo": "checkhelper", + "RemoteUsername": "thinkr-open", + "RemoteRef": "HEAD", + "RemoteSha": "d2e4fcada1b094d7af06324f6c54301c7586ffee", + "Hash": "694eebe322e5cbdf101c152ad0a67d28", + "Requirements": [ + "cli", + "desc", + "devtools", + "dplyr", + "glue", + "lifecycle", + "magrittr", + "pkgbuild", + "purrr", + "rcmdcheck", + "roxygen2", + "stringr", + "whisker", + "withr" + ] + }, + "checkmate": { + "Package": "checkmate", + "Version": "2.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "147e4db6909d8814bb30f671b49d7e06", + "Requirements": [ + "backports" + ] + }, + "chromote": { + "Package": "chromote", + "Version": "0.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "785cfc65cd435cc7f7b0cef04e4cf77c", + "Requirements": [ + "R6", + "curl", + "fastmap", + "jsonlite", + "later", + "magrittr", + "processx", + "promises", + "rlang", + "websocket" + ] + }, + "cli": { + "Package": "cli", + "Version": "3.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "23abf173c2b783dcc43379ab9bba00ee", + "Requirements": [ + "glue" + ] + }, + "clipr": { + "Package": "clipr", + "Version": "0.8.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "3f038e5ac7f41d4ac41ce658c85e3042", + "Requirements": [] + }, + "clisymbols": { + "Package": "clisymbols", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "96c01552bfd5661b9bbdefbc762f4bcd", + "Requirements": [] + }, + "colorspace": { + "Package": "colorspace", + "Version": "2.0-3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "bb4341986bc8b914f0f0acf2e4a3f2f7", + "Requirements": [] + }, + "commonmark": { + "Package": "commonmark", + "Version": "1.8.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "2ba81b120c1655ab696c935ef33ea716", + "Requirements": [] + }, + "config": { + "Package": "config", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "31d77b09f63550cee9ecb5a08bf76e8f", + "Requirements": [ + "yaml" + ] + }, + "covr": { + "Package": "covr", + "Version": "3.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "6d80a9fc3c0c8473153b54fa54719dfd", + "Requirements": [ + "crayon", + "digest", + "httr", + "jsonlite", + "rex", + "withr", + "yaml" + ] + }, + "cpp11": { + "Package": "cpp11", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "fa53ce256cd280f468c080a58ea5ba8c", + "Requirements": [] + }, + "crancache": { + "Package": "crancache", + "Version": "0.0.0.9001", + "Source": "GitHub", + "RemoteType": "github", + "RemoteHost": "api.github.com", + "RemoteRepo": "crancache", + "RemoteUsername": "r-lib", + "RemoteRef": "HEAD", + "RemoteSha": "7ea4e479bdf780adadd1bd421a5ca23e5f951697", + "Hash": "795b8389734f11481fdcdf9cdde3002f", + "Requirements": [ + "callr", + "cranlike", + "curl", + "desc", + "digest", + "parsedate", + "rappdirs", + "rematch2", + "withr" + ] + }, + "cranlike": { + "Package": "cranlike", + "Version": "1.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "2a531c8d1d45799fe2e880708dfc1097", + "Requirements": [ + "DBI", + "RSQLite", + "debugme", + "desc" + ] + }, + "cranlogs": { + "Package": "cranlogs", + "Version": "2.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "cfa4eec97df94fd69cb8652368966020", + "Requirements": [ + "httr", + "jsonlite" + ] + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "8dc45fd8a1ee067a92b85ef274e66d6a", + "Requirements": [] + }, + "credentials": { + "Package": "credentials", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "93762d0a34d78e6a025efdbfb5c6bb41", + "Requirements": [ + "askpass", + "curl", + "jsonlite", + "openssl", + "sys" + ] + }, + "crosstalk": { + "Package": "crosstalk", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "6aa54f69598c32177e920eb3402e8293", + "Requirements": [ + "R6", + "htmltools", + "jsonlite", + "lazyeval" + ] + }, + "curl": { + "Package": "curl", + "Version": "4.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "022c42d49c28e95d69ca60446dbabf88", + "Requirements": [] + }, + "data.table": { + "Package": "data.table", + "Version": "1.14.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "36b67b5adf57b292923f5659f5f0c853", + "Requirements": [] + }, + "dbplyr": { + "Package": "dbplyr", + "Version": "2.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "1f37fa4ab2f5f7eded42f78b9a887182", + "Requirements": [ + "DBI", + "R6", + "assertthat", + "blob", + "dplyr", + "ellipsis", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "tibble", + "tidyselect", + "vctrs", + "withr" + ] + }, + "debugme": { + "Package": "debugme", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "2d8a9e4f08f3dd669cb8ddd1eb575959", + "Requirements": [ + "crayon" + ] + }, + "desc": { + "Package": "desc", + "Version": "1.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "eebd27ee58fcc58714eedb7aa07d8ad1", + "Requirements": [ + "R6", + "cli", + "rprojroot" + ] + }, + "devtools": { + "Package": "devtools", + "Version": "2.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "fc35e13bb582e5fe6f63f3d647a4cbe5", + "Requirements": [ + "callr", + "cli", + "desc", + "ellipsis", + "fs", + "httr", + "lifecycle", + "memoise", + "pkgbuild", + "pkgload", + "rcmdcheck", + "remotes", + "rlang", + "roxygen2", + "rstudioapi", + "rversions", + "sessioninfo", + "testthat", + "usethis", + "withr" + ] + }, + "diffobj": { + "Package": "diffobj", + "Version": "0.3.5", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8", + "Requirements": [ + "crayon" + ] + }, + "digest": { + "Package": "digest", + "Version": "0.6.29", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "cf6b206a045a684728c3267ef7596190", + "Requirements": [] + }, + "downlit": { + "Package": "downlit", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "ba63dc9ab5a31f3209892437e40c5f60", + "Requirements": [ + "brio", + "desc", + "digest", + "evaluate", + "fansi", + "memoise", + "rlang", + "vctrs", + "yaml" + ] + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.0.9", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f0bda1627a7f5d3f9a0b5add931596ac", + "Requirements": [ + "R6", + "generics", + "glue", + "lifecycle", + "magrittr", + "pillar", + "rlang", + "tibble", + "tidyselect", + "vctrs" + ] + }, + "dtplyr": { + "Package": "dtplyr", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f5d195cd5fcc0a77499d9da698ef2ea3", + "Requirements": [ + "crayon", + "data.table", + "dplyr", + "ellipsis", + "glue", + "lifecycle", + "rlang", + "tibble", + "tidyselect", + "vctrs" + ] + }, + "ellipsis": { + "Package": "ellipsis", + "Version": "0.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "bb0eec2fe32e88d9e2836c2f73ea2077", + "Requirements": [ + "rlang" + ] + }, + "evaluate": { + "Package": "evaluate", + "Version": "0.15", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "699a7a93d08c962d9f8950b2d7a227f1", + "Requirements": [] + }, + "fansi": { + "Package": "fansi", + "Version": "1.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "83a8afdbe71839506baa9f90eebad7ec", + "Requirements": [] + }, + "farver": { + "Package": "farver", + "Version": "2.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c98eb5133d9cb9e1622b8691487f11bb", + "Requirements": [] + }, + "fastmap": { + "Package": "fastmap", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "77bd60a6157420d4ffa93b27cf6a58b8", + "Requirements": [] + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.5.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "e80750aec5717dedc019ad7ee40e4a7c", + "Requirements": [ + "htmltools", + "rlang" + ] + }, + "forcats": { + "Package": "forcats", + "Version": "0.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "81c3244cab67468aac4c60550832655d", + "Requirements": [ + "ellipsis", + "magrittr", + "rlang", + "tibble" + ] + }, + "formattable": { + "Package": "formattable", + "Version": "0.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "870d6d5d39b23923d0c816f904075b4c", + "Requirements": [ + "htmltools", + "htmlwidgets", + "knitr", + "rmarkdown" + ] + }, + "fs": { + "Package": "fs", + "Version": "1.5.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "7c89603d81793f0d5486d91ab1fc6f1d", + "Requirements": [] + }, + "gargle": { + "Package": "gargle", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "9d234e6a87a6f8181792de6dc4a00e39", + "Requirements": [ + "cli", + "fs", + "glue", + "httr", + "jsonlite", + "rappdirs", + "rlang", + "rstudioapi", + "withr" + ] + }, + "generics": { + "Package": "generics", + "Version": "0.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "177475892cf4a55865868527654a7741", + "Requirements": [] + }, + "gert": { + "Package": "gert", + "Version": "1.6.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "98c014c4c933f23ea5a0321a4d0b588b", + "Requirements": [ + "askpass", + "credentials", + "openssl", + "rstudioapi", + "sys", + "zip" + ] + }, + "ggplot2": { + "Package": "ggplot2", + "Version": "3.3.6", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "0fb26d0674c82705c6b701d1a61e02ea", + "Requirements": [ + "MASS", + "digest", + "glue", + "gtable", + "isoband", + "mgcv", + "rlang", + "scales", + "tibble", + "withr" + ] + }, + "gh": { + "Package": "gh", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "38c2580abbda249bd6afeec00d14f531", + "Requirements": [ + "cli", + "gitcreds", + "httr", + "ini", + "jsonlite" + ] + }, + "gitcreds": { + "Package": "gitcreds", + "Version": "0.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f3aefccc1cc50de6338146b62f115de8", + "Requirements": [] + }, + "glue": { + "Package": "glue", + "Version": "1.6.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "4f2596dfb05dac67b9dc558e5c6fba2e", + "Requirements": [] + }, + "gmailr": { + "Package": "gmailr", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "185e047cb2392acf320b8bc657a55c92", + "Requirements": [ + "base64enc", + "crayon", + "gargle", + "httr", + "jsonlite", + "lifecycle", + "magrittr", + "mime", + "rematch2" + ] + }, + "golem": { + "Package": "golem", + "Version": "0.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b396a44b56209da3733a4a906b0cc457", + "Requirements": [ + "attempt", + "brio", + "cli", + "config", + "crayon", + "desc", + "fs", + "here", + "htmltools", + "pkgload", + "roxygen2", + "rstudioapi", + "shiny", + "usethis", + "yaml" + ] + }, + "googledrive": { + "Package": "googledrive", + "Version": "2.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c3a25adbbfbb03f12e6f88c5fb1f3024", + "Requirements": [ + "cli", + "gargle", + "glue", + "httr", + "jsonlite", + "lifecycle", + "magrittr", + "pillar", + "purrr", + "rlang", + "tibble", + "uuid", + "vctrs", + "withr" + ] + }, + "googlesheets4": { + "Package": "googlesheets4", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "9a6564184dc4a81daea4f1d7ce357c6a", + "Requirements": [ + "cellranger", + "cli", + "curl", + "gargle", + "glue", + "googledrive", + "httr", + "ids", + "magrittr", + "purrr", + "rematch2", + "rlang", + "tibble", + "vctrs" + ] + }, + "gtable": { + "Package": "gtable", + "Version": "0.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "ac5c6baf7822ce8732b343f14c072c4d", + "Requirements": [] + }, + "haven": { + "Package": "haven", + "Version": "2.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "e3058e4ac77f4fa686f68a1838d5b715", + "Requirements": [ + "cli", + "cpp11", + "forcats", + "hms", + "lifecycle", + "readr", + "rlang", + "tibble", + "tidyselect", + "vctrs" + ] + }, + "here": { + "Package": "here", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "24b224366f9c2e7534d2344d10d59211", + "Requirements": [ + "rprojroot" + ] + }, + "highr": { + "Package": "highr", + "Version": "0.9", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "8eb36c8125038e648e5d111c0d7b2ed4", + "Requirements": [ + "xfun" + ] + }, + "hms": { + "Package": "hms", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "5b8a2dd0fdbe2ab4f6081e6c7be6dfca", + "Requirements": [ + "ellipsis", + "lifecycle", + "pkgconfig", + "rlang", + "vctrs" + ] + }, + "htmltools": { + "Package": "htmltools", + "Version": "0.5.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "526c484233f42522278ab06fb185cb26", + "Requirements": [ + "base64enc", + "digest", + "fastmap", + "rlang" + ] + }, + "htmlwidgets": { + "Package": "htmlwidgets", + "Version": "1.5.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "76147821cd3fcd8c4b04e1ef0498e7fb", + "Requirements": [ + "htmltools", + "jsonlite", + "yaml" + ] + }, + "httpuv": { + "Package": "httpuv", + "Version": "1.6.5", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "97fe71f0a4a1c9890e6c2128afa04bc0", + "Requirements": [ + "R6", + "Rcpp", + "later", + "promises" + ] + }, + "httr": { + "Package": "httr", + "Version": "1.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "88d1b310583777edf01ccd1216fb0b2b", + "Requirements": [ + "R6", + "curl", + "jsonlite", + "mime", + "openssl" + ] + }, + "hunspell": { + "Package": "hunspell", + "Version": "3.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "3987784c19192ad0f2261c456d936df1", + "Requirements": [ + "Rcpp", + "digest" + ] + }, + "ids": { + "Package": "ids", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "99df65cfef20e525ed38c3d2577f7190", + "Requirements": [ + "openssl", + "uuid" + ] + }, + "ini": { + "Package": "ini", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "6154ec2223172bce8162d4153cda21f7", + "Requirements": [] + }, + "isoband": { + "Package": "isoband", + "Version": "0.2.5", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "7ab57a6de7f48a8dc84910d1eca42883", + "Requirements": [] + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "5aab57a3bd297eee1c1d862735972182", + "Requirements": [ + "htmltools" + ] + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "1.8.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "d07e729b27b372429d42d24d503613a0", + "Requirements": [] + }, + "knitr": { + "Package": "knitr", + "Version": "1.39", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "029ab7c4badd3cf8af69016b2ba27493", + "Requirements": [ + "evaluate", + "highr", + "stringr", + "xfun", + "yaml" + ] + }, + "labeling": { + "Package": "labeling", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "3d5108641f47470611a32d0bdf357a72", + "Requirements": [] + }, + "later": { + "Package": "later", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "7e7b457d7766bc47f2a5f21cc2984f8e", + "Requirements": [ + "Rcpp", + "rlang" + ] + }, + "lattice": { + "Package": "lattice", + "Version": "0.20-45", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b64cdbb2b340437c4ee047a1f4c4377b", + "Requirements": [] + }, + "lazyeval": { + "Package": "lazyeval", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "d908914ae53b04d4c0c0fd72ecc35370", + "Requirements": [] + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "a6b6d352e3ed897373ab19d8395c98d0", + "Requirements": [ + "glue", + "rlang" + ] + }, + "loggit": { + "Package": "loggit", + "Version": "2.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b50f4bdb63956bf8acfa6839dcd98c13", + "Requirements": [] + }, + "lubridate": { + "Package": "lubridate", + "Version": "1.8.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "2ff5eedb6ee38fb1b81205c73be1be5a", + "Requirements": [ + "cpp11", + "generics" + ] + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "7ce2733a9826b3aeb1775d56fd305472", + "Requirements": [] + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c", + "Requirements": [ + "cachem", + "rlang" + ] + }, + "mgcv": { + "Package": "mgcv", + "Version": "1.8-40", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c6b2fdb18cf68ab613bd564363e1ba0d", + "Requirements": [ + "Matrix", + "nlme" + ] + }, + "mime": { + "Package": "mime", + "Version": "0.12", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "18e9c28c1d3ca1560ce30658b22ce104", + "Requirements": [] + }, + "modelr": { + "Package": "modelr", + "Version": "0.1.8", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "9fd59716311ee82cba83dc2826fc5577", + "Requirements": [ + "broom", + "magrittr", + "purrr", + "rlang", + "tibble", + "tidyr", + "tidyselect", + "vctrs" + ] + }, + "munsell": { + "Package": "munsell", + "Version": "0.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "6dfe8bf774944bd5595785e3229d8771", + "Requirements": [ + "colorspace" + ] + }, + "nlme": { + "Package": "nlme", + "Version": "3.1-157", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "dbca60742be0c9eddc5205e5c7ca1f44", + "Requirements": [ + "lattice" + ] + }, + "openssl": { + "Package": "openssl", + "Version": "2.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "6d3bef2e305f55c705c674653c7d7d3d", + "Requirements": [ + "askpass" + ] + }, + "parsedate": { + "Package": "parsedate", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "4fe511a06367943d4372478cd1c4b395", + "Requirements": [] + }, + "pillar": { + "Package": "pillar", + "Version": "1.7.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "51dfc97e1b7069e9f7e6f83f3589c22e", + "Requirements": [ + "cli", + "crayon", + "ellipsis", + "fansi", + "glue", + "lifecycle", + "rlang", + "utf8", + "vctrs" + ] + }, + "pingr": { + "Package": "pingr", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "e293e79be42ffd336d938937fd3017fb", + "Requirements": [ + "processx" + ] + }, + "pkgbuild": { + "Package": "pkgbuild", + "Version": "1.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "66d2adfed274daf81ccfe77d974c3b9b", + "Requirements": [ + "R6", + "callr", + "cli", + "crayon", + "desc", + "prettyunits", + "rprojroot", + "withr" + ] + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "01f28d4278f15c76cddbea05899c5d6f", + "Requirements": [] + }, + "pkgdown": { + "Package": "pkgdown", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "ec3139021900fa27faae7a821b732bf8", + "Requirements": [ + "bslib", + "callr", + "crayon", + "desc", + "digest", + "downlit", + "fs", + "httr", + "jsonlite", + "magrittr", + "memoise", + "purrr", + "ragg", + "rlang", + "rmarkdown", + "tibble", + "whisker", + "withr", + "xml2", + "yaml" + ] + }, + "pkgload": { + "Package": "pkgload", + "Version": "1.2.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "7533cd805940821bf23eaf3c8d4c1735", + "Requirements": [ + "cli", + "crayon", + "desc", + "rlang", + "rprojroot", + "rstudioapi", + "withr" + ] + }, + "plogr": { + "Package": "plogr", + "Version": "0.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "09eb987710984fc2905c7129c7d85e65", + "Requirements": [] + }, + "plotly": { + "Package": "plotly", + "Version": "4.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "fbb11e44d057996ca5fe40d959cacfb0", + "Requirements": [ + "RColorBrewer", + "base64enc", + "crosstalk", + "data.table", + "digest", + "dplyr", + "ggplot2", + "htmltools", + "htmlwidgets", + "httr", + "jsonlite", + "lazyeval", + "magrittr", + "promises", + "purrr", + "rlang", + "scales", + "tibble", + "tidyr", + "vctrs", + "viridisLite" + ] + }, + "praise": { + "Package": "praise", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "a555924add98c99d2f411e37e7d25e9f", + "Requirements": [] + }, + "prettyunits": { + "Package": "prettyunits", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "95ef9167b75dde9d2ccc3c7528393e7e", + "Requirements": [] + }, + "processx": { + "Package": "processx", + "Version": "3.5.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "8bbae1a548d0d3fdf6647bdd9d35bf6d", + "Requirements": [ + "R6", + "ps" + ] + }, + "progress": { + "Package": "progress", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "14dc9f7a3c91ebb14ec5bb9208a07061", + "Requirements": [ + "R6", + "crayon", + "hms", + "prettyunits" + ] + }, + "promises": { + "Package": "promises", + "Version": "1.2.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "4ab2c43adb4d4699cf3690acd378d75d", + "Requirements": [ + "R6", + "Rcpp", + "later", + "magrittr", + "rlang" + ] + }, + "ps": { + "Package": "ps", + "Version": "1.7.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "eef74b13f32cae6bb0d495e53317c44c", + "Requirements": [] + }, + "purrr": { + "Package": "purrr", + "Version": "0.3.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "97def703420c8ab10d8f0e6c72101e02", + "Requirements": [ + "magrittr", + "rlang" + ] + }, + "qpdf": { + "Package": "qpdf", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "c483a5cbb08463128f1bd714e6e9e914", + "Requirements": [ + "Rcpp", + "askpass", + "curl" + ] + }, + "ragg": { + "Package": "ragg", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "14932bb6f2739c771ca4ceaba6b4248e", + "Requirements": [ + "systemfonts", + "textshaping" + ] + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "5e3c5dc0b071b21fa128676560dbe94d", + "Requirements": [] + }, + "rcmdcheck": { + "Package": "rcmdcheck", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "8f25ebe2ec38b1f2aef3b0d2ef76f6c4", + "Requirements": [ + "R6", + "callr", + "cli", + "curl", + "desc", + "digest", + "pkgbuild", + "prettyunits", + "rprojroot", + "sessioninfo", + "withr", + "xopen" + ] + }, + "readr": { + "Package": "readr", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "9c59de1357dc209868b5feb5c9f0fe2f", + "Requirements": [ + "R6", + "cli", + "clipr", + "cpp11", + "crayon", + "hms", + "lifecycle", + "rlang", + "tibble", + "tzdb", + "vroom" + ] + }, + "readxl": { + "Package": "readxl", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "170c35f745563bb307e963bde0197e4f", + "Requirements": [ + "cellranger", + "cpp11", + "progress", + "tibble" + ] + }, + "rematch": { + "Package": "rematch", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c66b930d20bb6d858cd18e1cebcfae5c", + "Requirements": [] + }, + "rematch2": { + "Package": "rematch2", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "76c9e04c712a05848ae7a23d2f170a40", + "Requirements": [ + "tibble" + ] + }, + "remotes": { + "Package": "remotes", + "Version": "2.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "227045be9aee47e6dda9bb38ac870d67", + "Requirements": [] + }, + "renv": { + "Package": "renv", + "Version": "0.16.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c9e8442ab69bc21c9697ecf856c1e6c7", + "Requirements": [] + }, + "reprex": { + "Package": "reprex", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "911d101becedc0fde495bd910984bdc8", + "Requirements": [ + "callr", + "cli", + "clipr", + "fs", + "glue", + "knitr", + "rlang", + "rmarkdown", + "rstudioapi", + "withr" + ] + }, + "revdepcheck": { + "Package": "revdepcheck", + "Version": "1.0.0.9001", + "Source": "GitHub", + "Remotes": "r-lib/crancache", + "RemoteType": "github", + "RemoteHost": "api.github.com", + "RemoteRepo": "revdepcheck", + "RemoteUsername": "r-lib", + "RemoteRef": "HEAD", + "RemoteSha": "73933982d9bb34244902b80fa95d8a5fd965470e", + "Hash": "0840f4cc4619466fe424153d8426c0be", + "Requirements": [ + "DBI", + "RSQLite", + "assertthat", + "brio", + "callr", + "cli", + "clisymbols", + "crancache", + "crayon", + "curl", + "desc", + "glue", + "gmailr", + "hms", + "httr", + "jsonlite", + "knitr", + "pkgbuild", + "prettyunits", + "processx", + "progress", + "rcmdcheck", + "rematch2", + "remotes", + "rlang", + "sessioninfo", + "tibble", + "whoami", + "withr", + "yaml" + ] + }, + "rex": { + "Package": "rex", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "ae34cd56890607370665bee5bd17812f", + "Requirements": [ + "lazyeval" + ] + }, + "rhub": { + "Package": "rhub", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "977cce19c029acc6d88a1c861f224819", + "Requirements": [ + "R6", + "assertthat", + "callr", + "cli", + "crayon", + "desc", + "digest", + "httr", + "jsonlite", + "parsedate", + "pillar", + "prettyunits", + "processx", + "rappdirs", + "rcmdcheck", + "rematch", + "tibble", + "uuid", + "whoami", + "withr" + ] + }, + "rintrojs": { + "Package": "rintrojs", + "Version": "0.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c93b7efc3f34a5888d9a919f86e77414", + "Requirements": [ + "jsonlite", + "shiny" + ] + }, + "riskmetric": { + "Package": "riskmetric", + "Version": "0.1.2", + "Source": "GitHub", + "RemoteType": "github", + "RemoteHost": "api.github.com", + "RemoteRepo": "riskmetric", + "RemoteUsername": "pharmaR", + "RemoteRef": "HEAD", + "RemoteSha": "527c07a5fbd696e92feacb80c8e438a01c79a922", + "Hash": "1afc10147e2f6db6754ba4203a47d0db", + "Requirements": [ + "BiocManager", + "backports", + "covr", + "cranlogs", + "curl", + "devtools", + "httr", + "memoise", + "pillar", + "pkgload", + "qpdf", + "tibble", + "urltools", + "vctrs", + "xml2" + ] + }, + "rlang": { + "Package": "rlang", + "Version": "1.0.6", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "4ed1f8336c8d52c3e750adcdc57228a7", + "Requirements": [] + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.14", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "31b60a882fabfabf6785b8599ffeb8ba", + "Requirements": [ + "bslib", + "evaluate", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "stringr", + "tinytex", + "xfun", + "yaml" + ] + }, + "roxygen2": { + "Package": "roxygen2", + "Version": "7.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b390c1d54fcd977cda48588e6172daba", + "Requirements": [ + "R6", + "brew", + "cli", + "commonmark", + "cpp11", + "desc", + "digest", + "knitr", + "pkgload", + "purrr", + "rlang", + "stringi", + "stringr", + "withr", + "xml2" + ] + }, + "rprojroot": { + "Package": "rprojroot", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "1de7ab598047a87bba48434ba35d497d", + "Requirements": [] + }, + "rstudioapi": { + "Package": "rstudioapi", + "Version": "0.13", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "06c85365a03fdaf699966cc1d3cf53ea", + "Requirements": [] + }, + "rversions": { + "Package": "rversions", + "Version": "2.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f88fab00907b312f8b23ec13e2d437cb", + "Requirements": [ + "curl", + "xml2" + ] + }, + "rvest": { + "Package": "rvest", + "Version": "1.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "bb099886deffecd6f9b298b7d4492943", + "Requirements": [ + "httr", + "lifecycle", + "magrittr", + "rlang", + "selectr", + "tibble", + "xml2" + ] + }, + "sass": { + "Package": "sass", + "Version": "0.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f37c0028d720bab3c513fd65d28c7234", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ] + }, + "scales": { + "Package": "scales", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "6e8750cdd13477aa440d453da93d5cac", + "Requirements": [ + "R6", + "RColorBrewer", + "farver", + "labeling", + "lifecycle", + "munsell", + "rlang", + "viridisLite" + ] + }, + "scrypt": { + "Package": "scrypt", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "a1d1dfd8769a6cda6087b55430b1a901", + "Requirements": [ + "Rcpp" + ] + }, + "selectr": { + "Package": "selectr", + "Version": "0.4-2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "3838071b66e0c566d55cc26bd6e27bf4", + "Requirements": [ + "R6", + "stringr" + ] + }, + "sessioninfo": { + "Package": "sessioninfo", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "3f9796a8d0a0e8c6eb49a4b029359d1f", + "Requirements": [ + "cli" + ] + }, + "shiny": { + "Package": "shiny", + "Version": "1.7.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "00344c227c7bd0ab5d78052c5d736c44", + "Requirements": [ + "R6", + "bslib", + "cachem", + "commonmark", + "crayon", + "ellipsis", + "fastmap", + "fontawesome", + "glue", + "htmltools", + "httpuv", + "jsonlite", + "later", + "lifecycle", + "mime", + "promises", + "rlang", + "sourcetools", + "withr", + "xtable" + ] + }, + "shinyWidgets": { + "Package": "shinyWidgets", + "Version": "0.7.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "4c00b64347509091f39c01c52f8d9e4c", + "Requirements": [ + "bslib", + "htmltools", + "jsonlite", + "rlang", + "sass", + "shiny" + ] + }, + "shinydashboard": { + "Package": "shinydashboard", + "Version": "0.7.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "e418b532e9bb4eb22a714b9a9f1acee7", + "Requirements": [ + "htmltools", + "promises", + "shiny" + ] + }, + "shinyjs": { + "Package": "shinyjs", + "Version": "2.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "802e4786b353a4bb27116957558548d5", + "Requirements": [ + "digest", + "jsonlite", + "shiny" + ] + }, + "shinymanager": { + "Package": "shinymanager", + "Version": "1.0.400", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "9fd419993e75cf7e12a985e786b02f51", + "Requirements": [ + "DBI", + "DT", + "R.utils", + "R6", + "RSQLite", + "billboarder", + "htmltools", + "openssl", + "scrypt", + "shiny" + ] + }, + "shinytest2": { + "Package": "shinytest2", + "Version": "0.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "1f5b10b1567c31c131b98bb44ab4ea20", + "Requirements": [ + "R6", + "callr", + "checkmate", + "chromote", + "crayon", + "ellipsis", + "fs", + "httr", + "jsonlite", + "pingr", + "rlang", + "rmarkdown", + "shiny", + "testthat", + "withr" + ] + }, + "sourcetools": { + "Package": "sourcetools", + "Version": "0.1.7", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "947e4e02a79effa5d512473e10f41797", + "Requirements": [] + }, + "spelling": { + "Package": "spelling", + "Version": "2.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b8c899a5c83f0d897286550481c91798", + "Requirements": [ + "commonmark", + "hunspell", + "knitr", + "xml2" + ] + }, + "stringi": { + "Package": "stringi", + "Version": "1.7.6", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "bba431031d30789535745a9627ac9271", + "Requirements": [] + }, + "stringr": { + "Package": "stringr", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "0759e6b6c0957edb1311028a49a35e76", + "Requirements": [ + "glue", + "magrittr", + "stringi" + ] + }, + "sys": { + "Package": "sys", + "Version": "3.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b227d13e29222b4574486cfcbde077fa", + "Requirements": [] + }, + "systemfonts": { + "Package": "systemfonts", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "90b28393209827327de889f49935140a", + "Requirements": [ + "cpp11" + ] + }, + "testthat": { + "Package": "testthat", + "Version": "3.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f76c2a02d0fdc24aa7a47ea34261a6e3", + "Requirements": [ + "R6", + "brio", + "callr", + "cli", + "crayon", + "desc", + "digest", + "ellipsis", + "evaluate", + "jsonlite", + "lifecycle", + "magrittr", + "pkgload", + "praise", + "processx", + "ps", + "rlang", + "waldo", + "withr" + ] + }, + "textshaping": { + "Package": "textshaping", + "Version": "0.3.6", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "1ab6223d3670fac7143202cb6a2d43d5", + "Requirements": [ + "cpp11", + "systemfonts" + ] + }, + "tibble": { + "Package": "tibble", + "Version": "3.1.7", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "08415af406e3dd75049afef9552e7355", + "Requirements": [ + "ellipsis", + "fansi", + "lifecycle", + "magrittr", + "pillar", + "pkgconfig", + "rlang", + "vctrs" + ] + }, + "tidyr": { + "Package": "tidyr", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "d8b95b7fee945d7da6888cf7eb71a49c", + "Requirements": [ + "cpp11", + "dplyr", + "ellipsis", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "tibble", + "tidyselect", + "vctrs" + ] + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "17f6da8cfd7002760a859915ce7eef8f", + "Requirements": [ + "ellipsis", + "glue", + "purrr", + "rlang", + "vctrs" + ] + }, + "tidyverse": { + "Package": "tidyverse", + "Version": "1.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "fc4c72b6ae9bb283416bd59a3303bbab", + "Requirements": [ + "broom", + "cli", + "crayon", + "dbplyr", + "dplyr", + "dtplyr", + "forcats", + "ggplot2", + "googledrive", + "googlesheets4", + "haven", + "hms", + "httr", + "jsonlite", + "lubridate", + "magrittr", + "modelr", + "pillar", + "purrr", + "readr", + "readxl", + "reprex", + "rlang", + "rstudioapi", + "rvest", + "stringr", + "tibble", + "tidyr", + "xml2" + ] + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.39", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "29f67ab15405b390b90e56ff22198ead", + "Requirements": [ + "xfun" + ] + }, + "triebeard": { + "Package": "triebeard", + "Version": "0.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "847a9d113b78baca4a9a8639609ea228", + "Requirements": [ + "Rcpp" + ] + }, + "tzdb": { + "Package": "tzdb", + "Version": "0.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b2e1cbce7c903eaf23ec05c58e59fb5e", + "Requirements": [ + "cpp11" + ] + }, + "urlchecker": { + "Package": "urlchecker", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "409328b8e1253c8d729a7836fe7f7a16", + "Requirements": [ + "cli", + "curl", + "xml2" + ] + }, + "urltools": { + "Package": "urltools", + "Version": "1.7.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "e86a704261a105f4703f653e05defa3e", + "Requirements": [ + "Rcpp", + "triebeard" + ] + }, + "usethis": { + "Package": "usethis", + "Version": "2.1.6", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "a67a22c201832b12c036cc059f1d137d", + "Requirements": [ + "cli", + "clipr", + "crayon", + "curl", + "desc", + "fs", + "gert", + "gh", + "glue", + "jsonlite", + "lifecycle", + "purrr", + "rappdirs", + "rlang", + "rprojroot", + "rstudioapi", + "whisker", + "withr", + "yaml" + ] + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c9c462b759a5cc844ae25b5942654d13", + "Requirements": [] + }, + "uuid": { + "Package": "uuid", + "Version": "1.1-0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f1cb46c157d080b729159d407be83496", + "Requirements": [] + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "8b54f22e2a58c4f275479c92ce041a57", + "Requirements": [ + "cli", + "glue", + "rlang" + ] + }, + "viridisLite": { + "Package": "viridisLite", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "55e157e2aa88161bdb0754218470d204", + "Requirements": [] + }, + "vroom": { + "Package": "vroom", + "Version": "1.5.7", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "976507b5a105bc3bdf6a5a5f29e0684f", + "Requirements": [ + "bit64", + "cli", + "cpp11", + "crayon", + "glue", + "hms", + "lifecycle", + "progress", + "rlang", + "tibble", + "tidyselect", + "tzdb", + "vctrs", + "withr" + ] + }, + "waldo": { + "Package": "waldo", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "035fba89d0c86e2113120f93301b98ad", + "Requirements": [ + "cli", + "diffobj", + "fansi", + "glue", + "rematch2", + "rlang", + "tibble" + ] + }, + "websocket": { + "Package": "websocket", + "Version": "1.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "76e0d400757e318cca33def29ccebbc2", + "Requirements": [ + "AsioHeaders", + "R6", + "cpp11", + "later" + ] + }, + "whisker": { + "Package": "whisker", + "Version": "0.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "ca970b96d894e90397ed20637a0c1bbe", + "Requirements": [] + }, + "whoami": { + "Package": "whoami", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "ef0f4d9b8f2cc2ebeccae1d725b8a023", + "Requirements": [ + "httr", + "jsonlite" + ] + }, + "withr": { + "Package": "withr", + "Version": "2.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c0e49a9760983e81e55cdd9be92e7182", + "Requirements": [] + }, + "xfun": { + "Package": "xfun", + "Version": "0.36", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "f5baec54606751aa53ac9c0e05848ed6", + "Requirements": [] + }, + "xml2": { + "Package": "xml2", + "Version": "1.3.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "40682ed6a969ea5abfd351eb67833adc", + "Requirements": [] + }, + "xopen": { + "Package": "xopen", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "6c85f015dee9cc7710ddd20f86881f58", + "Requirements": [ + "processx" + ] + }, + "xtable": { + "Package": "xtable", + "Version": "1.8-4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b8acdf8af494d9ec19ccb2481a9b11c2", + "Requirements": [] + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.5", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "458bb38374d73bf83b1bb85e353da200", + "Requirements": [] + }, + "zip": { + "Package": "zip", + "Version": "2.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c7eef2996ac270a18c2715c997a727c5", + "Requirements": [] + } + } +} diff --git a/renv/.gitignore b/renv/.gitignore new file mode 100644 index 000000000..0ec0cbba2 --- /dev/null +++ b/renv/.gitignore @@ -0,0 +1,7 @@ +library/ +local/ +cellar/ +lock/ +python/ +sandbox/ +staging/ diff --git a/renv/activate.R b/renv/activate.R new file mode 100644 index 000000000..019b5a669 --- /dev/null +++ b/renv/activate.R @@ -0,0 +1,994 @@ + +local({ + + # the requested version of renv + version <- "0.16.0" + + # the project directory + project <- getwd() + + # figure out whether the autoloader is enabled + enabled <- local({ + + # first, check config option + override <- getOption("renv.config.autoloader.enabled") + if (!is.null(override)) + return(override) + + # next, check environment variables + # TODO: prefer using the configuration one in the future + envvars <- c( + "RENV_CONFIG_AUTOLOADER_ENABLED", + "RENV_AUTOLOADER_ENABLED", + "RENV_ACTIVATE_PROJECT" + ) + + for (envvar in envvars) { + envval <- Sys.getenv(envvar, unset = NA) + if (!is.na(envval)) + return(tolower(envval) %in% c("true", "t", "1")) + } + + # enable by default + TRUE + + }) + + if (!enabled) + return(FALSE) + + # avoid recursion + if (identical(getOption("renv.autoloader.running"), TRUE)) { + warning("ignoring recursive attempt to run renv autoloader") + return(invisible(TRUE)) + } + + # signal that we're loading renv during R startup + options(renv.autoloader.running = TRUE) + on.exit(options(renv.autoloader.running = NULL), add = TRUE) + + # signal that we've consented to use renv + options(renv.consent = TRUE) + + # load the 'utils' package eagerly -- this ensures that renv shims, which + # mask 'utils' packages, will come first on the search path + library(utils, lib.loc = .Library) + + # unload renv if it's already been loaded + if ("renv" %in% loadedNamespaces()) + unloadNamespace("renv") + + # load bootstrap tools + `%||%` <- function(x, y) { + if (is.environment(x) || length(x)) x else y + } + + bootstrap <- function(version, library) { + + # attempt to download renv + tarball <- tryCatch(renv_bootstrap_download(version), error = identity) + if (inherits(tarball, "error")) + stop("failed to download renv ", version) + + # now attempt to install + status <- tryCatch(renv_bootstrap_install(version, tarball, library), error = identity) + if (inherits(status, "error")) + stop("failed to install renv ", version) + + } + + renv_bootstrap_tests_running <- function() { + getOption("renv.tests.running", default = FALSE) + } + + renv_bootstrap_repos <- function() { + + # check for repos override + repos <- Sys.getenv("RENV_CONFIG_REPOS_OVERRIDE", unset = NA) + if (!is.na(repos)) + return(repos) + + # check for lockfile repositories + repos <- tryCatch(renv_bootstrap_repos_lockfile(), error = identity) + if (!inherits(repos, "error") && length(repos)) + return(repos) + + # if we're testing, re-use the test repositories + if (renv_bootstrap_tests_running()) + return(getOption("renv.tests.repos")) + + # retrieve current repos + repos <- getOption("repos") + + # ensure @CRAN@ entries are resolved + repos[repos == "@CRAN@"] <- getOption( + "renv.repos.cran", + "https://cloud.r-project.org" + ) + + # add in renv.bootstrap.repos if set + default <- c(FALLBACK = "https://cloud.r-project.org") + extra <- getOption("renv.bootstrap.repos", default = default) + repos <- c(repos, extra) + + # remove duplicates that might've snuck in + dupes <- duplicated(repos) | duplicated(names(repos)) + repos[!dupes] + + } + + renv_bootstrap_repos_lockfile <- function() { + + lockpath <- Sys.getenv("RENV_PATHS_LOCKFILE", unset = "renv.lock") + if (!file.exists(lockpath)) + return(NULL) + + lockfile <- tryCatch(renv_json_read(lockpath), error = identity) + if (inherits(lockfile, "error")) { + warning(lockfile) + return(NULL) + } + + repos <- lockfile$R$Repositories + if (length(repos) == 0) + return(NULL) + + keys <- vapply(repos, `[[`, "Name", FUN.VALUE = character(1)) + vals <- vapply(repos, `[[`, "URL", FUN.VALUE = character(1)) + names(vals) <- keys + + return(vals) + + } + + renv_bootstrap_download <- function(version) { + + # if the renv version number has 4 components, assume it must + # be retrieved via github + nv <- numeric_version(version) + components <- unclass(nv)[[1]] + + # if this appears to be a development version of 'renv', we'll + # try to restore from github + dev <- length(components) == 4L + + # begin collecting different methods for finding renv + methods <- c( + renv_bootstrap_download_tarball, + if (dev) + renv_bootstrap_download_github + else c( + renv_bootstrap_download_cran_latest, + renv_bootstrap_download_cran_archive + ) + ) + + for (method in methods) { + path <- tryCatch(method(version), error = identity) + if (is.character(path) && file.exists(path)) + return(path) + } + + stop("failed to download renv ", version) + + } + + renv_bootstrap_download_impl <- function(url, destfile) { + + mode <- "wb" + + # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17715 + fixup <- + Sys.info()[["sysname"]] == "Windows" && + substring(url, 1L, 5L) == "file:" + + if (fixup) + mode <- "w+b" + + args <- list( + url = url, + destfile = destfile, + mode = mode, + quiet = TRUE + ) + + if ("headers" %in% names(formals(utils::download.file))) + args$headers <- renv_bootstrap_download_custom_headers(url) + + do.call(utils::download.file, args) + + } + + renv_bootstrap_download_custom_headers <- function(url) { + + headers <- getOption("renv.download.headers") + if (is.null(headers)) + return(character()) + + if (!is.function(headers)) + stopf("'renv.download.headers' is not a function") + + headers <- headers(url) + if (length(headers) == 0L) + return(character()) + + if (is.list(headers)) + headers <- unlist(headers, recursive = FALSE, use.names = TRUE) + + ok <- + is.character(headers) && + is.character(names(headers)) && + all(nzchar(names(headers))) + + if (!ok) + stop("invocation of 'renv.download.headers' did not return a named character vector") + + headers + + } + + renv_bootstrap_download_cran_latest <- function(version) { + + spec <- renv_bootstrap_download_cran_latest_find(version) + type <- spec$type + repos <- spec$repos + + message("* Downloading renv ", version, " ... ", appendLF = FALSE) + + baseurl <- utils::contrib.url(repos = repos, type = type) + ext <- if (identical(type, "source")) + ".tar.gz" + else if (Sys.info()[["sysname"]] == "Windows") + ".zip" + else + ".tgz" + name <- sprintf("renv_%s%s", version, ext) + url <- paste(baseurl, name, sep = "/") + + destfile <- file.path(tempdir(), name) + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (inherits(status, "condition")) { + message("FAILED") + return(FALSE) + } + + # report success and return + message("OK (downloaded ", type, ")") + destfile + + } + + renv_bootstrap_download_cran_latest_find <- function(version) { + + # check whether binaries are supported on this system + binary <- + getOption("renv.bootstrap.binary", default = TRUE) && + !identical(.Platform$pkgType, "source") && + !identical(getOption("pkgType"), "source") && + Sys.info()[["sysname"]] %in% c("Darwin", "Windows") + + types <- c(if (binary) "binary", "source") + + # iterate over types + repositories + for (type in types) { + for (repos in renv_bootstrap_repos()) { + + # retrieve package database + db <- tryCatch( + as.data.frame( + utils::available.packages(type = type, repos = repos), + stringsAsFactors = FALSE + ), + error = identity + ) + + if (inherits(db, "error")) + next + + # check for compatible entry + entry <- db[db$Package %in% "renv" & db$Version %in% version, ] + if (nrow(entry) == 0) + next + + # found it; return spec to caller + spec <- list(entry = entry, type = type, repos = repos) + return(spec) + + } + } + + # if we got here, we failed to find renv + fmt <- "renv %s is not available from your declared package repositories" + stop(sprintf(fmt, version)) + + } + + renv_bootstrap_download_cran_archive <- function(version) { + + name <- sprintf("renv_%s.tar.gz", version) + repos <- renv_bootstrap_repos() + urls <- file.path(repos, "src/contrib/Archive/renv", name) + destfile <- file.path(tempdir(), name) + + message("* Downloading renv ", version, " ... ", appendLF = FALSE) + + for (url in urls) { + + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (identical(status, 0L)) { + message("OK") + return(destfile) + } + + } + + message("FAILED") + return(FALSE) + + } + + renv_bootstrap_download_tarball <- function(version) { + + # if the user has provided the path to a tarball via + # an environment variable, then use it + tarball <- Sys.getenv("RENV_BOOTSTRAP_TARBALL", unset = NA) + if (is.na(tarball)) + return() + + # allow directories + info <- file.info(tarball, extra_cols = FALSE) + if (identical(info$isdir, TRUE)) { + name <- sprintf("renv_%s.tar.gz", version) + tarball <- file.path(tarball, name) + } + + # bail if it doesn't exist + if (!file.exists(tarball)) { + + # let the user know we weren't able to honour their request + fmt <- "* RENV_BOOTSTRAP_TARBALL is set (%s) but does not exist." + msg <- sprintf(fmt, tarball) + warning(msg) + + # bail + return() + + } + + fmt <- "* Bootstrapping with tarball at path '%s'." + msg <- sprintf(fmt, tarball) + message(msg) + + tarball + + } + + renv_bootstrap_download_github <- function(version) { + + enabled <- Sys.getenv("RENV_BOOTSTRAP_FROM_GITHUB", unset = "TRUE") + if (!identical(enabled, "TRUE")) + return(FALSE) + + # prepare download options + pat <- Sys.getenv("GITHUB_PAT") + if (nzchar(Sys.which("curl")) && nzchar(pat)) { + fmt <- "--location --fail --header \"Authorization: token %s\"" + extra <- sprintf(fmt, pat) + saved <- options("download.file.method", "download.file.extra") + options(download.file.method = "curl", download.file.extra = extra) + on.exit(do.call(base::options, saved), add = TRUE) + } else if (nzchar(Sys.which("wget")) && nzchar(pat)) { + fmt <- "--header=\"Authorization: token %s\"" + extra <- sprintf(fmt, pat) + saved <- options("download.file.method", "download.file.extra") + options(download.file.method = "wget", download.file.extra = extra) + on.exit(do.call(base::options, saved), add = TRUE) + } + + message("* Downloading renv ", version, " from GitHub ... ", appendLF = FALSE) + + url <- file.path("https://api.github.com/repos/rstudio/renv/tarball", version) + name <- sprintf("renv_%s.tar.gz", version) + destfile <- file.path(tempdir(), name) + + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (!identical(status, 0L)) { + message("FAILED") + return(FALSE) + } + + message("OK") + return(destfile) + + } + + renv_bootstrap_install <- function(version, tarball, library) { + + # attempt to install it into project library + message("* Installing renv ", version, " ... ", appendLF = FALSE) + dir.create(library, showWarnings = FALSE, recursive = TRUE) + + # invoke using system2 so we can capture and report output + bin <- R.home("bin") + exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R" + r <- file.path(bin, exe) + + args <- c( + "--vanilla", "CMD", "INSTALL", "--no-multiarch", + "-l", shQuote(path.expand(library)), + shQuote(path.expand(tarball)) + ) + + output <- system2(r, args, stdout = TRUE, stderr = TRUE) + message("Done!") + + # check for successful install + status <- attr(output, "status") + if (is.numeric(status) && !identical(status, 0L)) { + header <- "Error installing renv:" + lines <- paste(rep.int("=", nchar(header)), collapse = "") + text <- c(header, lines, output) + writeLines(text, con = stderr()) + } + + status + + } + + renv_bootstrap_platform_prefix <- function() { + + # construct version prefix + version <- paste(R.version$major, R.version$minor, sep = ".") + prefix <- paste("R", numeric_version(version)[1, 1:2], sep = "-") + + # include SVN revision for development versions of R + # (to avoid sharing platform-specific artefacts with released versions of R) + devel <- + identical(R.version[["status"]], "Under development (unstable)") || + identical(R.version[["nickname"]], "Unsuffered Consequences") + + if (devel) + prefix <- paste(prefix, R.version[["svn rev"]], sep = "-r") + + # build list of path components + components <- c(prefix, R.version$platform) + + # include prefix if provided by user + prefix <- renv_bootstrap_platform_prefix_impl() + if (!is.na(prefix) && nzchar(prefix)) + components <- c(prefix, components) + + # build prefix + paste(components, collapse = "/") + + } + + renv_bootstrap_platform_prefix_impl <- function() { + + # if an explicit prefix has been supplied, use it + prefix <- Sys.getenv("RENV_PATHS_PREFIX", unset = NA) + if (!is.na(prefix)) + return(prefix) + + # if the user has requested an automatic prefix, generate it + auto <- Sys.getenv("RENV_PATHS_PREFIX_AUTO", unset = NA) + if (auto %in% c("TRUE", "True", "true", "1")) + return(renv_bootstrap_platform_prefix_auto()) + + # empty string on failure + "" + + } + + renv_bootstrap_platform_prefix_auto <- function() { + + prefix <- tryCatch(renv_bootstrap_platform_os(), error = identity) + if (inherits(prefix, "error") || prefix %in% "unknown") { + + msg <- paste( + "failed to infer current operating system", + "please file a bug report at https://github.com/rstudio/renv/issues", + sep = "; " + ) + + warning(msg) + + } + + prefix + + } + + renv_bootstrap_platform_os <- function() { + + sysinfo <- Sys.info() + sysname <- sysinfo[["sysname"]] + + # handle Windows + macOS up front + if (sysname == "Windows") + return("windows") + else if (sysname == "Darwin") + return("macos") + + # check for os-release files + for (file in c("/etc/os-release", "/usr/lib/os-release")) + if (file.exists(file)) + return(renv_bootstrap_platform_os_via_os_release(file, sysinfo)) + + # check for redhat-release files + if (file.exists("/etc/redhat-release")) + return(renv_bootstrap_platform_os_via_redhat_release()) + + "unknown" + + } + + renv_bootstrap_platform_os_via_os_release <- function(file, sysinfo) { + + # read /etc/os-release + release <- utils::read.table( + file = file, + sep = "=", + quote = c("\"", "'"), + col.names = c("Key", "Value"), + comment.char = "#", + stringsAsFactors = FALSE + ) + + vars <- as.list(release$Value) + names(vars) <- release$Key + + # get os name + os <- tolower(sysinfo[["sysname"]]) + + # read id + id <- "unknown" + for (field in c("ID", "ID_LIKE")) { + if (field %in% names(vars) && nzchar(vars[[field]])) { + id <- vars[[field]] + break + } + } + + # read version + version <- "unknown" + for (field in c("UBUNTU_CODENAME", "VERSION_CODENAME", "VERSION_ID", "BUILD_ID")) { + if (field %in% names(vars) && nzchar(vars[[field]])) { + version <- vars[[field]] + break + } + } + + # join together + paste(c(os, id, version), collapse = "-") + + } + + renv_bootstrap_platform_os_via_redhat_release <- function() { + + # read /etc/redhat-release + contents <- readLines("/etc/redhat-release", warn = FALSE) + + # infer id + id <- if (grepl("centos", contents, ignore.case = TRUE)) + "centos" + else if (grepl("redhat", contents, ignore.case = TRUE)) + "redhat" + else + "unknown" + + # try to find a version component (very hacky) + version <- "unknown" + + parts <- strsplit(contents, "[[:space:]]")[[1L]] + for (part in parts) { + + nv <- tryCatch(numeric_version(part), error = identity) + if (inherits(nv, "error")) + next + + version <- nv[1, 1] + break + + } + + paste(c("linux", id, version), collapse = "-") + + } + + renv_bootstrap_library_root_name <- function(project) { + + # use project name as-is if requested + asis <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT_ASIS", unset = "FALSE") + if (asis) + return(basename(project)) + + # otherwise, disambiguate based on project's path + id <- substring(renv_bootstrap_hash_text(project), 1L, 8L) + paste(basename(project), id, sep = "-") + + } + + renv_bootstrap_library_root <- function(project) { + + prefix <- renv_bootstrap_profile_prefix() + + path <- Sys.getenv("RENV_PATHS_LIBRARY", unset = NA) + if (!is.na(path)) + return(paste(c(path, prefix), collapse = "/")) + + path <- renv_bootstrap_library_root_impl(project) + if (!is.null(path)) { + name <- renv_bootstrap_library_root_name(project) + return(paste(c(path, prefix, name), collapse = "/")) + } + + renv_bootstrap_paths_renv("library", project = project) + + } + + renv_bootstrap_library_root_impl <- function(project) { + + root <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT", unset = NA) + if (!is.na(root)) + return(root) + + type <- renv_bootstrap_project_type(project) + if (identical(type, "package")) { + userdir <- renv_bootstrap_user_dir() + return(file.path(userdir, "library")) + } + + } + + renv_bootstrap_validate_version <- function(version) { + + loadedversion <- utils::packageDescription("renv", fields = "Version") + if (version == loadedversion) + return(TRUE) + + # assume four-component versions are from GitHub; three-component + # versions are from CRAN + components <- strsplit(loadedversion, "[.-]")[[1]] + remote <- if (length(components) == 4L) + paste("rstudio/renv", loadedversion, sep = "@") + else + paste("renv", loadedversion, sep = "@") + + fmt <- paste( + "renv %1$s was loaded from project library, but this project is configured to use renv %2$s.", + "Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile.", + "Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library.", + sep = "\n" + ) + + msg <- sprintf(fmt, loadedversion, version, remote) + warning(msg, call. = FALSE) + + FALSE + + } + + renv_bootstrap_hash_text <- function(text) { + + hashfile <- tempfile("renv-hash-") + on.exit(unlink(hashfile), add = TRUE) + + writeLines(text, con = hashfile) + tools::md5sum(hashfile) + + } + + renv_bootstrap_load <- function(project, libpath, version) { + + # try to load renv from the project library + if (!requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) + return(FALSE) + + # warn if the version of renv loaded does not match + renv_bootstrap_validate_version(version) + + # load the project + renv::load(project) + + TRUE + + } + + renv_bootstrap_profile_load <- function(project) { + + # if RENV_PROFILE is already set, just use that + profile <- Sys.getenv("RENV_PROFILE", unset = NA) + if (!is.na(profile) && nzchar(profile)) + return(profile) + + # check for a profile file (nothing to do if it doesn't exist) + path <- renv_bootstrap_paths_renv("profile", profile = FALSE, project = project) + if (!file.exists(path)) + return(NULL) + + # read the profile, and set it if it exists + contents <- readLines(path, warn = FALSE) + if (length(contents) == 0L) + return(NULL) + + # set RENV_PROFILE + profile <- contents[[1L]] + if (!profile %in% c("", "default")) + Sys.setenv(RENV_PROFILE = profile) + + profile + + } + + renv_bootstrap_profile_prefix <- function() { + profile <- renv_bootstrap_profile_get() + if (!is.null(profile)) + return(file.path("profiles", profile, "renv")) + } + + renv_bootstrap_profile_get <- function() { + profile <- Sys.getenv("RENV_PROFILE", unset = "") + renv_bootstrap_profile_normalize(profile) + } + + renv_bootstrap_profile_set <- function(profile) { + profile <- renv_bootstrap_profile_normalize(profile) + if (is.null(profile)) + Sys.unsetenv("RENV_PROFILE") + else + Sys.setenv(RENV_PROFILE = profile) + } + + renv_bootstrap_profile_normalize <- function(profile) { + + if (is.null(profile) || profile %in% c("", "default")) + return(NULL) + + profile + + } + + renv_bootstrap_path_absolute <- function(path) { + + substr(path, 1L, 1L) %in% c("~", "/", "\\") || ( + substr(path, 1L, 1L) %in% c(letters, LETTERS) && + substr(path, 2L, 3L) %in% c(":/", ":\\") + ) + + } + + renv_bootstrap_paths_renv <- function(..., profile = TRUE, project = NULL) { + renv <- Sys.getenv("RENV_PATHS_RENV", unset = "renv") + root <- if (renv_bootstrap_path_absolute(renv)) NULL else project + prefix <- if (profile) renv_bootstrap_profile_prefix() + components <- c(root, renv, prefix, ...) + paste(components, collapse = "/") + } + + renv_bootstrap_project_type <- function(path) { + + descpath <- file.path(path, "DESCRIPTION") + if (!file.exists(descpath)) + return("unknown") + + desc <- tryCatch( + read.dcf(descpath, all = TRUE), + error = identity + ) + + if (inherits(desc, "error")) + return("unknown") + + type <- desc$Type + if (!is.null(type)) + return(tolower(type)) + + package <- desc$Package + if (!is.null(package)) + return("package") + + "unknown" + + } + + renv_bootstrap_user_dir <- function() { + dir <- renv_bootstrap_user_dir_impl() + path.expand(chartr("\\", "/", dir)) + } + + renv_bootstrap_user_dir_impl <- function() { + + # use local override if set + override <- getOption("renv.userdir.override") + if (!is.null(override)) + return(override) + + # use R_user_dir if available + tools <- asNamespace("tools") + if (is.function(tools$R_user_dir)) + return(tools$R_user_dir("renv", "cache")) + + # try using our own backfill for older versions of R + envvars <- c("R_USER_CACHE_DIR", "XDG_CACHE_HOME") + for (envvar in envvars) { + root <- Sys.getenv(envvar, unset = NA) + if (!is.na(root)) + return(file.path(root, "R/renv")) + } + + # use platform-specific default fallbacks + if (Sys.info()[["sysname"]] == "Windows") + file.path(Sys.getenv("LOCALAPPDATA"), "R/cache/R/renv") + else if (Sys.info()[["sysname"]] == "Darwin") + "~/Library/Caches/org.R-project.R/R/renv" + else + "~/.cache/R/renv" + + } + + + renv_json_read <- function(file = NULL, text = NULL) { + + # if jsonlite is loaded, use that instead + if ("jsonlite" %in% loadedNamespaces()) + renv_json_read_jsonlite(file, text) + else + renv_json_read_default(file, text) + + } + + renv_json_read_jsonlite <- function(file = NULL, text = NULL) { + text <- paste(text %||% read(file), collapse = "\n") + jsonlite::fromJSON(txt = text, simplifyVector = FALSE) + } + + renv_json_read_default <- function(file = NULL, text = NULL) { + + # find strings in the JSON + text <- paste(text %||% read(file), collapse = "\n") + pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]' + locs <- gregexpr(pattern, text, perl = TRUE)[[1]] + + # if any are found, replace them with placeholders + replaced <- text + strings <- character() + replacements <- character() + + if (!identical(c(locs), -1L)) { + + # get the string values + starts <- locs + ends <- locs + attr(locs, "match.length") - 1L + strings <- substring(text, starts, ends) + + # only keep those requiring escaping + strings <- grep("[[\\]{}:]", strings, perl = TRUE, value = TRUE) + + # compute replacements + replacements <- sprintf('"\032%i\032"', seq_along(strings)) + + # replace the strings + mapply(function(string, replacement) { + replaced <<- sub(string, replacement, replaced, fixed = TRUE) + }, strings, replacements) + + } + + # transform the JSON into something the R parser understands + transformed <- replaced + transformed <- gsub("{}", "`names<-`(list(), character())", transformed, fixed = TRUE) + transformed <- gsub("[[{]", "list(", transformed, perl = TRUE) + transformed <- gsub("[]}]", ")", transformed, perl = TRUE) + transformed <- gsub(":", "=", transformed, fixed = TRUE) + text <- paste(transformed, collapse = "\n") + + # parse it + json <- parse(text = text, keep.source = FALSE, srcfile = NULL)[[1L]] + + # construct map between source strings, replaced strings + map <- as.character(parse(text = strings)) + names(map) <- as.character(parse(text = replacements)) + + # convert to list + map <- as.list(map) + + # remap strings in object + remapped <- renv_json_remap(json, map) + + # evaluate + eval(remapped, envir = baseenv()) + + } + + renv_json_remap <- function(json, map) { + + # fix names + if (!is.null(names(json))) { + lhs <- match(names(json), names(map), nomatch = 0L) + rhs <- match(names(map), names(json), nomatch = 0L) + names(json)[rhs] <- map[lhs] + } + + # fix values + if (is.character(json)) + return(map[[json]] %||% json) + + # handle true, false, null + if (is.name(json)) { + text <- as.character(json) + if (text == "true") + return(TRUE) + else if (text == "false") + return(FALSE) + else if (text == "null") + return(NULL) + } + + # recurse + if (is.recursive(json)) { + for (i in seq_along(json)) { + json[i] <- list(renv_json_remap(json[[i]], map)) + } + } + + json + + } + + # load the renv profile, if any + renv_bootstrap_profile_load(project) + + # construct path to library root + root <- renv_bootstrap_library_root(project) + + # construct library prefix for platform + prefix <- renv_bootstrap_platform_prefix() + + # construct full libpath + libpath <- file.path(root, prefix) + + # attempt to load + if (renv_bootstrap_load(project, libpath, version)) + return(TRUE) + + # load failed; inform user we're about to bootstrap + prefix <- paste("# Bootstrapping renv", version) + postfix <- paste(rep.int("-", 77L - nchar(prefix)), collapse = "") + header <- paste(prefix, postfix) + message(header) + + # perform bootstrap + bootstrap(version, libpath) + + # exit early if we're just testing bootstrap + if (!is.na(Sys.getenv("RENV_BOOTSTRAP_INSTALL_ONLY", unset = NA))) + return(TRUE) + + # try again to load + if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) { + message("* Successfully installed and loaded renv ", version, ".") + return(renv::load()) + } + + # failed to download or load renv; warn the user + msg <- c( + "Failed to find an renv installation: the project will not be loaded.", + "Use `renv::activate()` to re-initialize the project." + ) + + warning(paste(msg, collapse = "\n"), call. = FALSE) + +}) diff --git a/renv/settings.dcf b/renv/settings.dcf new file mode 100644 index 000000000..cf0cf3653 --- /dev/null +++ b/renv/settings.dcf @@ -0,0 +1,10 @@ +bioconductor.version: +external.libraries: +ignored.packages: riskassessment, rsconnect +package.dependency.fields: Imports, Depends, LinkingTo +r.version: +snapshot.type: implicit +use.cache: TRUE +vcs.ignore.cellar: TRUE +vcs.ignore.library: TRUE +vcs.ignore.local: TRUE diff --git a/risk_assessment.Rproj b/riskassessment.Rproj similarity index 100% rename from risk_assessment.Rproj rename to riskassessment.Rproj diff --git a/tests/spelling.R b/tests/spelling.R index 6713838fc..7441f5027 100644 --- a/tests/spelling.R +++ b/tests/spelling.R @@ -1,3 +1,8 @@ if(requireNamespace('spelling', quietly = TRUE)) - spelling::spell_check_test(vignettes = TRUE, error = FALSE, + spelling::spell_check_test(vignettes = TRUE, error = TRUE, skip_on_cran = TRUE) +# To check for spelling mistakes: +# spelling::spell_check_package() + +# To add remainging (un-correctable) words to the wordlist: +# spelling::update_wordlist() diff --git a/tests/testthat.R b/tests/testthat.R index a83610981..ed11ea8a7 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,8 @@ library(testthat) library(riskassessment) +# Load application support files into testing environment +library(shinytest2) +options(shinytest2.load_timeout = 30*1000) +options(shinytest2.timeout = 30*1000) test_check("riskassessment") diff --git a/tests/testthat/test-addComment.R b/tests/testthat/test-addComment.R new file mode 100644 index 000000000..190efe758 --- /dev/null +++ b/tests/testthat/test-addComment.R @@ -0,0 +1,177 @@ + +test_that("Comments can be added via the addComment module", { + # delete app DB if exists to ensure clean test + app_db_loc <- test_path("test-apps", "database.sqlite") + if (file.exists(app_db_loc)) { + file.remove(app_db_loc) + } + + # copy in already instantiated database to avoid need to rebuild + # this is a database that has been built via inst/testdata/upload_format.csv + test_db_loc <- system.file("testdata", "upload_format.database", package = "riskassessment") + file.copy( + test_db_loc, + app_db_loc + ) + + # confirm no comments exist in the database + con <- DBI::dbConnect(RSQLite::SQLite(), app_db_loc) + comments <- DBI::dbGetQuery(con, "select * from comments") + expect_equal( + nrow(comments), + 0 + ) + + # set up new app driver object + app <- AppDriver$new(app_dir = test_path("test-apps")) + + # select dplyr package + app$set_inputs(`sidebar-select_pkg` = "dplyr") + + # navigate to maintenance metrics tab + app$set_inputs(tabs = "Maintenance Metrics") + app$wait_for_idle(500) + + # confirm no comments are currently shown + expect_equal( + app$get_text(selector = "#maintenanceMetrics-view_comments-view_comments > div"), + "No comments" + ) + + # click submit with empty comment box does not add a comment + app$click("maintenanceMetrics-add_comment-submit_comment") + app$wait_for_idle(500) + expect_equal( + app$get_text(selector = "#maintenanceMetrics-view_comments-view_comments > div"), + "No comments" + ) + + # enter text in the comment area and submit + maintenance_comment <- "This is a maintenance comment" + app$set_inputs(`maintenanceMetrics-add_comment-add_comment` = maintenance_comment) + app$click("maintenanceMetrics-add_comment-submit_comment") + app$wait_for_idle(500) + + # parse the comment div on the page + added_comments <- app$get_html(selector = "#maintenanceMetrics-view_comments-view_comments > div > div") + + # confirm one comment has been added + expect_equal( + length(added_comments), + 1 + ) + + # confirm comment contents match. actual comment shows up after the last
tag + comment_text <- rev(strsplit(added_comments, split = "
")[[1]])[1] + comment_text <- gsub("", "", comment_text) + expect_equal( + comment_text, + maintenance_comment + ) + + # confirm user name and user role are set appropriately + user_name <- strsplit( + strsplit(added_comments, split = "user: ")[[1]][[2]], + split = "," + )[[1]][1] + expect_equal( + user_name, + "test_user" + ) + + user_role <- strsplit( + strsplit(added_comments, split = "role: ")[[1]][[2]], + split = "," + )[[1]][1] + expect_equal( + user_role, + "admin" + ) + + # confirm comment is in database and has correct metadata + comments <- DBI::dbGetQuery(con, "select * from comments") + expect_equal( + nrow(comments), + 1 + ) + expect_equal( + comments$comment, + maintenance_comment + ) + + # close connection + DBI::dbDisconnect(con) + +}) + + +test_that("Comment input box is rendered according to the tab and user state", { + # delete app DB if exists to ensure clean test + app_db_loc <- test_path("test-apps", "database.sqlite") + if (file.exists(app_db_loc)) { + file.remove(app_db_loc) + } + + # copy in already instantiated database to avoid need to rebuild + # this is a database that has been built via inst/testdata/upload_format.csv + test_db_loc <- system.file("testdata", "upload_format.database", package = "riskassessment") + file.copy( + test_db_loc, + app_db_loc + ) + + # set up new app driver object + app <- AppDriver$new(app_dir = test_path("test-apps")) + + # select dplyr package + app$set_inputs(`sidebar-select_pkg` = "dplyr") + + # navigate to maintenance metrics tab + app$set_inputs(tabs = "Maintenance Metrics") + app$wait_for_idle(500) + + # helper fn + get_element_attribute <- function(app, element_id, el_attribute) { + app$get_js( + sprintf( + 'document.getElementById("%s").getAttribute("%s")', + element_id, + el_attribute + ) + ) + } + + # confirm label & placeholder text are rendered properly + expect_equal( + app$get_text("#maintenanceMetrics-add_comment-add_comment-label h5"), + "Add Comment for Maintenance Metrics" + ) + + expect_equal( + get_element_attribute( + app, "maintenanceMetrics-add_comment-add_comment", + "placeholder" + ), + "Commenting as user: test_user, role: admin" + ) + + + # change to Community Usage Metrics tab + app$set_inputs(tabs = "Community Usage Metrics") + app$wait_for_idle(500) + + # confirm label & placeholder text are rendered properly + expect_equal( + app$get_text("#communityMetrics-add_comment-add_comment-label h5"), + "Add Comment for Community Usage Metrics" + ) + + expect_equal( + get_element_attribute( + app, "communityMetrics-add_comment-add_comment", + "placeholder" + ), + "Commenting as user: test_user, role: admin" + ) +}) + diff --git a/tests/testthat/test-apps/.gitignore b/tests/testthat/test-apps/.gitignore new file mode 100644 index 000000000..9b1dffd90 --- /dev/null +++ b/tests/testthat/test-apps/.gitignore @@ -0,0 +1 @@ +*.sqlite diff --git a/tests/testthat/test-apps/app.R b/tests/testthat/test-apps/app.R new file mode 100644 index 000000000..942594eb1 --- /dev/null +++ b/tests/testthat/test-apps/app.R @@ -0,0 +1,6 @@ +# Launch the ShinyApp (Do not remove this comment) +# To deploy, run: rsconnect::deployApp() +# Or use the blue button on top of this file + +# pkgload::load_all(export_all = FALSE,helpers = FALSE,attach_testthat = FALSE) +riskassessment::run_app() # add parameters here (if any) diff --git a/tests/testthat/test-apps/downloadHandler-app/.gitignore b/tests/testthat/test-apps/downloadHandler-app/.gitignore new file mode 100644 index 000000000..0dc7d5460 --- /dev/null +++ b/tests/testthat/test-apps/downloadHandler-app/.gitignore @@ -0,0 +1 @@ +!*.sqlite diff --git a/tests/testthat/test-apps/downloadHandler-app/app.R b/tests/testthat/test-apps/downloadHandler-app/app.R new file mode 100644 index 000000000..9d34723c1 --- /dev/null +++ b/tests/testthat/test-apps/downloadHandler-app/app.R @@ -0,0 +1,42 @@ +library(shiny) + +ui <- fluidPage( + tabsetPanel( + id = "tabs", + tabPanel( + "single", + riskassessment:::mod_downloadHandler_button_ui("downloadHandler_1", multiple = FALSE), + riskassessment:::mod_downloadHandler_filetype_ui("downloadHandler_1") + ), + tabPanel( + "multiple", + riskassessment:::mod_downloadHandler_button_ui("downloadHandler_2", multiple = TRUE), + riskassessment:::mod_downloadHandler_filetype_ui("downloadHandler_2") + ) + ) +) + +server <- function(input, output, session) { + shinyOptions(golem_options = list(assessment_db_name = "dplyr_tidyr.sqlite")) + + user <- reactiveValues( + name = "tester", + role = "tester" + ) + + pkg <- reactiveVal("dplyr") + pkgs <- reactiveVal(c("dplyr", "tidyr")) + + metric_weights <- reactiveVal(structure(list(name = c("has_vignettes", "has_news", "news_current", + "has_bug_reports_url", "has_website", "has_maintainer", + "has_source_control", "export_help", "bugs_status", + "license", "covr_coverage", "downloads_1yr"), + weight = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1)), + class = "data.frame", + row.names = c(NA, -12L))) + + riskassessment:::mod_downloadHandler_server("downloadHandler_1", pkg, user, metric_weights) + riskassessment:::mod_downloadHandler_server("downloadHandler_2", pkgs, user, metric_weights) +} + +shinyApp(ui, server) diff --git a/tests/testthat/test-apps/downloadHandler-app/dplyr_tidyr.sqlite b/tests/testthat/test-apps/downloadHandler-app/dplyr_tidyr.sqlite new file mode 100644 index 000000000..11ebc6ef2 Binary files /dev/null and b/tests/testthat/test-apps/downloadHandler-app/dplyr_tidyr.sqlite differ diff --git a/tests/testthat/test-apps/reweightView-app/app.R b/tests/testthat/test-apps/reweightView-app/app.R new file mode 100644 index 000000000..6eed4883b --- /dev/null +++ b/tests/testthat/test-apps/reweightView-app/app.R @@ -0,0 +1,28 @@ +library(shiny) + +ui <- fluidPage( + shinyjs::useShinyjs(), + riskassessment:::reweightViewUI("reweightInfo") +) + +server <- function(input, output, session) { + shinyOptions(golem_options = list(assessment_db_name = "dplyr.sqlite")) + + user <- reactiveValues( + name = "tester", + role = "admin" + ) + + auto_json <- jsonlite::read_json("auto_decisions.json") + auto_list <- reactiveVal(auto_json) + + exportTestValues( + metric_weights = { + metric_weights() + } + ) + + metric_weights <- riskassessment:::reweightViewServer("reweightInfo", user, auto_list) +} + +shinyApp(ui, server) diff --git a/tests/testthat/test-auto_font.R b/tests/testthat/test-auto_font.R new file mode 100644 index 000000000..85fbf612e --- /dev/null +++ b/tests/testthat/test-auto_font.R @@ -0,0 +1,68 @@ + +### Create tests for autofont + + +test_that("no extra args - font is proportional and hits floor at .75", { + long_str <- "https://github.com/tidyverse/dplyr/issues" + expect_equal(auto_font(long_str,), .817) + expect_equal(auto_font(paste0(long_str, "+")), .800) + expect_equal(auto_font(paste0(long_str, "pl")), .783) + expect_equal(auto_font(paste0(long_str, "plu")), .767) + expect_equal(auto_font(paste0(long_str, "plus")), .75) +}) + +test_that("adjusting 'txt_max' changes proportion for long strings", { + long_str <- "https://github.com/tidyverse/dplyr/issues" + expect_equal(auto_font(long_str, txt_max = 55), .941) + expect_equal(auto_font(paste0(long_str, "+"), txt_max = 55), .927) +}) + +test_that("adjusting 'size_min' changes proportion for long strings", { + long_str <- "https://github.com/tidyverse/dplyr/issues" + expect_equal(auto_font(long_str, size_min = .5), .589) + expect_equal(auto_font(paste0(long_str, "+"), size_min = .5), .567) +}) + +test_that("Adding `bins` argument returns categorical options", { + short_str <- "" + med_str <- "https://github.com/" + long_str <- "https://github.com/tidyverse/dplyr/issues" + + expect_equal(auto_font(short_str, num_bins = 3), 1.5) + expect_equal(auto_font(paste0(short_str, "+"), num_bins = 3), 1.5) + + expect_equal(auto_font(med_str, num_bins = 3), 1.125) + expect_equal(auto_font(paste0(med_str, "+"), num_bins = 3), 1.125) + + expect_equal(auto_font(long_str, num_bins = 3), .75) + expect_equal(auto_font(paste0(long_str, "+"), num_bins = 3), .75) +}) + + + +test_that("no extra args - font is proportional and hits ceiling at 1.5", { + str <- "" + expect_equal(auto_font(str), 1.5) + expect_equal(auto_font(paste0(str, "+")), 1.483) + expect_equal(auto_font(paste0(str, "pl")), 1.467) + expect_equal(auto_font(paste0(str, "plu")), 1.450) + expect_equal(auto_font(paste0(str, "plus")), 1.433) +}) + +test_that("adjusting 'txt_max' changes proportion for short strings", { + str <- "" + expect_equal(auto_font(str, txt_max = 10), 1.5) + expect_equal(auto_font(paste0(str, "+"), txt_max = 10), 1.425) +}) + +test_that("adjusting 'size_max' changes proportion for short strings", { + str <- "" + expect_equal(auto_font(str, size_max = 2.0), 2) + expect_equal(auto_font(paste0(str, "+"), size_max = 2.0), 1.972) +}) + + + + + + diff --git a/tests/testthat/test-communityMetrics.R b/tests/testthat/test-communityMetrics.R new file mode 100644 index 000000000..8161c999e --- /dev/null +++ b/tests/testthat/test-communityMetrics.R @@ -0,0 +1,53 @@ +test_that("Reactivity of communityMetrics", { + app_db_loc <- test_path("test-apps", "database.sqlite") + if (file.exists(app_db_loc)) { + file.remove(app_db_loc) + } + + # copy in already instantiated database to avoid need to rebuild + # this is a database that has been built via inst/testdata/upload_format.csv + test_db_loc <- system.file("testdata", "upload_format.database", package = "riskassessment") + file.copy( + test_db_loc, + app_db_loc + ) + + # set up new app driver object + app <- AppDriver$new(app_dir = test_path("test-apps")) + + # set pkg_name to dplyr + app$set_inputs(`sidebar-select_pkg` = "dplyr") + + # get to the Maintenance Metrics tab + app$set_inputs(tabs = "Community Usage Metrics") + + # read the current comment + out_cmt <- app$get_values()$output$`communityMetrics-view_comments-view_comments`$html + + cmt_txt <- rvest::read_html(out_cmt) %>% + rvest::html_nodes(xpath = '//div[@class="well"]/text()') %>% + purrr::map_chr(., ~as.character(.x)) + + expect_equal(cmt_txt, "No comments") + + # add a comment + add_comment <- "This package gets lots of downloads." + app$set_inputs(`communityMetrics-add_comment-add_comment` = add_comment) + + app$click("communityMetrics-add_comment-submit_comment") + app$wait_for_idle() + + # read the comment back in + out_cmt <- app$get_values()$output$`communityMetrics-view_comments-view_comments`$html + + cmt_txt <- rvest::read_html(out_cmt) %>% + rvest::html_nodes(xpath = '//div[@class="well"]/text()') %>% + purrr::map_chr(., ~as.character(.x)) + + # is the last text entry the comment we entered? + expect_equal(cmt_txt[length(cmt_txt)], add_comment) + + app$stop() + unlink("app_db_loc") + rm(app, add_comment, out_cmt, cmt_txt, app_db_loc) +}) \ No newline at end of file diff --git a/tests/testthat/test-databaseView.R b/tests/testthat/test-databaseView.R new file mode 100644 index 000000000..8ca3b1fc6 --- /dev/null +++ b/tests/testthat/test-databaseView.R @@ -0,0 +1,96 @@ +test_that("Reactivity of database view table", { + # delete app DB if exists to ensure clean test + app_db_loc <- test_path("test-apps", "database.sqlite") + if (file.exists(app_db_loc)) { + file.remove(app_db_loc) + } + + # copy in already instantiated database to avoid need to rebuild + # this is a database that has been built via inst/testdata/upload_format.csv + test_db_loc <- system.file("testdata", "upload_format.database", package = "riskassessment") + file.copy( + test_db_loc, + app_db_loc + ) + + # set up new app driver object + app <- AppDriver$new(app_dir = test_path("test-apps")) + + app$set_inputs(apptabs = "database-tab") + + #### Test that the `table_data` loads correctly #### + tbl_expect <- + structure(list(name = "dplyr", version = "1.0.10", score = 0.1, + was_decision_made = FALSE, decision = "-", + last_comment = "-"), + class = "data.frame", row.names = c(NA, -1L)) + tbl_actual <- + app$get_value(export = "databaseView-table_data") + + expect_equal(tbl_actual, tbl_expect) + + #### Test that`table_data` updates in response to `changes` #### + app$set_inputs(`sidebar-select_pkg` = "dplyr") + app$click("sidebar-submit_decision") + app$wait_for_idle() + app$click("sidebar-submit_confirmed_decision") + + tbl_expect <- + structure(list(name = "dplyr", version = "1.0.10", score = 0.1, + was_decision_made = TRUE, decision = "Low Risk", + last_comment = "-"), + class = "data.frame", row.names = c(NA, -1L)) + tbl_actual <- + app$get_value(export = "databaseView-table_data") + + expect_equal(tbl_actual, tbl_expect) + + #### Test that`table_data` updates in response to `uploaded_pkgs` #### + tbl_actual <- + app$get_value(export = "databaseView-table_data") + + app$run_js("Shiny.setInputValue('upload_package-load_cran', 'load')") + app$wait_for_idle() + app$set_inputs(`upload_package-pkg_lst` = "tidyr") + app$click("upload_package-add_pkgs", wait_ = FALSE) + app$wait_for_value(export = "databaseView-table_data", + ignore = tbl_actual, timeout = 30 * 1000 ) + + tbl_expect <- structure(list(name = c("tidyr", "dplyr"), + was_decision_made = c(FALSE, TRUE), + decision = c("-", "Low Risk"), + last_comment = c("-", "-")), + class = "data.frame", row.names = c(NA, -2L)) + tbl_actual <- + app$get_value(export = "databaseView-table_data") + + expect_equal(tbl_actual %>% dplyr::select(1,4,5,6) %>% dplyr::arrange(1), tbl_expect) + + #### Test that `packages_table` is loaded correctly #### + tbl_actual <- + app$get_value(export = "databaseView-table_data") %>% + dplyr::mutate(was_decision_made = dplyr::if_else(was_decision_made, "Yes", "No")) + + packages_table <- + app$get_html("#databaseView-packages_table") %>% + rvest::minimal_html() %>% + rvest::html_table() %>% + `[[`(1) + + expect_equal(packages_table, tbl_actual, + ignore_attr = TRUE) + + #### Test that the selected packages are being passed to the download handler #### + expect_equal(app$get_value(export = "databaseView-pkgs"), character(0)) + app$run_js("Shiny.setInputValue('databaseView-packages_table_rows_selected', 1)") + app$wait_for_idle() + expect_equal(app$get_value(export = "databaseView-pkgs"), "tidyr") + app$run_js("Shiny.setInputValue('databaseView-packages_table_rows_selected', [1,2])") + app$wait_for_idle() + expect_equal(app$get_value(export = "databaseView-pkgs"), c("tidyr", "dplyr")) + app$run_js("Shiny.setInputValue('databaseView-packages_table_rows_selected', null)") + app$wait_for_idle() + expect_equal(app$get_value(export = "databaseView-pkgs"), character(0)) + + app$stop() +}) diff --git a/tests/testthat/test-dbSelect.R b/tests/testthat/test-dbSelect.R new file mode 100644 index 000000000..53d0b31bf --- /dev/null +++ b/tests/testthat/test-dbSelect.R @@ -0,0 +1,47 @@ +test_that("database has been defined and dbSelect function works", { + + # this is a copy of the empty database.sqlite db which is in ./inst/testdata + db_name <- "skeleton.sqlite" + + base_path <- app_sys("testdata") + + # 1. file exists? + testthat::expect_true(file.exists(file.path(base_path, db_name))) + + # 2. valid db? test this is a valid sqlite database + testthat::expect_equal(readLines(file.path(base_path, db_name), n =1, warn = FALSE), "SQLite format 3") + + # 3. can we connect? + testthat::expect_true(DBI::dbCanConnect(RSQLite::SQLite(), file.path(base_path, db_name))) + + query <- "SELECT [name] FROM sqlite_master WHERE type='table' order by [rootpage]" + tbls <- dbSelect(query, file.path(base_path, db_name)) + + # 4. test s3 class is data.frame + testthat::expect_s3_class(tbls, "data.frame") + + tbl_names <- c("package", "sqlite_sequence", "metric", "package_metrics", "community_usage_metrics", "comments") + # 5. test all tables have been created + testthat::expect_equal(tbls |> dplyr::pull(), tbl_names) + + query <- "select * FROM [metric] WHERE [class] = 'maintenance' order by [id]" + metric <- dbSelect(query, file.path(base_path, db_name)) + + # 6. test that we have at least 10 maintenance metrics + testthat::expect_gte(nrow(metric), 10) + + query <- "select name FROM [thispackage] limit 1" + + # 7. expect message about "no such table" + testthat::expect_message(dbSelect(query, file.path(base_path, db_name)), regexp = "Error: no such table:") + + # NULL is returned when Trycatch is invoked + ret <- suppressMessages(dbSelect(query, file.path(base_path, db_name))) + # 8. test NULL is returned + testthat::expect_null(ret) + + + rm(db_name, base_path, query, tbls, tbl_names, metric) + +}) + diff --git a/tests/testthat/test-dbUpdate.R b/tests/testthat/test-dbUpdate.R new file mode 100644 index 000000000..3cced3367 --- /dev/null +++ b/tests/testthat/test-dbUpdate.R @@ -0,0 +1,82 @@ +test_that("both dbUpdate and dbSelect work", { + + base_path <- app_sys("testdata") + # this is a copy of the empty database.sqlite db which is in ./inst/testdata + db_name <- "skeleton.sqlite" + # and this is a temporary datbase + db_temp <- "datatest.sqlite" + + confr <- dbConnect(RSQLite::SQLite(), file.path(base_path, db_name)) + conto <- dbConnect(RSQLite::SQLite(), file.path(base_path, db_temp)) + + # copy into temp db + RSQLite::sqliteCopyDatabase(confr, conto) + + DBI::dbDisconnect(confr) + DBI::dbDisconnect(conto) + + con <- DBI::dbConnect(RSQLite::SQLite(), file.path(base_path, db_temp)) + + # 1. table 'package' exists? + testthat::expect_true(DBI::dbExistsTable(con, "package")) + + # executing each query + #col_list <- purrr::map(.x = tbls, .f =DBI::dbListFields, conn = con) + cols <- DBI::dbListFields(con, "package") + + # 2. description is the 5th column in table 'package' + testthat::expect_equal(5, which(cols == "description")) + + DBI::dbDisconnect(con) + + query <- "select * FROM [package] limit 1" + tbl1 <- dbSelect(query, file.path(base_path, db_temp)) + + # 4. expect zero rows have been returned. + testthat::expect_equal(nrow(tbl1), 0L) + + pkg_name <- "stringr" + + command <- glue::glue("DELETE from [package] WHERE ( name = '{pkg_name}')") + + # 5. expect zero rows were affected, referring to existing table + testthat::expect_message(dbUpdate(command, file.path(base_path, db_temp)), regexp = "zero rows were affected by the command:" ) + + command <- glue::glue("DELETE from [thispkg] WHERE (name = '{pkg_name}')") + # 6. expect message about "no such table" + testthat::expect_message(dbUpdate(command, file.path(base_path, db_temp)), regexp = "Error: no such table:" ) + + pkg_info <- get_latest_pkg_info(pkg_name) + + command <-(glue::glue( + "INSERT or REPLACE INTO package + (name, version, title, description, maintainer, author, + license, published_on, decision, date_added) + VALUES('{pkg_name}', '{pkg_info$Version}', '{pkg_info$Title}', '{pkg_info$Description}', + '{pkg_info$Maintainer}', '{pkg_info$Author}', '{pkg_info$License}', '{pkg_info$Published}', + '', '{Sys.Date()}')")) + + dbUpdate(command, file.path(base_path, db_temp)) + + tbl1 <- dbSelect(query, file.path(base_path, db_temp)) + + # 7. expect one row has been returned. + testthat::expect_equal(nrow(tbl1), 1L) + + # 8. query result matches what we wrote into the table + testthat::expect_equal(pkg_info$Title, tbl1$title) + + # clean up after ourselves + command <- glue::glue("DELETE from [package] WHERE ( name = '{pkg_name}')") + dbUpdate(command, file.path(base_path, db_temp)) + + tbl1 <- dbSelect(query, file.path(base_path, db_temp)) + + # 9. expect zero rows have been returned. + testthat::expect_equal(nrow(tbl1), 0L) + + unlink(file.path(base_path, db_temp)) + rm(base_path, db_name, db_temp, confr, conto, con, query, command, tbl1, cols, pkg_name, pkg_info) + +}) + diff --git a/tests/testthat/test-downloadHandler.R b/tests/testthat/test-downloadHandler.R new file mode 100644 index 000000000..6cf2f72cb --- /dev/null +++ b/tests/testthat/test-downloadHandler.R @@ -0,0 +1,23 @@ +test_that("downloadHandler works", { + + app <- AppDriver$new(test_path("test-apps", "downloadHandler-app")) + + expect_equal(app$get_value(input = "tabs"), "single") + expect_equal(app$get_value(input = "downloadHandler_1-report_format"), "html") + report <- app$get_download("downloadHandler_1-download_reports") + expect_equal(tools::file_ext(report), "html") + + ## TODO: Add tests back in when issues are figured out + # app$set_inputs(`downloadHandler_1-report_format` = "docx") + # report <- app$get_download("downloadHandler_1-download_reports") + # expect_equal(tools::file_ext(report), "docx") + # + # app$set_inputs(`downloadHandler_1-report_format` = "pdf") + # report <- app$get_download("downloadHandler_1-download_reports") + # expect_equal(tools::file_ext(report), "pdf") + + app$set_inputs(tabs = "multiple") + expect_equal(app$get_value(input = "downloadHandler_2-report_format"), "html") + report <- app$get_download("downloadHandler_2-download_reports") + expect_equal(tools::file_ext(report), "zip") +}) \ No newline at end of file diff --git a/tests/testthat/test-generate_comm_data.R b/tests/testthat/test-generate_comm_data.R new file mode 100644 index 000000000..3e943e1dd --- /dev/null +++ b/tests/testthat/test-generate_comm_data.R @@ -0,0 +1,24 @@ + +### Create tests for generate_comm_data +library(dplyr) +dat <- generate_comm_data("ggplot2") +test_that("func should return one row per month and year", { + expect_equal(dat %>% + group_by(year, month) %>% + summarize(n = n()) %>% + filter(n > 1) %>% nrow + , 0) +}) +test_that("Versions should aggregate when more than 1 version exists per year and month", { + expect_equal(pull(dat[1, "version"]), "0.5 - 0.5.2") +}) +test_that("data should contain every possible year month combo from month of first release until present month - 1", { + mid_years <- (min(dat$year)+1):(max(dat$year) - 1) + year1_mnths <- dat$month[1]:12 + yearn_mnths <- 1:dat$month[nrow(dat)] + all_combos <- expand.grid(year1_mnths, min(dat$year)) %>% + union(expand.grid(1:12, mid_years))%>% + union(expand.grid(yearn_mnths, max(dat$year))) + colnames(all_combos) <- c("month", "year") + expect_equal(dat %>% distinct(year, month) %>% as.data.frame, all_combos) +}) diff --git a/tests/testthat/test-getTimeStamp.R b/tests/testthat/test-getTimeStamp.R new file mode 100644 index 000000000..fcd4502dc --- /dev/null +++ b/tests/testthat/test-getTimeStamp.R @@ -0,0 +1,10 @@ +test_that("utils.R", { + expect_type(getTimeStamp(), "character") + expect_equal(object = getTimeStamp(), + expected = paste(gsub(x = Sys.time(), pattern = " ", replacement = "; "), + Sys.timezone()), tolerance = 1e-02 + ) + str = ";" + expect_true(grepl(str, getTimeStamp(), fixed = TRUE)) + expect_true(grepl(Sys.timezone(), getTimeStamp(), fixed = TRUE)) +}) diff --git a/tests/testthat/test-get_date_span.R b/tests/testthat/test-get_date_span.R new file mode 100644 index 000000000..980739bf5 --- /dev/null +++ b/tests/testthat/test-get_date_span.R @@ -0,0 +1,14 @@ + +## test cases for functions in utils.R +test_that(desc = "Check output of get_date_span()", + code = { + testthat::expect_equal(object = get_date_span(start = "2021-07-03", end = "2022-12-05")$value, expected = 1) + testthat::expect_equal(object = get_date_span(start = "2021-07-03", end = "2022-12-05")$label, expected = "Year") + testthat::expect_equal(object = get_date_span(start = "2020-02-26", end = "2020-05-04")$value, expected = 2) + testthat::expect_equal(object = get_date_span(start = "2020-02-26", end = "2020-05-04")$label, expected = "Months") + testthat::expect_equal(object = get_date_span(start = "2020-03-16", end = "2020-03-21")$value, expected = 0) + testthat::expect_equal(object = get_date_span(start = "2020-03-16", end = "2020-03-21")$label, expected = "Months") + + ## check error message when function is called without any argument + testthat::expect_error(object = get_date_span(), regexp = "argument \"start\" is missing, with no default") + }) diff --git a/tests/testthat/test-get_latest_pkg_info.R b/tests/testthat/test-get_latest_pkg_info.R new file mode 100644 index 000000000..f3084737e --- /dev/null +++ b/tests/testthat/test-get_latest_pkg_info.R @@ -0,0 +1,11 @@ +test_that("get_latest_pkg_info() in utils.R", { + test <- get_latest_pkg_info("rpact") + expect_error(get_latest_pkg_info("r_pact123")) + + expect_type(test, "list") + expect_equal(colnames(test), c("Version", "Maintainer", "Author", + "License", "Published", "Title", + "Description")) + expect_true(length(test) > 0) + expect_true(nrow(test) > 0) +}) diff --git a/tests/testthat/test-golem-recommended.R b/tests/testthat/test-golem-recommended.R index 1d8154995..d27dc444b 100644 --- a/tests/testthat/test-golem-recommended.R +++ b/tests/testthat/test-golem-recommended.R @@ -50,8 +50,9 @@ test_that( } ) -# # Configure this test to fit your need. -# # testServer() function makes it possible to test code in server functions and modules, without needing to run the full Shiny application + +# Configure this test to fit your need. +# testServer() function makes it possible to test code in server functions and modules, without needing to run the full Shiny application # testServer(app_server, { # # # Set and test an input diff --git a/tests/testthat/test-introJS.R b/tests/testthat/test-introJS.R new file mode 100644 index 000000000..24cae66af --- /dev/null +++ b/tests/testthat/test-introJS.R @@ -0,0 +1,138 @@ +test_that("The introJS module works as expected", { + app_db_loc <- test_path("test-apps", "database.sqlite") + if (file.exists(app_db_loc)) { + file.remove(app_db_loc) + } + + # copy in already instantiated database to avoid need to rebuild + # this is a database that has been built via inst/testdata/upload_format.csv + test_db_loc <- system.file("testdata", "skeleton.sqlite", package = "riskassessment") + file.copy( + test_db_loc, + app_db_loc + ) + + # set up new app driver object + app <- shinytest2::AppDriver$new(app_dir = test_path("test-apps")) + + expect_equal(app$get_value(input = "tabs"), "Upload Package") + + # note upload_pkgs + upload_pkgs <- bind_rows(list(upload_pkg, upload_adm, apptab_admn, apptab_steps)) + + app$click("upload_package-introJS-help") + + # Verify that all elements exist and are visible + el_pos <- + purrr::map(upload_pkgs$element, ~ app$get_js(glue::glue('$("{.x}").position()'))[["top"]]) %>% + unlist() + expect(length(el_pos) == length(upload_pkgs$element), "One or more Upload Package introJS elements are missing.") + #expect(all(el_pos != 0), "Not all Upload Package introJS elements are visible.") #last 3 not visible. + + tt_txt <- app$get_text(".introjs-tooltiptext") + expect_equal(tt_txt, upload_pkgs$intro[1]) + + app$click(selector = ".introjs-nextbutton") + app$wait_for_idle() + + tt_txt <- app$get_text(".introjs-tooltiptext") + expect_equal(tt_txt, upload_pkgs$intro[2]) + + app$click(selector = glue::glue("[data-stepnumber='{nrow(upload_pkgs)+1}']")) + app$wait_for_idle() + + tt_txt <- app$get_text(".introjs-tooltiptext") + expect_equal(tt_txt, sidebar_steps$intro[1]) + + app$click(selector = ".introjs-prevbutton") + app$wait_for_idle() + + tt_txt <- app$get_text(".introjs-tooltiptext") + expect_equal(tt_txt, upload_pkgs$intro[nrow(upload_pkgs)]) + + app$click(selector = glue::glue("[data-stepnumber='{nrow(upload_pkgs)+nrow(sidebar_steps)}']")) + app$wait_for_idle() + app$click(selector = ".introjs-donebutton") + + app$run_js("Shiny.setInputValue('upload_package-load_cran', 'load')") + app$wait_for_idle() + app$set_inputs(`upload_package-pkg_lst` = "tidyr") + app$click("upload_package-add_pkgs", wait_ = FALSE) + app$wait_for_value( + output = "upload_package-upload_pkgs_table", + ignore = list(NULL), + timeout = 30 * 1000 + ) + + upload_pkg_complete <- dplyr::bind_rows(list(upload_pkg, upload_adm, upload_pkg_comp, apptab_admn, apptab_steps)) + + # Verify that all elements exist and are visible + el_pos <- + purrr::map(upload_pkg_complete$element, ~ app$get_js(glue::glue('$("{.x}").position()'))[["top"]]) %>% + unlist() + expect(length(el_pos) == length(upload_pkg_complete$element), "One or more Upload Complete introJS elements are missing.") + #expect(all(el_pos != 0), "Not all Upload Complete introJS elements are visible.") + + app$click("upload_package-introJS-help") + app$click(selector = glue::glue("[data-stepnumber='{nrow(upload_pkg_complete)+1}']")) + app$wait_for_idle() + + # we should be at sidebar_steps #1 here + tt_txt <- app$get_text(".introjs-tooltiptext") + expect_equal(tt_txt, sidebar_steps$intro[1]) + + app$click(selector = ".introjs-skipbutton") + app$set_inputs(tabs = "Maintenance Metrics") + app$set_inputs(`sidebar-select_pkg` = "tidyr") + app$wait_for_idle() + + # Verify that all elements exist and are visible + el_pos <- + purrr::map(mm_steps$element, ~ app$get_js(glue::glue('$("{.x}").position()'))[["top"]]) %>% + unlist() + expect(length(el_pos) == length(mm_steps$element), "One or more Maintenance Metrics introJS elements are missing.") + expect(all(el_pos != 0), "Not all Maintenance Metrics introJS elements are visible.") + + app$click("maintenanceMetrics-introJS-help") + app$wait_for_idle() + + tt_txt <- app$get_text(".introjs-tooltiptext") + expect_equal(tt_txt, mm_steps$intro[1]) + + app$click(selector = ".introjs-skipbutton") + + app$set_inputs(tabs = "Community Usage Metrics") + app$wait_for_idle() + + # Verify that all elements exist and are visible + el_pos <- + purrr::map(cum_steps$element, ~ app$get_js(glue::glue('$("{.x}").position()'))[["top"]]) %>% + unlist() + expect(length(el_pos) == length(cum_steps$element), "One or more Community Usage Metrics introJS elements are missing.") + expect(all(el_pos != 0), "Not all Community Usage Metrics introJS elements are visible.") + + app$click("communityMetrics-introJS-help") + app$wait_for_idle() + + tt_txt <- app$get_text(".introjs-tooltiptext") + expect_equal(tt_txt, cum_steps$intro[1]) + + app$click(selector = ".introjs-skipbutton") + app$set_inputs(tabs = "Report Preview") + app$wait_for_idle() + + # Verify that all elements exist and are visible + el_pos <- + purrr::map(rp_steps$element, ~ app$get_js(glue::glue('$("{.x}").position()'))[["top"]]) %>% + unlist() + expect(length(el_pos) == length(rp_steps$element), "One or more Report Preview introJS elements are missing.") + expect(all(el_pos != 0), "Not all Report Preview introJS elements are visible.") + + app$click("reportPreview-introJS-help") + app$wait_for_idle() + + tt_txt <- app$get_text(".introjs-tooltiptext") + expect_equal(tt_txt, rp_steps$intro[1]) + + app$stop() +}) \ No newline at end of file diff --git a/tests/testthat/test-maintenanceMetrics.R b/tests/testthat/test-maintenanceMetrics.R new file mode 100644 index 000000000..7174b34a5 --- /dev/null +++ b/tests/testthat/test-maintenanceMetrics.R @@ -0,0 +1,74 @@ +test_that("Reactivity of maintenanceMetrics", { + app_db_loc <- test_path("test-apps", "database.sqlite") + if (file.exists(app_db_loc)) { + file.remove(app_db_loc) + } + + # copy in already instantiated database to avoid need to rebuild + # this is a database that has been built via inst/testdata/upload_format.csv + test_db_loc <- system.file("testdata", "upload_format.database", package = "riskassessment") + file.copy( + test_db_loc, + app_db_loc + ) + + # set up new app driver object + app <- AppDriver$new(app_dir = test_path("test-apps")) + + # set pkg_name to dplyr + app$set_inputs(`sidebar-select_pkg` = "dplyr") + + # get to the Maintenance Metrics tab + app$set_inputs(tabs = "Maintenance Metrics") + app$wait_for_idle() + + # read the current comment -- set to "No comments" + out_cmt <- app$get_values()$output$`maintenanceMetrics-view_comments-view_comments`$html + + cmt_txt <- rvest::read_html(out_cmt) %>% + rvest::html_nodes(xpath = '//div[@class="well"]/text()') %>% + purrr::map_chr(., ~as.character(.x)) + + expect_equal(cmt_txt, "No comments") + + # add a comment + add_comment <- "This is a well-maintained package." + app$set_inputs(`maintenanceMetrics-add_comment-add_comment` = add_comment) + + app$click("maintenanceMetrics-add_comment-submit_comment") + app$wait_for_idle() + + # check some of the card footers + out_val <- app$get_values()$output$`maintenanceMetrics-metricGrid-has_source_control-metricBox_ui`$html + pkg_url <- rvest::read_html(out_val) %>% + rvest::html_elements(.,".card-footer") %>% + rvest::html_text() + expect_equal(pkg_url, "Package source control url") + + out_val <- app$get_values()$output$`maintenanceMetrics-metricGrid-has_vignettes-metricBox_ui`$html + vignettes <- rvest::read_html(out_val) %>% + rvest::html_elements(.,".card-footer") %>% + rvest::html_text() + expect_equal(vignettes, "Number of vignettes") + + out_val <- app$get_values()$output$`maintenanceMetrics-metricGrid-news_current-metricBox_ui`$html + news_curr <- rvest::read_html(out_val) %>% + rvest::html_elements(.,".card-footer") %>% + rvest::html_text() + expect_equal(news_curr, "NEWS contains current version") + + # read the comment back in + out_cmt <- app$get_values()$output$`maintenanceMetrics-view_comments-view_comments`$html + + cmt_txt <- rvest::read_html(out_cmt) %>% + rvest::html_nodes(xpath = '//div[@class="well"]/text()') %>% + purrr::map_chr(., ~as.character(.x)) + + # is the last text entry the comment we entered? + expect_equal(cmt_txt[length(cmt_txt)], add_comment) + + app$stop() + unlink("app_db_loc") + rm(app, add_comment, out_val, pkg_url, vignettes, news_curr, out_cmt, cmt_txt, app_db_loc) + +}) \ No newline at end of file diff --git a/tests/testthat/test-reportPreview.R b/tests/testthat/test-reportPreview.R new file mode 100644 index 000000000..d8fe6911a --- /dev/null +++ b/tests/testthat/test-reportPreview.R @@ -0,0 +1,71 @@ +test_that("Reactivity of reportPreview", { + app_db_loc <- test_path("test-apps", "database.sqlite") + if (file.exists(app_db_loc)) { + file.remove(app_db_loc) + } + + # copy in already instantiated database to avoid need to rebuild + # this is a database that has been built via inst/testdata/upload_format.csv + test_db_loc <- system.file("testdata", "upload_format.database", package = "riskassessment") + file.copy( + test_db_loc, + app_db_loc + ) + + # set up new app driver object + app <- AppDriver$new(app_dir = test_path("test-apps")) + + # set pkg_name to dplyr + app$set_inputs(`sidebar-select_pkg` = "dplyr") + # get to the Report Preview tab + app$set_inputs(tabs = "Report Preview") + + vals <- app$get_values()$input + + # set file type to pdf + app$set_inputs(`reportPreview-downloadHandler-report_format` = "pdf") + app$wait_for_idle() + + # verify it changed + expect_equal(app$get_values()$input$`reportPreview-downloadHandler-report_format`, "pdf") + + # set file type back to default html + app$set_inputs(`reportPreview-downloadHandler-report_format` = "html") + app$wait_for_idle() + + expect_equal(app$get_values()$input$`reportPreview-downloadHandler-report_format`, "html") + + # download and check file type + report <- app$get_download("reportPreview-downloadHandler-download_reports") + app$wait_for_idle() + + # scrape output pkg_overview + out_val <- app$get_values()$output$`reportPreview-pkg_overview`$html + + html <- rvest::read_html(out_val) + pkg_rev <- rvest::html_nodes(html, "h5") %>% + rvest::html_text() + + # scrape similar section in html report + html <- rvest::read_html(report) + about <- html %>% + rvest::html_nodes(xpath="//h5[contains(., 'General Information')]/following-sibling::h6") %>% + rvest::html_nodes(xpath="//h5/preceding-sibling::h6") %>% + rvest::html_text() + + # first 8 should match + expect_equal(about[1:8], pkg_rev) + + # scrape maintenance info headers + maint_info <- rvest::html_elements(html,".card-header") %>% + rvest::html_text() %>% + paste(collapse = ", ") + + str_expect <- "Vignettes, NEWS file, NEWS current, Report Bugs, Website, Maintainer, Source Control, Documentation, Bugs Closure Rate, License, First Version Release, Latest Version Release, Package Downloads" + + expect_equal(maint_info, str_expect) + + app$stop() + unlink("app_db_loc") + rm(app, vals, html, about, maint_info, out_val, pkg_rev, report, str_expect, app_db_loc) +}) \ No newline at end of file diff --git a/tests/testthat/test-reweightView.R b/tests/testthat/test-reweightView.R new file mode 100644 index 000000000..9aac6c8a1 --- /dev/null +++ b/tests/testthat/test-reweightView.R @@ -0,0 +1,111 @@ +test_that("reweightView works", { + # delete app DB if exists to ensure clean test + app_db_loc <- test_path("test-apps", "reweightView-app", "dplyr.sqlite") + if (file.exists(app_db_loc)) { + file.remove(app_db_loc) + } + + # copy in already instantiated database to avoid need to rebuild + # this is a database that has been built via inst/testdata/upload_format.csv + test_db_loc <- system.file("testdata", "upload_format.database", package = "riskassessment") + file.copy( + test_db_loc, + app_db_loc + ) + + if(!file.exists(test_path("test-apps", "reweightView-app", "auto_decisions.json"))) jsonlite::write_json(data.frame(decision = character(0), lower_limit = numeric(0), upper_limit = numeric(0)), test_path("test-apps", "reweightView-app", "auto_decisions.json")) + + app <- AppDriver$new(test_path("test-apps", "reweightView-app")) + + if (interactive()) + app$view() + + metric_weights <- app$get_value(export = "metric_weights") + curr_new_wts <- app$get_value(export = "reweightInfo-curr_new_wts") + expect_equal(metric_weights, curr_new_wts[,1:2]) + expect_equal(app$get_value(input = "reweightInfo-metric_weight"), 1) + + db_backup <- app$get_download("reweightInfo-download_database_btn") + app$wait_for_idle() + app$click(selector = "#confirmation_id button") + + con1 <- DBI::dbConnect(RSQLite::SQLite(), app_db_loc) + con2 <- DBI::dbConnect(RSQLite::SQLite(), db_backup) + + expect_equal(DBI::dbListTables(con2), DBI::dbListTables(con1)) + + db1 <- purrr::map(DBI::dbListTables(con1), ~ DBI::dbGetQuery(con1, glue::glue("SELECT * FROM {.x}"))) + db2 <- purrr::map(DBI::dbListTables(con2), ~ DBI::dbGetQuery(con2, glue::glue("SELECT * FROM {.x}"))) + expect_equal(db2, db1) + DBI::dbDisconnect(con1) + DBI::dbDisconnect(con2) + + expect_equal(app$get_value(input = "reweightInfo-metric_name"), curr_new_wts[1,1]) + app$set_inputs(`reweightInfo-metric_weight` = -30) + app$wait_for_idle() + expect_equal(app$get_value(input = "reweightInfo-metric_weight"), 0) + + app$set_inputs(`reweightInfo-metric_weight` = 2) + curr_new_wts2 <- app$get_value(export = "reweightInfo-curr_new_wts") + expect_equal(curr_new_wts2, curr_new_wts) + app$click("reweightInfo-update_weight") + curr_new_wts2 <- app$get_value(export = "reweightInfo-curr_new_wts") + expect_equal(curr_new_wts2[1,3], 2) + expect_equal(curr_new_wts2[-1,], curr_new_wts[-1,]) + + expect_equal(app$get_js("$('[data-ns-prefix=reweightInfo-]').css('display')"), "none") + app$set_inputs(`reweightInfo-metric_name` = "covr_coverage") + expect_equal(app$get_js("$('[data-ns-prefix=reweightInfo-]').css('display')"), "block") + + app$set_inputs(`reweightInfo-metric_weight` = 2) + app$wait_for_idle() + expect_equal(app$get_value(input = "reweightInfo-metric_weight"), 0) + + app$set_inputs(`reweightInfo-metric_name` = curr_new_wts[3,1]) + app$set_inputs(`reweightInfo-metric_weight` = 3.5) + app$wait_for_idle() + app$click("reweightInfo-update_weight") + curr_new_wts2 <- app$get_value(export = "reweightInfo-curr_new_wts") + + expect_equal(nrow(dbSelect("select * from comments", db_backup)), 0) + expect_equal(dbSelect("select * from package", db_backup)[["decision"]], "") + + # Set overall comment + dbUpdate( + "INSERT INTO comments + VALUES ('dplyr', 'tester', 'admin', 'This is an overall comment', 'o', 'TODAY'), + ('dplyr', 'tester', 'admin', 'This is a maintenance metric comment', 'mm', 'TODAY')", + app_db_loc + ) + # Set decision + dbUpdate( + "UPDATE package + SET decision = 'Low' + WHERE name = 'dplyr'", + app_db_loc + ) + + db_backup <- app$get_download("reweightInfo-download_database_btn") + app$wait_for_idle() + app$click(selector = "#confirmation_id button") + + expect_equal(nrow(dbSelect("select * from comments", db_backup)), 2) + expect_equal(dbSelect("select * from package", db_backup)[["decision"]], "Low") + + app$click("reweightInfo-update_pkg_risk") + app$click("reweightInfo-confirm_update_risk") + app$wait_for_idle() + + db_backup <- app$get_download("reweightInfo-download_database_btn") + app$wait_for_idle() + app$click(selector = "#confirmation_id button") + + expect_equal(nrow(dbSelect("select * from comments where comment_type = 'o'", db_backup)), 0) + expect_equal(nrow(dbSelect("select * from comments", db_backup)), 3) + expect_equal(dbSelect("select * from package", db_backup)[["decision"]], "") + + metric_weights <- app$get_value(export = "metric_weights") + curr_new_wts <- app$get_value(export = "reweightInfo-curr_new_wts") + expect_equal(metric_weights, curr_new_wts[,1:2]) + expect_equal(metric_weights[1:3,2], c(2,1,3.5)) +}) \ No newline at end of file diff --git a/tests/testthat/test-showHelperMessage.R b/tests/testthat/test-showHelperMessage.R new file mode 100644 index 000000000..1f1094797 --- /dev/null +++ b/tests/testthat/test-showHelperMessage.R @@ -0,0 +1,15 @@ + +test_that(desc = "Check output of showHelperMessage()", + code = { + msg <- showHelperMessage(message = "This is a test message!") + testthat::expect_equal(object = msg$children[[1]][1], expected = "This is a test message!") + testthat::expect_equal(object = msg$name, expected = "h6") + + ## check HTML attributes of the message + attribs <- stringr::str_split(msg$attribs$style, pattern = "[;\n]")[[1]] ## split at either semi-colon OR newline + testthat::expect_equal(object = attribs[1], expected = "text-align: center") + testthat::expect_equal(object = stringr::str_split(string = attribs[3], pattern = "^\\s+")[[1]][2], + expected = "color: gray") ## split at one or more white spaces in the beginning + testthat::expect_equal(object = stringr::str_split(string = attribs[5], pattern = "^\\s+")[[1]][2], + expected = "padding-top: 50px") + }) \ No newline at end of file diff --git a/tests/testthat/test-sidebar.R b/tests/testthat/test-sidebar.R new file mode 100644 index 000000000..68ab078fa --- /dev/null +++ b/tests/testthat/test-sidebar.R @@ -0,0 +1,129 @@ +test_that("Reactivity of sidebar", { + library(shinytest2, quietly = TRUE) + + app_db_loc <- test_path("test-apps", "database.sqlite") + if (file.exists(app_db_loc)) { + file.remove(app_db_loc) + } + + # copy in already instantiated database to avoid need to rebuild + # this is a database created for test-downloadHandler + test_db_loc <- test_path("test-apps", "downloadHandler-app", "dplyr_tidyr.sqlite") + + file.copy( + test_db_loc, + app_db_loc + ) + + # set up new app driver object + app <- AppDriver$new(app_dir = test_path("test-apps"), load_timeout = 600*1000) + + # select_pkg is "-" + expect_equal(app$get_value(input = "sidebar-select_pkg"), "-") + + # set select_pkg to "dplyr" + app$set_inputs(`sidebar-select_pkg` = "dplyr") + + pkg_ver <- app$get_value(input = "sidebar-select_ver") %>% gsub(" - latest version","",.) + # select_ver for "dplyr" should be >= "1.0.10" + # expect_true(pkg_ver >= "1.0.10") + + # status and risk messages should appear + out_htm <- app$get_values()$output$`sidebar-status`$html + status_txt <- rvest::read_html(out_htm) %>% rvest::html_text() + # status is "Under Review" + expect_equal(status_txt, "Under Review") + + out_htm <- app$get_values()$output$`sidebar-score`$html + score_txt <- rvest::read_html(out_htm) %>% rvest::html_text() + # numeric score is between 0 and 1, inclusive + expect_true(dplyr::between(as.numeric(score_txt), 0, 1)) + + # test slider... + app$set_inputs(`sidebar-decision` = "1") # 0 = Low, 1 = Medium, 2 = High + expect_equal(app$get_values()$input$`sidebar-decision`, "Medium") + + app$set_inputs(`sidebar-decision` = "2") # 0 = Low, 1 = Medium, 2 = High + expect_equal(app$get_values()$input$`sidebar-decision`, "High") + + app$set_inputs(`sidebar-decision` = "0") # 0 = Low, 1 = Medium, 2 = High + expect_equal(app$get_values()$input$`sidebar-decision`, "Low") + + # add a comment + add_comment <- "This is a really useful package." + app$set_inputs(`sidebar-overall_comment` = add_comment) + + app$click("sidebar-submit_overall_comment") + app$wait_for_idle() + + # clear the modal + app$run_js('document.getElementById(`shiny-modal`).click();') + + # button was pressed once + expect_equal(app$get_value(input = "sidebar-submit_overall_comment")[1], 1L) + + # comment is hidden + expect_equal(app$get_value(input = "sidebar-overall_comment"), "") + + # change the comment + add_comment <- "OK maybe this is a great package." + app$set_inputs(`sidebar-overall_comment` = add_comment) + + expect_equal(app$get_value(input = "sidebar-overall_comment"), add_comment) + + app$click("sidebar-submit_overall_comment") + app$wait_for_idle() + + app$run_js('document.getElementById(`sidebar-submit_overall_comment_yes`).click();') + + # button was pressed twice + expect_equal(app$get_value(input = "sidebar-submit_overall_comment")[1], 2L) + + # click on submit_decision and submit_confirmed_decision + app$click("sidebar-submit_decision") + app$wait_for_idle() + app$click("sidebar-submit_confirmed_decision") + + # and status and risk messages should appear + out_htm <- app$get_values()$output$`sidebar-status`$html + status_txt <- rvest::read_html(out_htm) %>% rvest::html_text() + # sidebar status set to Reviewed + expect_equal(status_txt, "Reviewed") + + ##### this section only appears with user$role = "admin" + out_htm <- app$get_values()$output$`sidebar-reset_decision_ui`$html + if (!is.null(out_htm)) { + score_txt <- rvest::read_html(out_htm) %>% rvest::html_text() + } else { + score_txt <- "Nothing here" + } + + # do this if the Reset Decision button appeared + if (score_txt == "Reset Decision") { + # reset decision and confirm + app$click("sidebar-reset_decision") + app$wait_for_idle() + app$click("sidebar-reset_confirmed_decision") + # button pressed once + expect_equal(app$get_value(input = "sidebar-reset_decision")[1], 1L) + + out_htm <- app$get_values()$output$`sidebar-status`$html + status_txt <- rvest::read_html(out_htm) %>% rvest::html_text() + # sidebar status is reset to "Under Review" + expect_equal(status_txt, "Under Review") + } + ##### + + # set select_pkg back to "-" + app$set_inputs(`sidebar-select_pkg` = "-") + # expect version to be set to "-" as well + expect_equal(app$get_value(input = "sidebar-select_ver"), "-") + + # status and score have been reset + expect_equal(app$get_value(output = "sidebar-status")$message, "Please select a package") + expect_equal(app$get_value(output = "sidebar-score")$message, "Please select a package") + + app$stop() + unlink("app_db_loc") + rm(app, add_comment, out_htm, pkg_ver, score_txt, status_txt, app_db_loc) +}) \ No newline at end of file diff --git a/tests/testthat/test-uploadPackage.R b/tests/testthat/test-uploadPackage.R new file mode 100644 index 000000000..bc1d395d9 --- /dev/null +++ b/tests/testthat/test-uploadPackage.R @@ -0,0 +1,152 @@ + + +test_that("Uploaded packages show up in summary table", { + # delete app DB if exists to ensure clean test + db_loc <- test_path("test-apps", "database.sqlite") + if (file.exists(db_loc)) { + file.remove(db_loc) + } + + # set up new app driver object + app <- AppDriver$new(app_dir = test_path("test-apps")) + + # test package data to upload + test_csv <- system.file("testdata", "upload_format.csv", package = "riskassessment") + + # upload file to application + app$upload_file( + `upload_package-uploaded_file` = test_csv + ) + + # wait for table to be shown + app$wait_for_value( + output = "upload_package-upload_pkgs_table", + ignore = list(NULL), + timeout = 30 * 1000 # CI keeps failing here... + ) + app$wait_for_idle(1000) + + # parse the package name from the upload summary table + uploaded_packages <- app$get_html("#upload_package-upload_pkgs_table") %>% + rvest::minimal_html() %>% + rvest::html_table() %>% + .[[2]] + + # read in raw data + test_data <- read.csv(test_csv) + + # confirm packages from the two match + expect_identical( + sort(uploaded_packages$package), + sort(test_data$package) + ) + + # confirm status for all is "new" + expect_true(all(test_data$uploaded_packages == "new")) +}) + + +test_that("Sample upload file can be shown and downloaded", { + # delete app DB if exists to ensure clean test + db_loc <- test_path("test-apps", "database.sqlite") + if (file.exists(db_loc)) { + file.remove(db_loc) + } + + # set up new app driver object + app <- AppDriver$new(app_dir = test_path("test-apps")) + + # click to show example upload table + app$click(selector = "#upload_package-upload_format") + app$wait_for_idle(1500) + + # parse displayed table for comparison + display_table <- app$get_html(".modal-body table") %>% + .[[2]] %>% + rvest::minimal_html() %>% + rvest::html_table() %>% + .[[1]] %>% + .[, -1] + + # remove the "spec" and "problem" attributes that exist on internal + # represenatation to allow for comparison; these are appended by readr + template_tbl <- riskassessment:::template + attr(template_tbl, "spec") <- NULL + attr(template_tbl, "problems") <- NULL + template_tbl <- as.data.frame(template_tbl) + + # confirm match + expect_identical( + as.data.frame(display_table), + template_tbl + ) + + # download file from application and read + sample_file <- app$get_download("upload_package-download_sample") + dl_data <- read.csv(sample_file) + + # confirm match + expect_identical( + dl_data, + template_tbl + ) +}) + +test_that("Removed packages show up in summary table", { + # delete app DB if exists to ensure clean test + app_db_loc <- test_path("test-apps", "database.sqlite") + if (file.exists(app_db_loc)) { + file.remove(app_db_loc) + } + + # copy in already instantiated database to avoid need to rebuild + # this is a database created for test-downloadHandler + test_db_loc <- test_path("test-apps", "downloadHandler-app", "dplyr_tidyr.sqlite") + + file.copy( + test_db_loc, + app_db_loc + ) + + pkgs <- dbSelect("select name from package", app_db_loc)[,1] + expect_equal(length(pkgs), 2L) + + # set up new app driver object + app <- AppDriver$new(app_dir = test_path("test-apps")) + + expect_equal(app$get_value(input = "tabs"), "Upload Package") + + # set focus + app$run_js('Shiny.setInputValue("upload_package-curr_pkgs", "load", {priority: "event"})') + app$wait_for_idle(1000) + + # set dplyr as package to remove + app$set_inputs(`upload_package-rem_pkg_lst` = "dplyr") + + app$click(selector = "#upload_package-rem_pkg_btn") + + # wait for table to be shown + app$wait_for_value( + output = "upload_package-upload_pkgs_table", + ignore = list(NULL), + timeout = 30 * 1000 # CI keeps failing here... + ) + app$wait_for_idle(1000) + + # parse the package name from the upload summary table + uploaded_packages <- app$get_html("#upload_package-upload_pkgs_table") %>% + rvest::minimal_html() %>% + rvest::html_table() %>% + .[[2]] + + # expect status is removed + expect_true(all(uploaded_packages$status == "removed")) + expect_identical(uploaded_packages$package[1], "dplyr") + + # There should be just one package left in the db: stringr + pkgs_left <- app$get_value(export = "databaseView-table_data")$name + expect_equal(length(pkgs_left), 1L) + expect_identical(pkgs_left[1], "tidyr") + + app$stop() +}) diff --git a/tests/testthat/test-utils_get_db.R b/tests/testthat/test-utils_get_db.R new file mode 100644 index 000000000..109113e3d --- /dev/null +++ b/tests/testthat/test-utils_get_db.R @@ -0,0 +1,114 @@ +test_that("utils_get_db functions other than dbSelect", { + + base_path <- app_sys("testdata") + # this is a copy of the empty database.sqlite db which is in ./inst/testdata + db_name <- "skeleton.sqlite" + # and this is a temporary datbase + db_temp <- "datatest.sqlite" + + confr <- dbConnect(RSQLite::SQLite(), file.path(base_path, db_name)) + conto <- dbConnect(RSQLite::SQLite(), file.path(base_path, db_temp)) + + # copy into temp db + RSQLite::sqliteCopyDatabase(confr, conto) + + DBI::dbDisconnect(confr) + DBI::dbDisconnect(conto) + + # valid db? test this is a valid sqlite database + testthat::expect_equal(readLines(file.path(base_path, db_temp), n =1, warn = FALSE), "SQLite format 3") + + # load pkg info for stringr into the database + pkg_name <- "stringr" + + pkg_info <- get_latest_pkg_info(pkg_name) + + command <- glue::glue( + "INSERT or REPLACE INTO package + (name, version, title, description, maintainer, author, + license, published_on, decision, date_added) + VALUES('{pkg_name}', '{pkg_info$Version}', '{pkg_info$Title}', '{pkg_info$Description}', + '{pkg_info$Maintainer}', '{pkg_info$Author}', '{pkg_info$License}', '{pkg_info$Published}', + '', '{Sys.Date()}')") + + dbUpdate(command, file.path(base_path, db_temp)) + + comment <- "this is a pretty good package" + user_name <- Sys.info()["user"] + user_role <- "admin" + abrv <- c('o', 'mm', 'cum') + + for(i in seq_along(abrv)) { + metric_abrv <- abrv[i] + command <- glue::glue( + "INSERT INTO comments values('{pkg_name}', '{user_name}', + '{user_role}', '{comment}', '{metric_abrv}', + '{getTimeStamp()}')") + dbUpdate(command, file.path(base_path, db_temp)) + } + + insert_riskmetric_to_db(pkg_name, file.path(base_path, db_temp)) + pkg_id <- dbSelect(glue::glue("SELECT id FROM package WHERE name = '{pkg_name}'"), file.path(base_path, db_temp)) + + insert_community_metrics_to_db(pkg_name, file.path(base_path, db_temp)) + + test_that("get_overall_comments works", { + ocmt <- get_overall_comments(pkg_name, db_name = file.path(base_path, db_temp)) + expect_equal(names(ocmt), c("id", "user_name", "user_role", "comment", "comment_type", "added_on")) + expect_equal(ocmt$id[1], pkg_name) + expect_equal(ocmt$user_name[1], unname(user_name)) + expect_equal(ocmt$comment[1], comment) + expect_equal(ocmt$comment_type, "o") + }) + + test_that("get_mm_comments works", { + mcmt <- get_mm_comments(pkg_name, db_name = file.path(base_path, db_temp)) + expect_equal(mcmt$user_name, unname(user_name)) + expect_equal(names(mcmt), c("user_name", "user_role", "comment", "added_on")) + expect_equal(mcmt$comment, comment) + }) + + test_that("get_cm_comments works", { + ccmt <- get_cm_comments(pkg_name, db_name = file.path(base_path, db_temp)) + expect_equal(ccmt$user_name, unname(user_name)) + expect_equal(names(ccmt), c("user_name", "user_role", "comment", "added_on")) + expect_equal(ccmt$comment, comment) + }) + + test_that("get_mm_data works", { + mmdata <- get_mm_data(pkg_id, file.path(base_path, db_temp)) + expect_s3_class(mmdata, "data.frame") + expect_equal(names(mmdata), c("name", "is_perc", "is_url", "value", "title", "desc", "succ_icon", "unsucc_icon", "icon_class")) + expect_equal(mmdata$name[1], "has_vignettes") + }) + + test_that("get_comm_data works", { + cmdata <- get_comm_data(pkg_name, file.path(base_path, db_temp)) + expect_s3_class(cmdata, "data.frame") + expect_equal(colnames(cmdata), c("id", "month", "year", "downloads", "version")) + expect_equal(cmdata$id[1], pkg_name) + }) + + test_that("get_pkg_info works", { + pkg <- get_pkg_info(pkg_name, file.path(base_path, db_temp)) + expect_s3_class(pkg, "data.frame") + expect_equal(nrow(pkg), 1) + expect_equal(names(pkg), c("id", "name", "version", "title", "description", "maintainer", "author", "license", "published_on", "score", "weighted_score", "decision", "date_added")) + }) + + test_that("get_metric_weights works", { + mtwt <- get_metric_weights(file.path(base_path, db_temp)) + testthat::expect_equal(mtwt$name[1], "has_vignettes") + }) + + test_that("weight_risk_comment works", { + wcmt <- weight_risk_comment(pkg_name, file.path(base_path, db_temp)) + testthat::expect_s3_class(wcmt, "character") + testthat::expect_match(wcmt, regexp = "Metric re-weighting has occurred.") + }) + + unlink(file.path(base_path, db_temp)) + rm(base_path, db_temp, pkg_name, pkg_id, pkg_info, command, comment, user_name, user_role, abrv) + +}) + \ No newline at end of file diff --git a/tests/testthat/test-utils_insert_db.R b/tests/testthat/test-utils_insert_db.R new file mode 100644 index 000000000..024686e1a --- /dev/null +++ b/tests/testthat/test-utils_insert_db.R @@ -0,0 +1,98 @@ +test_that("utils_insert_db functions other than dbUpdate", { + + base_path <- app_sys("testdata") + # this is a copy of the empty database.sqlite db which is in ./inst/testdata + db_name <- "skeleton.sqlite" + # and this is a temporary datbase + db_temp <- "datatest.sqlite" + + confr <- dbConnect(RSQLite::SQLite(), file.path(base_path, db_name)) + conto <- dbConnect(RSQLite::SQLite(), file.path(base_path, db_temp)) + + # copy into temp db + RSQLite::sqliteCopyDatabase(confr, conto) + + DBI::dbDisconnect(confr) + DBI::dbDisconnect(conto) + + # valid db? test this is a valid sqlite database + testthat::expect_equal(readLines(file.path(base_path, db_temp), n =1, warn = FALSE), "SQLite format 3") + + # load pkg info for stringr into the database + pkg_name <- "stringr" + + insert_pkg_info_to_db(pkg_name, file.path(base_path, db_temp)) + + test_that("insert_pkg_info_to_db works", { + pkg <- dbSelect(glue::glue( + "SELECT * + FROM package + WHERE name = '{pkg_name}'"), file.path(base_path, db_temp) + ) + expect_s3_class(pkg, "data.frame") + expect_equal(nrow(pkg), 1) + expect_equal(names(pkg), c("id", "name", "version", "title", "description", "maintainer", "author", "license", "published_on", "score", "weighted_score", "decision", "date_added")) + }) + + insert_riskmetric_to_db(pkg_name, file.path(base_path, db_temp)) + + pkg_id <- dbSelect(glue::glue("SELECT id FROM package WHERE name = '{pkg_name}'"), file.path(base_path, db_temp)) + + test_that("insert_riskmetric_to_db", { + mmdata <- dbSelect(glue::glue( + "SELECT metric.name, metric.long_name, metric.description, metric.is_perc, + metric.is_url, package_metrics.value + FROM metric + INNER JOIN package_metrics ON metric.id = package_metrics.metric_id + WHERE package_metrics.package_id = '{pkg_id}' AND + metric.class = 'maintenance' ;"), file.path(base_path, db_temp)) + expect_s3_class(mmdata, "data.frame") + expect_equal(names(mmdata), c("name", "long_name", "description", "is_perc", "is_url", "value")) + expect_equal(mmdata$name[1], "has_vignettes") + }) + + insert_community_metrics_to_db(pkg_name, file.path(base_path, db_temp)) + + test_that("insert_community_metrics_to_db works", { + cmdata <- dbSelect(glue::glue( + "SELECT * + FROM community_usage_metrics + WHERE id = '{pkg_name}'"), file.path(base_path, db_temp) + ) + expect_s3_class(cmdata, "data.frame") + expect_equal(colnames(cmdata), c("id", "month", "year", "downloads", "version")) + expect_equal(cmdata$id[1], pkg_name) + }) + + update_metric_weight(metric_name = 'has_vignettes', metric_weight = 2, file.path(base_path, db_temp)) + + test_that("update_metric_weight works", { + mtwt <- dbSelect( + "SELECT name, weight + FROM metric where name = 'has_vignettes'", db_name = file.path(base_path, db_temp) + ) + testthat::expect_equal(mtwt$weight, 2) + }) + + test_that("db_trash_collection works", { + cmdata1 <- dbSelect(glue::glue( + "SELECT * + FROM community_usage_metrics + WHERE id = '{pkg_name}'"), file.path(base_path, db_temp) + ) + dbUpdate(glue::glue("delete from package where name = '{pkg_name}'"), db_name = file.path(base_path, db_temp)) + db_trash_collection(db_name = file.path(base_path, db_temp)) + cmdata2 <- dbSelect(glue::glue( + "SELECT * + FROM community_usage_metrics + WHERE id = '{pkg_name}'"), file.path(base_path, db_temp) + ) + testthat::expect_true(nrow(cmdata2) == 0) + testthat::expect_lt(nrow(cmdata2), nrow(cmdata1)) + }) + + unlink(file.path(base_path, db_temp)) + rm(base_path, db_temp, pkg_name, pkg_id) + +}) + \ No newline at end of file diff --git a/tests/testthat/test-utils_startup.R b/tests/testthat/test-utils_startup.R new file mode 100644 index 000000000..2e5ba4bba --- /dev/null +++ b/tests/testthat/test-utils_startup.R @@ -0,0 +1,137 @@ +#### create_db tests #### + +test_that("invalid arguments", { + expect_error(create_db()) + expect_error(create_db(1)) + expect_error(create_db("tmp")) + expect_error(create_db(c("tmp.sqlite", "tmp2.sqlite"))) + expect_error(create_db(), "db_name must follow SQLite naming conventions.*") +}) + +test_that("database creation", { + db <- create_db("tmp.sqlite") + + expect_equal(db, "tmp.sqlite") + + con <- DBI::dbConnect(RSQLite::SQLite(), db) + on.exit({ + DBI::dbDisconnect(con) + unlink(db) + }) + + expect_equal(DBI::dbListTables(con), + c("comments", "community_usage_metrics", "metric", "package", "package_metrics", "sqlite_sequence")) + pkg <- DBI::dbGetQuery(con, "SELECT * FROM package") + expect_equal(nrow(pkg), 0) + expect_equal(names(pkg), c("id", "name", "version", "title", "description", "maintainer", "author", "license", "published_on", "score", "weighted_score", "decision", "date_added")) + metric <- DBI::dbGetQuery(con, "SELECT * FROM metric") + expect_equal(nrow(metric), 12) + expect_equal(names(metric), c("id", "name", "long_name", "is_url", "is_perc", "description", "class", "weight")) + pkg_metric <- DBI::dbGetQuery(con, "SELECT * FROM package_metrics") + expect_equal(nrow(pkg_metric), 0) + expect_equal(names(pkg_metric), c("id", "package_id", "metric_id", "value", "weight")) + com_metric <- DBI::dbGetQuery(con, "SELECT * FROM community_usage_metrics") + expect_equal(nrow(com_metric), 0) + expect_equal(names(com_metric), c("id", "month", "year", "downloads", "version")) + comments <- DBI::dbGetQuery(con, "SELECT * FROM comments") + expect_equal(nrow(comments), 0) + expect_equal(names(comments), c("id", "user_name", "user_role", "comment", "comment_type", "added_on")) +}) + +#### create_credentials_db tests #### + +test_that("invalid arguments", { + expect_error(create_credentials_db()) + expect_error(create_credentials_db(1)) + expect_error(create_credentials_db("tmp")) + expect_error(create_credentials_db(c("tmp.sqlite", "tmp2.sqlite"))) + expect_error(create_credentials_db(), "db_name must follow SQLite naming conventions.*") +}) + +test_that("database creation", { + db <- create_credentials_db("tmp.sqlite") + + expect_equal(db, "tmp.sqlite") + + con <- DBI::dbConnect(RSQLite::SQLite(), db) + on.exit({ + DBI::dbDisconnect(con) + unlink(db) + }) + + expect_equal(DBI::dbListTables(con), + c("credentials", "logs", "pwd_mngt")) + creds <- shinymanager::read_db_decrypt(con, name = "credentials", passphrase = passphrase) + expect_equal(creds$user, "ADMIN") + expect_equal(creds$admin, 'TRUE') + expect_equal(creds$expire, as.character(Sys.Date() + 365)) + pwd <- shinymanager::read_db_decrypt(con, name = "pwd_mngt", passphrase = passphrase) + expect_equal(pwd$must_change, 'TRUE') +}) + +#### create_credentials_dev_db tests #### + +test_that("invalid arguments", { + expect_error(create_credentials_dev_db()) + expect_error(create_credentials_dev_db(1)) + expect_error(create_credentials_dev_db("tmp")) + expect_error(create_credentials_dev_db(c("tmp.sqlite", "tmp2.sqlite"))) + expect_error(create_credentials_dev_db(), "db_name must follow SQLite naming conventions.*") +}) + +test_that("database creation", { + db <- create_credentials_dev_db("tmp.sqlite") + + expect_equal(db, "tmp.sqlite") + + con <- DBI::dbConnect(RSQLite::SQLite(), db) + on.exit({ + DBI::dbDisconnect(con) + unlink(db) + }) + + expect_equal(DBI::dbListTables(con), + c("credentials", "logs", "pwd_mngt")) + creds <- shinymanager::read_db_decrypt(con, name = "credentials", passphrase = passphrase) + expect_equal(creds$user, c("admin", "nonadmin")) + expect_equal(creds$admin, c('TRUE', 'FALSE')) + expect_equal(creds$expire, c(NA_character_, NA_character_)) + pwd <- shinymanager::read_db_decrypt(con, name = "pwd_mngt", passphrase = passphrase) + expect_equal(pwd$must_change, c('FALSE', 'FALSE')) +}) + +#### initialize_raa tests #### + +test_that("database initialization", { + expect_error(initialize_raa()) + expect_error(initialize_raa(assess_db = "tmp_assess.sqlite"), + "cred_db must follow SQLite naming conventions.*") + expect_error(initialize_raa(cred_db = "tmp_cred.sqlite"), + "assess_db must follow SQLite naming conventions.*") + + db_lst <- initialize_raa("tmp_assess.sqlite", "tmp_cred.sqlite") + on.exit(unlink(db_lst)) + expect_true(file.exists(db_lst[1])) + expect_true(file.exists(db_lst[2])) +}) + +#### add_tags tests #### + +test_that("add_tags works", { + at <- add_tags(fluidPage()) + + expect_type(at, "closure") +}) + +#### app_theme tests #### + +test_that("app_theme runs", { + app_thm <- app_theme() + expect_equal(app_thm, + bslib::bs_theme( + bootswatch = "lux", + version = 5, + primary = "#24305E", + secondary = "#F76C6C", + )) +}) diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 000000000..097b24163 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/Administrative_Tools_and_Options.Rmd b/vignettes/Administrative_Tools_and_Options.Rmd new file mode 100644 index 000000000..6f5f82312 --- /dev/null +++ b/vignettes/Administrative_Tools_and_Options.Rmd @@ -0,0 +1,445 @@ +--- +title: "Administrative Tools and Options" +output: + rmarkdown::html_vignette: + toc: false +vignette: > + %\VignetteIndexEntry{Administrative Tools and Options} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include=FALSE} +# Load packages. +library(fontawesome) + +knitr::opts_chunk$set(echo = TRUE) +``` + +


+ +# Introduction + +This guide is to assist `ADMIN` users to manage credentials (aka, user IDs and passwords) and other `ADMIN`-only privileges, such as assessment re-weighting on metrics leveraged by `riskassessment` app. + + +It's no secret that only users with administrator privileges have access to certain features of the application. To verify if you have `ADMIN` access, first check that you can see all THE navigation tabs within the app, especially the rightmost "Administrative Tools" tab. If you do not see this tab, you have not been granted access! To gain access, you'll have to request access from a known `ADMIN` user within your organization. + +
+ +
+![](images/top_left_tabs.png){style="margin: 10px 0 10px 0"} +
+ +![](images/admin_mode_button.png){style="float:right; width:60px; margin-left: 20px;"} + +
+ +You can also hover your cursor over the `r fa("plus")` symbol in the bottom-right corner of the page. Upon hovering, two additional buttons should appear. The middle one is the log out `r fa("right-from-bracket")` button, while the Administrator mode `r fa("gears")` button will appear on top, as shown. This button will not appear from non-`ADMIN` users. + + +
+ + +Once you have selected the `Administrative Tools` tab, there are currently two areas available for review: the first is `Credential Manager` and the second is `Assessment Reweighting`, as seen below. + +
+ +
+![](images/admin_tools_tabs.png) +
+ +
+ +
+ +# Credential Manager + +The Credential Manager tab is shown by default which contains two tables: + +* The first one, indicated by the `r fa("users")` Users icon, is used to manage users. + +* The the second one, indicated by the `r fa("key")` key icon, is used to manage passwords. + +There is also a button at the bottom to download a copy of the current sqlite database. + +
+ +![](images/admin_mode_tables1.png){style="position:center; width:790px"} +
+ +![](images/admin_mode_tables2.png){style="position:center; width:790px"} + +
+ +## Managing Users + +The first table provides tools for managing of users: adding, editing, and deleting. + +
+ +### Add a User + +![](images/add_a_user_btn.png){style="align:left; width:142px"} + + +
+ + +To add a new user, click the dark blue button labelled: "Add a user". + + +
+ +![](images/add_user.png){style="float:right; width:411px; margin-left: 20px;"} +

+ +A prompt will appear where you can specify a user name, as well as **optional** start & expire date for that new member. By default set to today's date (more on that later). + +


+ +Here, we'll type "PeterParker" into the User Name field. + +







+ +Notice the checkbox to grant the new user administrator privileges is also checked by default. A unique password is generated which the user will be prompted to change the first time he/she logs on, as long as the "Ask to change password" box remains checked. + +
+ +
+ +
+ +
+ +Upon clicking "Confirm New User", a confirmation modal will appear. Now would be a good time to notify the user by sending them their userid and temporary password. + + +
+ +
+![](images/new_user_modal.png){style="width:410px"} +
+ +
+ +### User `start` and `expire` dates + + +
+ +![](images/account_expired_msg.png){style="float:right; width:312px; margin-left: 20px;"} + +If either the **start** date is set to a future date or the **expire** date is set to **before** today's date, an "account expired" message will appear, and the log-on attempt will fail. + +
+ +Feel free to set either or both of these dates as needed, or just leave them blank to ignore/avoid time-based access for a particular user. + +
+ +
+ +### Edit a user + +
+ +![](images/users_table.png){style="position:center; width:780px"} + +
+ +Edit user information by clicking on the dark blue `r fa(name = "pen-to-square", fill = "darkblue", height = "1em")` Edit button, found on the right-hand side of the table.

+ + +An Edit User window will appear: + +
+ +
+![](images/edit_user_popup.png){style="position:center; width:416px"} +
+ +
+ +Make your changes, and then click on "Confirm Change".
+ +
+ +
+![](images/user_updated_modal.png){style="position:center; width:343px"} +
+ +
+ +A small modal dialog box will appear (briefly) indicating the user has been successfully updated. + + +
+ + +### More Edit options + +At the bottom of this table is a bar with three buttons: + +
+ +
+![](images/edit_remove_select_users.png){style="position:left; width:456px"} +
+ +
+ + +The first one is a checkbox `r fa(name = "square-check", fill = "red", height = "1em")` +to select multiple users followed by an `r fa(name = "pen-to-square", fill = "darkblue", height = "1em")` "Edit Selected Users" and a `r fa(name = "trash-can", fill = "red", height = "1em")` "Remove Selected Users" button. These buttons are enabled when you select **two or more** users. + +
+ +
+![](images/edit_select_users.png){style="float:left; width:406px; margin-right: 20px;"} +
+ +Note the "Edit Selected Users" button only allows you to modify the `start` and `expire` dates for that selected group of users. + +
+ +After you've made your changes, click "Confirm Change". + +
+ +
+ +
+ +Again, a small modal dialog box will briefly appear indicating the users have been updated. + +
+ +
+![](images/user_updated_modal.png){style="width:257px"} +
+ +
+ +### Delete a user + +
+ +![](images/users_table.png){style="position:center; width:780px"} + +
+ +
Delete any user by clicking on the red `r fa(name = "trash-can", fill = "red", height = "1em")` +Remove button on the right-hand side of the table. You will see a confirmatory modal dialog box. Click on "Delete User(s)." + +
+ +
+![](images/delete_user_modal.png){style="position:center; width:410px"} +
+ +
+ +You can also delete multiple users like you did with editing multiple users. Just click on the `r fa(name = "trash-can", fill = "red", height = "1em")` "Remove Selected Users" button at the bottom of the table. + +
+ +
+![](images/edit_remove_select_users.png){style="position:left; width:456px"} +
+ +
+ +The same confirmatory modal dialog box will appear. Click on "Delete User(s)." + +
+ +
+![](images/confirm_delete_users.png){style="position:center; width:410px"} +
+ +
+ + +### Replace initial `Admin` user + +![](images/create_new_admin.png){style="float:right; width:410px; margin-left: 20px;"} + + +As an administrator, it's recommended you replace the initial `ADMIN` user ID created the first time the app is launched. Note that there must always be **at least** one admin user, and **you cannot delete yourself!** If you want to delete the initial `admin` user you will first need to create another user ID with administrative privileges, as described below. + +
+ +Just as before, click the blue "Add a user" button and make sure to check the `Admin` box. The temporary password can be overridden by un-checking the "ask to change password" box and setting the password to whatever you want. + +
+ +After completing the form, sign in using your new credentials and delete the original `ADMIN` user by clicking on the red `r fa(name = "trash-can", fill = "red", height = "1em")` Remove button on that row of the table. + +








+ + +
+ +## Managing Passwords + +The second table allows for password management. + +
+ +![](images/password_table.png){style="position:center; width:780px"} + +
+ +Click on the dark blue `r fa(name = "key", fill = "darkblue", height = "1em")`*Change password* button to force the corresponding user to change his/her password on the next log-in. + +A confirmatory modal dialog box will appear, like this: + +
+ +
+![](images/confirm_change_password.png){style="position:center; width:416px"} +
+ +
+ +If you click on the orange `r fa(name = "arrow-rotate-left", fill = "orange", height = "1em")` *Reset password* button to generate a temporary password. + +Again, a confirmatory modal dialog box will appear, like this: + +
+ +
+![](images/confirm_reset_password.png){style="position:center; width:416px"} +
+ +
+ +Click on "Confirm" and you will see another modal dialog box with the new temporary password in it. + +
+ +
+![](images/password_reset.png){style="position:center; width:415px"} +
+ +
+ +You are responsible for delivering the new temporary password to the user. + +
As on the bottom of the User table, There is also a checkbox `r fa(name = "square-check", fill = "red", height = "1em")` to select multiple users followed by
a "Force Selected Users to Change Password" button. This button is enabled when you select two or more users. + +
+ +
+![](images/force_change_password.png){style="position:center; width=395px"} +
+ +
+ +### Additional columns in Passwords table + +- Must change column: Indicates whether the user has to change his/her password +next log-in. +- Have changed column: Indicates the user has already changed his/her password. +- Date Last changed column: Indicates the date the password was updated. + + +
+ + +# Assessment Reweighting + +Head over to the other tab available to `ADMIN` users called `Assessment Reweighting`. Here is a high level view: + +![](images/assessment_reweighting_tab.png){style="position:center; width:800px"} + +

There are three buttons on this page: "Update Weight" on the top right, "Download" on the middle left, and "Re-Calculate" on the bottom left. + +
+ +## Download Database + +First, the simplest: the "Download Database" button. + +
+ +
+![](images/download_db_btn.png){style="position:center; width:392px"} +
+ +
+ +When clicked, this button will download a copy of the current database (by default, called "database.sqlite"). The app developers recommend doing this anytime you plan to make integral changes to the database (like changing metric weights), before anything else. + +
+ +## Updating Weights + +As the name suggests, this modules allows to us view existing and change metric weights used to calculate a risk score using `riskmemtric`. + +
+ +
+![](images/set_update_weights.png){style="position:center; width:812px"} +
+ +
+ +
Here you can either select a metric from the "Select metric" dropdown box or select a row
in the "CURRENT RISK SCORE WEIGHTS BY METRIC" table. + +Once the metric is selected, enter a new (numeric) weight in the "Choose new weight" box and select the "Update Weight" button. You'll notice the row with the change will appear highlighted, showing you the old weight value and the new weight value: + +
+ +
+![](images/weight_updated.png){style="position:center; width:540px"} +
+ +
+ +After you have updated **at least one** metric weight, the "Re-Calculate" button is enabled, allowing you to apply new weights and re-calculated the risk for each package.
+ +After you've made all final re-weighting changes, you can click the "Re-calculate" button pictured here. Note that these weight changes will take effect on all packages in the database, updating the risk score for each. + +
+ +
+![](images/apply_new_weights.png){style="position:center; width:481px"} +
+ +
+ +

Once you click on "Re-Calculate" you will get a confirmation modal, reminding you that "updating the risk metrics cannot be reverted", and strongly recommending you download a copy of the current database first before clicking on "Submit". The modal also details all the actions that will take effect in the app if you submit these changes. + +
+ +
+![](images/confirm_update_weights.png){style="position:center; width:654px"} +
+ +
+ +Once you click on "Submit" a modal dialog box will appear indicating +that it is applying weights and updating risk scores to each package you have uploaded. This will be followed by a brief "updates completed" message. + +
+ +
+![](images/reweighting_modal.png){style="position:center; width:373px"} +
+ +
+ +Now go to the database overview tab to confirm that the risk scores have been updated. You can also view the new weights, including the standardized weight on the `Assessment Criteria` tab. + + +
+
+
+
+
+
+
+ + diff --git a/docs/Using_SQLite_Command_Line.Rmd b/vignettes/dev_Using_SQLite_Command_Line.Rmd similarity index 86% rename from docs/Using_SQLite_Command_Line.Rmd rename to vignettes/dev_Using_SQLite_Command_Line.Rmd index f4151e128..55d2fbefc 100644 --- a/docs/Using_SQLite_Command_Line.Rmd +++ b/vignettes/dev_Using_SQLite_Command_Line.Rmd @@ -4,6 +4,10 @@ output: html_document: theme: spacelab highlight: pygments +vignette: > + %\VignetteIndexEntry{Using SQLite Command Line} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} --- diff --git a/www/sql_queries/create_comments_table.sql b/www/sql_queries/create_comments_table.sql deleted file mode 100644 index 6e63968e6..000000000 --- a/www/sql_queries/create_comments_table.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE IF NOT EXISTS comments ( - id CHAR NOT NULL, - user_name CHAR, - user_role CHAR, - comment CHAR, - comment_type CHAR, - added_on DATE -); \ No newline at end of file diff --git a/www/sql_queries/create_community_usage_metrics_table.sql b/www/sql_queries/create_community_usage_metrics_table.sql deleted file mode 100644 index eab868ede..000000000 --- a/www/sql_queries/create_community_usage_metrics_table.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE IF NOT EXISTS community_usage_metrics ( - id CHAR NOT NULL, - month INT, /* Format: 01 */ - year INT, /* Format: 2022 */ - downloads INT, - version CHAR, - FOREIGN KEY(id) REFERENCES package(name) -); \ No newline at end of file diff --git a/www/sql_queries/create_metric_table.sql b/www/sql_queries/create_metric_table.sql deleted file mode 100644 index 410e5d676..000000000 --- a/www/sql_queries/create_metric_table.sql +++ /dev/null @@ -1,10 +0,0 @@ -CREATE TABLE IF NOT EXISTS metric ( - id INTEGER PRIMARY KEY AUTOINCREMENT, - name CHAR, - long_name CHAR, /* Represents the title of the metrixBox. */ - is_url INTEGER, /* Indicates whether the metric value is a url. 0: indicates FALSE, 1: indicates TRUE */ - is_perc INTEGER, /* Indicates whether the metric value is a percentage. 0: indicates FALSE, 1: indicates TRUE */ - description CHAR, - class CHAR, /* class = maintenance or test */ - weight REAL -); \ No newline at end of file diff --git a/www/sql_queries/create_package_metrics_table.sql b/www/sql_queries/create_package_metrics_table.sql deleted file mode 100644 index d387dbc06..000000000 --- a/www/sql_queries/create_package_metrics_table.sql +++ /dev/null @@ -1,11 +0,0 @@ -CREATE TABLE IF NOT EXISTS package_metrics ( - id INTEGER PRIMARY KEY AUTOINCREMENT, - package_id INT, - metric_id INT, - value CHAR, - /* value == 'pkg_metric_error' indicates an error. */ - /* value == NA indicates metric is not applicable for this package. */ - weight REAL, - FOREIGN KEY (package_id) REFERENCES package(id), - FOREIGN KEY (metric_id) REFERENCES metric(id) -); \ No newline at end of file diff --git a/www/sql_queries/create_package_table.sql b/www/sql_queries/create_package_table.sql deleted file mode 100644 index 4e8942b7b..000000000 --- a/www/sql_queries/create_package_table.sql +++ /dev/null @@ -1,15 +0,0 @@ -CREATE TABLE IF NOT EXISTS package ( - id INTEGER PRIMARY KEY AUTOINCREMENT, - name CHAR, - version CHAR, - title CHAR, - description TEXT, - maintainer CHAR, - author CHAR, - license CHAR, - published_on CHAR, - score REAL, - weighted_score REAL, - decision CHAR, - date_added DATE -); \ No newline at end of file diff --git a/www/sql_queries/initialize_metric_table.sql b/www/sql_queries/initialize_metric_table.sql deleted file mode 100644 index fdbad3836..000000000 --- a/www/sql_queries/initialize_metric_table.sql +++ /dev/null @@ -1,15 +0,0 @@ -INSERT INTO metric -(name, long_name, description, is_perc, is_url, class, weight) -VALUES -('has_vignettes', 'Vignettes', 'Number of vignettes', 0, 0, 'maintenance', 1), -('has_news', 'NEWS file', 'Number of NEWS files', 0, 0, 'maintenance', 1), -('news_current', 'NEWS current', 'NEWS contains current version', 0, 0, 'maintenance', 1), -('has_bug_reports_url', 'Report Bugs', 'Public url to report bugs', 0, 1, 'maintenance', 1), -('has_website', 'Website', 'Package public website', 0, 1, 'maintenance', 1), -('has_maintainer', 'Maintainer', 'Package maintainers', 0, 0, 'maintenance', 1), -('has_source_control', 'Source Control', 'Package source control url', 0, 1, 'maintenance', 1), -('export_help', 'Documentation', '% of documented objects', 1, 0, 'maintenance', 1), -('bugs_status', 'Bugs Closure Rate', '% of the last 30 bugs closed', 1, 0, 'maintenance', 1), -('license', 'License', "Package's license", 0, 0, 'maintenance', 1), -('covr_coverage', 'Test Coverage', 'Percentage of objects tested', 0, 1, 'test', 0), -('downloads_1yr', 'Downloads', 'Number of package downloads in the last year', 0, 0, 'community', 1); \ No newline at end of file