Ni 581 introjshandling

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: riskassessment
 Title: A web app designed to interface with the `riskmetric` package
-Version: 3.0.0.9002
+Version: 3.0.0.9003
 Authors@R: c( 
     person("Aaron", "Clark", role = c("aut", "cre"), email = "[email protected]"),
     person("Robert", "Krajcik", role = "aut", email = "[email protected]"),
@@ -13,6 +13,7 @@ Authors@R: c(
     person("Maya", "Gans", role = "aut", email = "[email protected]"),
     person("Aravind Reddy", "Kallem", role = "aut"),
     person("Eduardo", "Almeida", role = "ctb", email = "[email protected]"),
+    person("Narayanan","Iyer",role = "ctb", email = "[email protected]"),
     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")),

NEWS.md

@@ -1,6 +1,9 @@
 # riskassessment (development version)
+
 * Fixes bug that doesn't reset decision by and date fields when re-scoring/re-weighting packages (#680)
 * Fixes bug where the privileges table was not aligned with the used privileges in the application (#697)
+* Added introjs for file browser & function explorer( #581)
+
 
 # riskassessment 3.0.0
 

R/mod_code_explorer.R

@@ -29,14 +29,17 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c
       } else if (!file.exists(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")))) {
         showHelperMessage(message = glue::glue("Source code not available for {{{selected_pkg$name()}}}"))
       } else {
-        div(
+        div(introJSUI(NS(id, "introJS")),
           br(),
           fluidRow(
             column(3,
                    wellPanel(
+                     div(id = ns("function_list"),
                      selectInput(ns("exported_function"), "Exported Function", choices = exported_functions()) %>%
-                       tagAppendAttributes(class = "exported_function"),
-                     selectInput(ns("file_type"), "File Type", choices = c("Testing Files" = "test", "R Source Code" = "source", "Help Documentation" = "man")),
+                       tagAppendAttributes(class = "exported_function")),
+                     div(id = ns("file_type"),
+                         selectInput(ns("file_type"), "File Type", choices = c("Testing Files" = "test", "R Source Code" = "source", "Help Documentation" = "man"))),
+                     div(id = ns("file_list"),
                      conditionalPanel(
                        condition = "input.file_type == 'test'",
                        selectInput(ns("test_files"), NULL,
@@ -59,9 +62,10 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c
                        ns = ns
                      )
                    )
+                   )
             ),
             column(9,
-                   div(
+                   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);"
                    )
@@ -138,6 +142,8 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c
     }) %>%
       bindEvent(input$man_files, input$exported_function, ignoreNULL = FALSE)
 
+    introJSServer("introJS", text = reactive(fe_steps), user, credentials)
+
     output$file_output <- renderUI({
       switch (input$file_type,
               test = test_code(),

R/mod_introJS_utils_text.R

@@ -23,7 +23,7 @@ sidebar_steps <-
 # appui tab widgets
 apptab_steps <- data.frame(
   element = c(
-  "[data-value=assessment-criteria-tab]", "[data-value=database-tab]"),
+    "[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))
@@ -64,15 +64,14 @@ upload_pkg_dec_adj <- data.frame(
   position = "left"
 )
 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")
+  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")
 )
 
-
 # Maintenance metrics.
 mm_steps <- 
   data.frame(
@@ -84,6 +83,32 @@ mm_steps <-
     position = c(rep("left", 2))
   )
 
+# Package Explorer
+pe_steps <- 
+  data.frame(
+    element = c("#pkg_explorer-file_tree", "#pkg_explorer-file_editor","#pkg_explorer-comments_for_se"),
+    intro = c(
+      "The file tree shows all the files inside.Click to view.",
+      "Text inside selected file from package if viewable",
+      "Add comments for any files"
+    ),
+    position = c("left","left","top")
+  )
+
+# Function Explorer
+fe_steps <- 
+  data.frame(
+    element = c("#code_explorer-function_list", "#code_explorer-file_type","#code_explorer-file_list","#code_explorer-file_viewer","#code_explorer-comments_for_fe"),
+    intro = c(
+      "Exported Functions.Click to view",
+      "Select type/source of function",
+      "File in which selected function is found",
+      "File viewer with selected function highlighted",
+      "Add comments for any functions"
+    ),
+    position = c(rep("right", 3), rep("top", 2))
+  )
+
 
 # Report Preview.
 rp_steps <- data.frame(

R/mod_pkg_explorer.R

@@ -38,20 +38,22 @@ mod_pkg_explorer_server <- function(id, selected_pkg,
       } else if (!file.exists(file.path("tarballs", glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")))) {
         showHelperMessage(message = glue::glue("Source code not available for {{{selected_pkg$name()}}}"))
       } else {
-        div(
+        div(introJSUI(NS(id, "introJS")),
             br(),
             fluidRow(
               column(4,
+                     div(id = ns("file_tree"),
                      wellPanel(
                        {
                          treeTag <- 
                            shinyTree::shinyTree(ns("dirtree"), theme = "proton", types = '{"default":{"icon":"fa fa-folder"},"file":{"icon":"fa fa-file"}}')
                          treeTag[[1]]$children[[3]] <- NULL
                          treeTag
                        }
-                     )
+                     ))
               ),
               column(8,
+                     div(id = ns("file_editor"),
                      conditionalPanel(
                        condition = "output.is_file",
                        shinyAce::aceEditor(ns("editor"), value = "", height = "62vh",
@@ -61,7 +63,7 @@ mod_pkg_explorer_server <- function(id, selected_pkg,
                        ),
                        htmlOutput(ns("filepath")),
                        ns = ns
-                     )
+                     ))
               )
             ),
             br(), br(),
@@ -83,7 +85,15 @@ mod_pkg_explorer_server <- function(id, selected_pkg,
 
     nodes <- reactive({
       req(pkgdir())
-      make_nodes(list.files(pkgdir(), recursive = TRUE))
+      s <- make_nodes(list.files(pkgdir(), recursive = TRUE))
+      if(!is.null(s[["DESCRIPTION"]])){
+      attr(s[["DESCRIPTION"]],"stselected") = TRUE
+      }
+      else {
+        f <- names(head(purrr::keep(s, \(x) !is.null(attr(x, "sttype"))), 1))
+        attr(s[[f]],"stselected") = TRUE
+      }
+      s
     }) %>%
       bindEvent(pkgdir(), selected_pkg$name())
 
@@ -117,6 +127,8 @@ mod_pkg_explorer_server <- function(id, selected_pkg,
       shinyAce::updateAceEditor(session, "editor", value = s, mode = e)
     })
 
+    introJSServer("introJS", text = reactive(pe_steps), user, credentials)
+
     output$filepath <- renderUI({
       s <- if (is_file())
         get_selected_path(shinyTree::get_selected(input$dirtree, "slices")[[1]]) else ""

tests/testthat/test-introJS.R

@@ -12,6 +12,23 @@ test_that("The introJS module works as expected for admins", {
     app_db_loc
   )
 
+  app_tar_loc <- test_path("test-apps", "tarballs", "tidyr_1.3.0.tar.gz")
+  if (!dir.exists(dirname(app_tar_loc))) {
+    dir.create(dirname(app_tar_loc))
+  }
+  if (!file.exists(app_tar_loc)) {
+    download.file(
+      "https://cran.r-project.org/src/contrib/tidyr_1.3.0.tar.gz", #This will need to be changed in the future
+      app_tar_loc,
+      mode = "wb"
+    )
+  }
+
+  app_src_loc <- test_path("test-apps", "source", "tidyr")
+  if (!dir.exists(app_src_loc)) {
+    untar(app_tar_loc, exdir = dirname(app_src_loc))
+  }
+
   getBoundingClientRect <- function(appDriver, el) {
     appDriver$get_js(glue::glue('const rect = $("{el}")[0].getBoundingClientRect(); [rect.left, rect.top, rect.bottom, rect.right]')) %>% purrr::possibly(purrr::set_names, otherwise = .)(c("left", "top", "bottom", "right"))
   }
@@ -36,7 +53,7 @@ test_that("The introJS module works as expected for admins", {
   expect(all(purrr::map_lgl(el_pos, ~ any(.x > 0))), "One or more elements are not visible")
   steps <- app$get_value(export = "upload_package-introJS-steps")
   expect_equal(upload_pkgs, steps)
-
+  
   app$click(selector = ".introjs-skipbutton")
 
   app$run_js("Shiny.setInputValue('upload_package-load_cran', 'load')")
@@ -66,7 +83,7 @@ test_that("The introJS module works as expected for admins", {
   app$set_inputs(tabs = "Package Metrics",
                  metric_type = "mm")
   app$set_inputs(`sidebar-select_pkg` = "tidyr")
-  app$wait_for_idle()
+  app$wait_for_idle(timeout = 30 * 1000)
 
   app$click("maintenanceMetrics-introJS-help")
   app$wait_for_idle()
@@ -83,6 +100,50 @@ test_that("The introJS module works as expected for admins", {
 
   app$click(selector = ".introjs-skipbutton")
 
+  app$set_inputs(tabs = "Source Explorer",
+                 explorer_type = "fb")
+
+  app$set_inputs(`sidebar-select_pkg` = "tidyr")
+
+  app$wait_for_idle()  
+
+  app$click("pkg_explorer-introJS-help")
+
+
+
+  pkg_explorer <- dplyr::bind_rows(pe_steps, apptab_admn, apptab_steps, sidebar_steps)
+
+  # Verify that all elements exist and are visible
+  el_pos <- purrr::map(pkg_explorer$element, getBoundingClientRect, appDriver = app)
+  introjs_bullets <- app$get_js("$('.introjs-bullets ul li').length")
+  expect(length(el_pos) == introjs_bullets, "One or more Upload Package introJS elements are missing.")
+  expect(all(purrr::map_lgl(el_pos, ~ any(.x > 0))), "One or more elements are not visible")
+  steps <- app$get_value(export = "pkg_explorer-introJS-steps")
+  expect_equal(pkg_explorer, steps)
+
+  app$click(selector = ".introjs-skipbutton")
+
+  app$set_inputs(tabs = "Source Explorer",
+                 explorer_type = "fe")
+
+  app$set_inputs(`sidebar-select_pkg` = "tidyr")
+  app$wait_for_idle()
+
+  app$click("code_explorer-introJS-help")
+
+
+  code_explorer <- dplyr::bind_rows(fe_steps, apptab_admn, apptab_steps, sidebar_steps)
+
+  # Verify that all elements exist and are visible
+  el_pos <- purrr::map(code_explorer$element, getBoundingClientRect, appDriver = app)
+  introjs_bullets <- app$get_js("$('.introjs-bullets ul li').length")
+  expect(length(el_pos) == introjs_bullets, "One or more Upload Package introJS elements are missing.")
+  expect(all(purrr::map_lgl(el_pos, ~ any(.x > 0))), "One or more elements are not visible")
+  steps <- app$get_value(export = "code_explorer-introJS-steps")
+  expect_equal(code_explorer, steps)
+
+  app$click(selector = ".introjs-skipbutton")
+
   app$set_inputs(tabs = "Package Metrics",
                  metric_type = "cum")
   app$wait_for_idle()