Merge pull request #98 from metrumresearchgroup/svn-list

svn list functionality

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: review
 Title: QC Management and Helpers
-Version: 3.9.0.8000
+Version: 3.9.0.8001
 Authors@R: 
     c(
     person(given = "Eric", family = "Anderson", email = "andersone@metrumrg.com", role = c("aut")),
@@ -27,7 +27,8 @@ Imports:
     cli,
     rmarkdown,
     tinytex,
-    pmtables
+    pmtables,
+    tidyr
 Suggests: 
     knitr,
     testthat (>= 3.0.0),

R/dirSummary.R

@@ -4,11 +4,6 @@
 #' 
 #' @param .dirs_exclude Character string (optional). Vector of directories to exclude in the summary (relative to log root).
 #'
-#' @examples 
-#' with_demoRepo({
-#'   dirSummary()
-#' })
-#'
 #' @return A list containing:
 #'   * `project`: the name of the project repository.
 #'   * `data`: a data.frame containing information about the relevant files including:
@@ -86,30 +81,31 @@ dirSummary <- function(.dirs_exclude = NULL) {
   # Determine current log state ---------------------------------------------
   log_summary <- logSummary()
 
+  if (nrow(log_summary) == 0) {
+    stop("QC log is empty")
+  }
+
   # Build data --------------------------------------------------------------
   relevant_files_df <- relevant_files_df %>% dplyr::left_join(log_summary, by = "file")
 
   n_iter <- nrow(relevant_files_df)
+  svn_list <- svnList()
+
   cli::cli_progress_bar("Checking files", total = n_iter)
 
   for (i in 1:n_iter) {
 
     cli::cli_progress_update()
 
-    log.i <- tryCatch(
-      svnInfo(relevant_files_df$file[i]),
-      error = identity
-    )
+    log.i <- svn_list %>% dplyr::filter(file == relevant_files_df$file[i])
 
-    if (inherits(log.i, "error")) {
+    if (nrow(log.i) == 0) {
 
       relevant_files_df$insvn[i] <- "No"
 
       next
     }
 
-    log.i <- log.i %>% dplyr::filter(datetime == max(datetime))
-
     relevant_files_df$lastauthor[i] <- log.i$author
     relevant_files_df$lastedit[i] <- log.i$datetime
     relevant_files_df$lastrev[i] <- log.i$rev

R/reviewPackage.R

@@ -15,6 +15,9 @@ globalVariables(
     "File",
     "Author",
     "Status",
-    "n"
+    "n",
+    "commit",
+    "name",
+    "value"
   )
 )

R/svnList.R

@@ -0,0 +1,30 @@
+#' Get the SVN list of a repo
+#' 
+#' @description 
+#' Returns the `svn list` in dataframe format.
+#' 
+#' @noRd
+svnList <- function(){
+
+  svn_list <- tryCatch(
+    svnCommand("list", .flags = "--depth infinity"),
+    error = identity
+  )
+
+  if (inherits(svn_list, "error")) {
+    stop("svn list failed")
+  }
+
+  list_return <- 
+    dplyr::bind_rows(svn_list$list) %>% 
+    tidyr::unnest(commit) %>% 
+    dplyr::select(name, commit) %>% 
+    dplyr::group_by(name) %>% 
+    dplyr::summarise(value = paste0(commit, collapse = "__reviewsep__")) %>% 
+    dplyr::ungroup() %>% 
+    tidyr::separate(value, c("author", "datetime", "rev"), sep = "__reviewsep__") %>% 
+    dplyr::mutate(datetime = as.POSIXct(datetime, format="%Y-%m-%dT%H:%M:%OS", tz="UTC")) %>% 
+    dplyr::select(file = name, author, datetime, rev)
+
+  list_return
+}

tests/testthat/setup.R

@@ -1,7 +1,30 @@
-#' Developer sys and svn info
+# Developer sys and svn info
 user_lookup <- dplyr::tribble(
   ~sys, ~svn,
   "michaelm", "michaelm",
   "anderson", "andersone",
   "graceo", "graceo"
-)
+)
+
+create_test_svn <- function(.user_lookup = user_lookup) {
+
+  this_user <- 
+    .user_lookup %>% 
+    dplyr::filter(sys == Sys.info()[["user"]]) %>% 
+    dplyr::pull(svn)
+
+  testthat::skip_if(
+    length(this_user) == 0,
+    glue::glue("Skipped svnUser tests because user not found in svn lookup in setup.R")
+  )
+
+  remote_repo_local <- paste0(tempdir(), "/test")
+
+  .command <-
+    glue::glue("svn co svn+ssh://{this_user}@mc1-test.metrumrg.com/common/repo/svn-proj-review-tests {remote_repo_local} -q -q")
+
+  system(.command)
+
+  setwd(remote_repo_local)
+}
+

tests/testthat/test-dirSummary.R

@@ -1,72 +1,54 @@
-with_demoRepo({
-  dirSummaryRes <- dirSummary()
-  dirSummaryResExcl <- dirSummary(.dirs_exclude = "script/pk")
-
-  # Check that QC summary contains expected information
-  test_that("dirSummary returns the correct project name", {
-    expect_equal(basename(logRoot()), dirSummaryRes$project)
-  })
+create_test_svn()
+
+logAssign("script/model-management.R")
+logAccept("script/box-sample-code.R")
+
+dirSummaryRes <- dirSummary()
+dirSummaryResExcl <- dirSummary(.dirs_exclude = "script")
 
-  test_that("dirSummary returns all expected output", {
-    expect_equal(c("project", "data", "status"), names(dirSummaryRes))
-    expect_true(length(dirSummaryRes) == 3)
-    expect_true(is.character(dirSummaryRes$project))
-    expect_true(is.data.frame(dirSummaryRes$data))
-    expect_equal(nrow(dirSummaryRes$data), 4)
-    expect_true(is.data.frame(dirSummaryRes$status))
-    expect_equal(nrow(dirSummaryRes$status), 4)
-    expect_true(length(dirSummaryResExcl) == 3)
-    expect_equal(nrow(dirSummaryResExcl$data), 3)
-    expect_equal(nrow(dirSummaryResExcl$status), 3)
-  })
+# Check that QC summary contains expected information
+test_that("dirSummary returns the correct project name", {
+  expect_equal(basename(logRoot()), dirSummaryRes$project)
+})
 
-  test_that("dirSummary captures the expected QC status of all scripts", {
-
-    expect_equal(
-      "script/combine-da.R",
-      dirSummaryRes$data %>% dplyr::filter(Status == "QC up to date") %>% dplyr::pull(File)
-    )
-
-    # Latest rev
-    expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/combine-da.R") %>% dplyr::pull(`Latest rev`) == "1")
-    expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/data-assembly.R") %>% dplyr::pull(`Latest rev`) == "5")
-    expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/examp-yaml.yaml") %>% dplyr::pull(`Latest rev`) == "1")
-
-    # Status
-    expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/combine-da.R") %>% dplyr::pull(Status) == "QC up to date")
-    expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/data-assembly.R") %>% dplyr::pull(Status) == "In QC log, needs QC")
-    expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/examp-yaml.yaml") %>% dplyr::pull(Status) == "Not in QC log")
-    expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/pk/load-spec.R") %>% dplyr::pull(Status) == "In QC log, needs QC")
-
-    # Date
-    expect_true(
-      abs(as.numeric(
-        difftime(
-          format(Sys.time(), tz = "UTC"),
-          format(dirSummaryRes$data$`Latest edit`[1], tz = "UTC"),
-          units = "secs")
-      )) < 120
-    )
-
-    # Author
-    expect_equal(dirSummaryRes$data$Author[1], Sys.info()[["user"]])
-
-  })
+test_that("dirSummary returns all expected output", {
+  expect_equal(c("project", "data", "status"), names(dirSummaryRes))
+  expect_true(length(dirSummaryRes) == 3)
+  expect_true(is.character(dirSummaryRes$project))
+  expect_true(is.data.frame(dirSummaryRes$data))
+  expect_true(is.data.frame(dirSummaryRes$status))
+  expect_true(length(dirSummaryResExcl) == 3)
+})
 
-  # QC Status data.frame
+test_that("dirSummary captures the expected QC status of all scripts", {
 
-  test_that("dirSummary generates formatted dataframe of QC status", {
-    expect_true(is.factor(dirSummaryRes$status$Status))
-    expect_true(nrow(dirSummaryRes$status %>% dplyr::filter(Status == "QC up to date")) == 1)
-    expect_true(nrow(dirSummaryRes$status %>% dplyr::filter(Status == "In QC log, needs QC")) == 2)
-    expect_true(nrow(dirSummaryRes$status %>% dplyr::filter(Status == "Not in QC log")) == 1)
-  })
+  expect_equal(
+    "script/box-sample-code.R",
+    dirSummaryRes$data %>% dplyr::filter(Status == "QC up to date") %>% dplyr::pull(File)
+  )
 
-  setwd("script")
-  dirSummaryResDir <- dirSummary()
+  # Latest rev
+  expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/box-sample-code.R") %>% dplyr::pull(`Latest rev`) == "1")
+  expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/data-assembly/da-study-abc.Rmd") %>% dplyr::pull(`Latest rev`) == "7")
+
+  # Status
+  expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/box-sample-code.R") %>% dplyr::pull(Status) == "QC up to date")
+  expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/model-management.R") %>% dplyr::pull(Status) == "In QC log, needs QC")
+  expect_true(dirSummaryRes$data %>% dplyr::filter(File == "script/model-summary.Rmd") %>% dplyr::pull(Status) == "Not in QC log")
+})
 
-  test_that("dirSummary works in a directory other than log root", {
-    expect_identical(dirSummaryRes, dirSummaryResDir)
-  })
+# QC Status data.frame
+test_that("dirSummary generates formatted dataframe of QC status", {
+  expect_true(is.factor(dirSummaryRes$status$Status))
+  expect_true(nrow(dirSummaryRes$status %>% dplyr::filter(Status == "QC up to date")) == 1)
+  expect_true(nrow(dirSummaryRes$status %>% dplyr::filter(Status == "In QC log, needs QC")) == 1)
+  expect_true(nrow(dirSummaryRes$status %>% dplyr::filter(Status == "Not in QC log")) == 15)
+})
+
+setwd("script")
+dirSummaryResDir <- dirSummary()
+
+test_that("dirSummary works in a directory other than log root", {
+  expect_identical(dirSummaryRes, dirSummaryResDir)
 })
 

tests/testthat/test-renderQCSummary.R

@@ -1,30 +1,32 @@
-with_demoRepo({
-  if (Sys.getenv("METWORX_VERSION") != "") {
-    test_that("renderQCSummary works with valid directory", {
-
-      expect_message({
-        renderQCSummary(.output_dir = logRoot())
-      })
-
-      # Check that the output file was created
-      expect_true(file.exists(file.path(logRoot(), paste0("qc-summary-", Sys.Date(), ".pdf"))))
-
+if (Sys.getenv("METWORX_VERSION") != "") {
+
+  create_test_svn()
+
+  test_that("renderQCSummary works with valid directory", {
+
+    expect_message({
+      renderQCSummary(.output_dir = logRoot())
     })
 
-    test_that("renderQCSummary doesn't save file if directory not given", {
-      
-      temp_dir <- tempdir()
-      
-      expect_message({
-        renderQCSummary()
-      })
-      
-      # Check that the output file was created
-      expect_true(file.exists(file.path(temp_dir, paste0("qc-summary-", Sys.Date(), ".pdf"))))
-
+    # Check that the output file was created
+    expect_true(file.exists(file.path(logRoot(), paste0("qc-summary-", Sys.Date(), ".pdf"))))
+
+  })
+
+  test_that("renderQCSummary doesn't save file if directory not given", {
+
+    temp_dir <- tempdir()
+
+    expect_message({
+      renderQCSummary()
     })
-  }
-})
+
+    # Check that the output file was created
+    expect_true(file.exists(file.path(temp_dir, paste0("qc-summary-", Sys.Date(), ".pdf"))))
+
+  })
+}
+
 
 
 

tests/testthat/test-svnList.R

@@ -0,0 +1,9 @@
+create_test_svn()
+
+svn_list <- svnList()
+
+test_that("svnList works for standard case", {
+  expect_true(all(file.exists(svn_list$file)))
+  expect_true(nrow(svn_list %>% dplyr::count(rev)) > 1)
+  expect_true(!any(grepl("renv", svn_list$file)))
+})

tests/testthat/test-svnProjInfo.R

@@ -1,24 +1,12 @@
+create_test_svn()
+
+proj_res <- svnProjInfo(.host_name = "mc1-test.metrumrg.com")
+
 this_user <- 
   user_lookup %>% 
   dplyr::filter(sys == Sys.info()[["user"]]) %>% 
   dplyr::pull(svn)
 
-testthat::skip_if(
-  length(this_user) == 0,
-  glue::glue("Skipped svnUser tests because user not found in svn lookup in setup.R")
-)
-
-remote_repo_local <- paste0(tempdir(), "/test")
-
-.command <-
-  glue::glue("svn co svn+ssh://{this_user}@mc1-test.metrumrg.com/common/repo/svn-proj-review-tests {remote_repo_local} -q -q")
-
-system(.command)
-
-setwd(remote_repo_local)
-
-proj_res <- svnProjInfo(.host_name = "mc1-test.metrumrg.com")
-
 test_that("svnUser retrieves correct svn user", {
   expect_true(proj_res$this_svn_user == this_user)
 })