Merge branch 'demo-shinyserver-v310' into jt-rm_with_eval_recording

.github/workflows/test-coverage.yaml

@@ -1,4 +1,4 @@
-# Workflow derived from https://github.com/r-lib/actions/tree/master/examples
+# 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
 on:
   push:
@@ -9,6 +9,8 @@ on:
 
 name: test-coverage
 
+permissions: read-all
+
 jobs:
   test-coverage:
     runs-on: ubuntu-latest
@@ -24,21 +26,45 @@ jobs:
           sudo apt-get update
           sudo apt-get install -y texlive-xetex
       
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-pandoc@v2
 
       - uses: r-lib/actions/setup-r@v2
         with:
-          use-public-rspm: true
+          use-public-rspm: false
           r-version: 'renv'
 
       - uses: r-lib/actions/setup-renv@v2
 
-      - name: Install riskassessment
-        shell: bash
-        run: R CMD INSTALL --preclean .
-
       - name: Test coverage
-        run: covr::codecov()
+        run: |
+          cov <- covr::package_coverage(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+          )
+          covr::to_cobertura(cov)
         shell: Rscript {0}
+
+      - uses: codecov/codecov-action@v4
+        with:
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }}
+          file: ./cobertura.xml
+          plugin: noop
+          disable_search: true
+          token: ${{ secrets.CODECOV_TOKEN }}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v4
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

.gitignore

@@ -1,5 +1,4 @@
 rsconnect/
-/*.sqlite
 .Rproj.user
 .Rhistory
 .RData
@@ -12,6 +11,7 @@ inst/doc
 auto_decisions.json
 ^docs$
 docs/
-tarballs/
+*.sqlite
+!*demo.sqlite
 report_preferences/
 .Renviron

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: riskassessment
 Title: A web app designed to interface with the `riskmetric` package
-Version: 3.1.0
+Version: 3.1.1
 Authors@R: c( 
     person("Aaron", "Clark", role = c("aut", "cre"), email = "[email protected]"),
     person("Jeff", "Thompson", role = c("aut"),  email = "[email protected]", comment = "Co-Lead"),

NEWS.md

@@ -1,3 +1,10 @@
+# riskassessment 3.1.1
+
+* Added navigation controls in Function Explorer tab (#644)
+* Fixed bug that crashed the Package Dependencies page for pkgs without any dependency info available (#802)
+* Fixed bug that incorrectly displayed 0 dependencies as 1 (#805)
+* Fixed bug that kept full list of available packages from populating (#776)
+
 # riskassessment 3.1.0
 
 ### User Enhancements

R/app_server.R

@@ -11,9 +11,20 @@ app_server <- function(input, output, session) {
 
   old <- options()
   onStop(function() {
-    options(old)
-    })
-  options(repos = get_db_config("package_repo"))
+    options(c(
+      # Unsets available packages filter if unset previously. Will be overriden
+      # otherwise.
+      list(available_packages_filters = NULL),
+      old
+    ))
+  })
+  options(
+    # Set session repo to value specified in configuration file
+    repos = get_db_config("package_repo"),
+    # Removes filters based on R version, OS type, sub-architecture. Only
+    # duplicates will be removed from the available package list
+    available_packages_filters = "duplicates"
+  )
 
   # Collect user info.
   user <- reactiveValues()

R/mod_code_explorer.R

@@ -31,7 +31,7 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(
         showHelperMessage(message = glue::glue("Source code not available for {{{selected_pkg$name()}}}"))
       } else {
         div(introJSUI(NS(id, "introJS")),
-          br(),
+            br(),
           fluidRow(
             column(3,
                    wellPanel(
@@ -69,7 +69,28 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(
                    div(id = ns("file_viewer"),
                      uiOutput(ns("file_output"), class = "file_browser"),
                      style = "height: 62vh; overflow: auto; border: 1px solid var(--bs-border-color-translucent);"
-                   )
+                   ),
+                   br(),
+                   fluidRow(style = "height:35px !important;",
+                            column(4,offset = 8,
+                                   conditionalPanel(
+                                     condition = "typeof(window.$highlights_list) != 'undefined' && window.$highlights_list.length > 1",
+                                     actionButton(ns("prev_button"),label = "",icon = icon("chevron-left"),
+                                                  style ="width: 32px !important; 
+                            height: 32px !important;
+                            font-size: 16px !important;
+                            line-height: 5px !important;
+                            padding: 0px !important;") |>bslib::tooltip("Previous occurence"), style = "display: inline-block;",
+
+                            div(id = "search_index","",style ="display:inline"),
+                            actionButton(ns("next_button"),label = "",icon = icon("chevron-right"),
+                                           style = "width: 32px !important; 
+                            height: 32px !important;
+                            font-size: 16px !important;
+                            line-height: 5px !important;
+                            padding: 0px !important;
+                            display:inline;
+                            ")|>bslib::tooltip("Next occurence",placement ="right"), style = "display: inline-block;")))
             )
           ),
           br(), br(),
@@ -127,7 +148,7 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(
       close(con)
       func_list <- c(input$exported_function, paste0("`", input$exported_function, "`"))
       highlight_index <- parse_data() %>% 
-        filter(stringr::str_ends(file, input$test_files) & func %in% func_list) %>% 
+        filter(basename(file) == input$test_files & func %in% func_list) %>% 
         pull(line)
       renderCode(lines, highlight_index)
     }) %>%
@@ -144,7 +165,7 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(
       close(con)
       func_list <- c(input$exported_function, paste0("`", input$exported_function, "`"))
       highlight_index <- parse_data() %>% 
-        filter(stringr::str_ends(file, input$source_files) & func %in% func_list) %>% 
+        filter(basename(file) ==  input$source_files & func %in% func_list) %>% 
         pull(line)
       renderCode(lines, highlight_index)
     }) %>%
@@ -157,16 +178,70 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(
       con <- archive::archive_read(file.path("tarballs",
                                              glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")),
                                    file = fp)
+
       Rdfile <-tools::parse_Rd(con)
       close(con)
+      shinyjs::runjs('
+                    $highlights_list = undefined;')
+
       HTML(paste0(utils::capture.output(tools::Rd2HTML(Rdfile,
                                                package = c(selected_pkg$name(),
                                                            selected_pkg$version()), out = "")), collapse = "\n"))
     }) %>%
       bindEvent(input$man_files, input$exported_function, ignoreNULL = FALSE)
 
     introJSServer("introJS", text = reactive(fe_steps), user, credentials)
+    search_index_value <- reactiveVal(1)
+    highlight_list <- reactiveVal(1)
+
+    observeEvent(input$next_button,{
+      if (input$next_button > 0){
+      shinyjs::runjs('
+                    var $index =Array.from($highlights_list).findIndex(node => node.isEqualNode($curr_sel));
+                    if( $index == $highlights_list.length -1) 
+                    {
+              
+                          $curr_sel = $highlights_list[0]
+                          search_index.innerHTML = 1 + " of " + $highlights_list.length;
+              
+                    }
+                else 
+                    {
+                          $curr_sel = $highlights_list[$index +1]
+                          search_index.innerHTML =  ( $index+2) + " of " + $highlights_list.length;
+                    }  
+                
+                    var $target = document.querySelector("#code_explorer-file_viewer")
+                    $target.scrollTop = 0;
+                    $target.scrollTop =$curr_sel.offsetTop -40; ')
+
+      }
+
+    })
 
+    observeEvent(input$prev_button,{
+      if (input$prev_button > 0){
+
+        shinyjs::runjs('var $index =Array.from($highlights_list).findIndex(node => node.isEqualNode($curr_sel));
+                      if( $index ==0) 
+                      {
+                            $curr_sel = $highlights_list[$highlights_list.length -1]
+                            search_index.innerHTML =   $highlights_list.length + " of " + $highlights_list.length;
+                      }
+                        else 
+                      {
+                            $curr_sel = $highlights_list[$index -1]
+                            search_index.innerHTML =   ($index) + " of " + $highlights_list.length;
+                      }  
+                      var $target = document.querySelector("#code_explorer-file_viewer")
+ 
+                      $target.scrollTop = 0; 
+                      $target.scrollTop = $curr_sel.offsetTop  - 40; 
+
+              ')
+      }
+
+    })
     output$file_output <- renderUI({
       switch (input$file_type,
               test = test_code(),

R/mod_code_explorer_utils.R

@@ -172,9 +172,19 @@ renderCode <- function(lines, hlindex) {
                })
              ),
              tags$script(HTML("
+                             
         document.querySelectorAll('.code pre').forEach(bl => {
           hljs.highlightBlock(bl);
         }); 
+        var $highlights_list = document.querySelectorAll('.highlight')
+        var $curr_sel = document.querySelector('.highlight')
+       if(typeof($highlights_list) != 'undefined' & $curr_sel != null){
+        var $target = document.querySelector('#code_explorer-file_viewer')
+        $target.scrollTop = 0;
+        $target.scrollTop = $curr_sel.offsetTop  - 40;
+        var $index1 =Array.from($highlights_list).findIndex(node => node.isEqualNode($curr_sel)) +1;
+        search_index.innerHTML =   $index1 + ' of ' + $highlights_list.length;
+       }
       "))
   )
 }

R/mod_packageDependencies.R

@@ -64,7 +64,7 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren
       req(pkgref())
       tryCatch(
         expr = {
-          deep_ends <- pkgref()$dependencies[[1]] %>% dplyr::as_tibble() %>% 
+          deep_ends <- {if(suppressWarnings(is.null(nrow(pkgref()$dependencies[[1]])) || nrow(pkgref()$dependencies[[1]]) == 0)) dplyr::tibble(package = character(0), type = character(0)) else pkgref()$dependencies[[1]] %>% dplyr::as_tibble()} %>% 
             mutate(package = stringr::str_replace(package, "\n", " ")) %>%
             mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])"))
 
@@ -94,7 +94,8 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren
       )
       tryCatch(
         expr = {
-          shrug_jests <- pkgref()$suggests[[1]] %>% dplyr::as_tibble()%>% 
+          shrug_jests <- 
+            {if(suppressWarnings(is.null(nrow(pkgref()$suggests[[1]])) || nrow(pkgref()$suggests[[1]]) == 0)) dplyr::tibble(package = character(0), type = character(0)) else pkgref()$suggests[[1]] %>% dplyr::as_tibble()} %>% 
             mutate(package = stringr::str_replace(package, "\n", " ")) %>%
             mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])"))
 
@@ -122,8 +123,7 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren
                                  decision_id = character(0)))
         }
       )
-      # this is so the dependencies is also a 0x2 tibble like suggests
-      if (rlang::is_empty(pkgref()$dependencies[[1]])) depends(dplyr::tibble(package = character(0), type = character(0), name = character(0)))
+
 
       revdeps(pkgref()$reverse_dependencies[[1]] %>% as.vector())