rix::rix() | rix::rix_init(): properly handle and close connections

.github/workflows/flint-code-formatter.yaml

@@ -1,8 +1,10 @@
 # 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:
-  pull_request:
-    branches: [main, master]
+# on:
+#   pull_request:
+#   branches: [main, master]
+on: 
+  workflow_dispatch:
 
 name: flint-code-formatter
 

R/fetchers.R

@@ -115,7 +115,16 @@ remove_base <- function(list_imports) {
 #' @return Atomic vector of packages
 #' @noRd
 get_imports <- function(path) {
-  tmp_dir <- tempdir()
+  tmpdir <- tempdir()
+
+  tmp_dir <- tempfile(pattern = "file", tmpdir = tmpdir, fileext = "")
+  if (!dir.exists(tmp_dir)) {
+    dir.create(tmp_dir, recursive = TRUE)
+  }
+  on.exit(
+    unlink(tmp_dir, recursive = TRUE, force = TRUE),
+    add = TRUE
+  )
 
   # Some packages have a Description file in the testthat folder
   # (see jimhester/lookup) so we need to get rid of that
@@ -139,11 +148,6 @@ get_imports <- function(path) {
 
   existing_columns <- intersect(columns_of_interest, colnames(imports))
 
-  on.exit(
-    unlink(tmp_dir, recursive = TRUE),
-    add = TRUE
-  )
-
   imports <- imports[, existing_columns, drop = FALSE]
 
   output <- unname(trimws(unlist(strsplit(unlist(imports), split = ","))))

R/nix_build_helpers.R

@@ -115,6 +115,14 @@ poll_sys_proc_nonblocking <- function(cmd,
 
   status <- sys::exec_status(proc, wait = TRUE)
 
+  if (is.na(status)) {
+    tools::pskill(pid = proc)
+    stop(
+      "`nix_build()` likely interrupted by SIGINT (ctrl+c)\n",
+      "Stop process with PID ", proc
+    )
+  }
+
   if (isFALSE(is_quiet)) {
     if (status == 0L) {
       cat(paste0("\n==> `", what, "` succeeded!"))

R/nix_hash.R

@@ -30,19 +30,33 @@ nix_hash <- function(repo_url, commit) {
 #' - `deps`: string with R package dependencies separarated by space.
 #' @noRd
 hash_url <- function(url) {
-  path_to_folder <- paste0(
-    tempdir(), "repo_hash_url_",
+  tmpdir <- paste0(
+    tempdir(), "_repo_hash_url_",
     paste0(sample(letters, 5), collapse = "")
   )
+  on.exit(unlink(tmpdir, recursive = TRUE, force = TRUE), add = TRUE)
 
+  path_to_folder <- tempfile(pattern = "file", tmpdir = tmpdir, fileext = "")
   dir.create(path_to_folder)
+  on.exit(
+    unlink(path_to_folder, recursive = TRUE, force = TRUE),
+    add = TRUE
+  )
 
   path_to_tarfile <- paste0(path_to_folder, "/package_tar_gz")
   path_to_src <- paste0(path_to_folder, "/package_src")
 
   dir.create(path_to_src, recursive = TRUE)
   path_to_src <- normalizePath(path_to_src)
+  on.exit(
+    unlink(path_to_src, recursive = TRUE, force = TRUE),
+    add = TRUE
+  )
   dir.create(path_to_tarfile, recursive = TRUE)
+  on.exit(
+    unlink(path_to_tarfile, recursive = TRUE, force = TRUE),
+    add = TRUE
+  )
   path_to_tarfile <- normalizePath(path_to_tarfile)
 
   h <- curl::new_handle(failonerror = TRUE, followlocation = TRUE)
@@ -80,11 +94,6 @@ hash_url <- function(url) {
 
   deps <- get_imports(desc_path)
 
-  on.exit(
-    unlink(path_to_folder, recursive = TRUE, force = TRUE),
-    add = TRUE
-  )
-
   return(
     list(
       "sri_hash" = sri_hash,

R/rix.R

@@ -321,19 +321,18 @@ for more details."
     collapse = "\n"
   )
 
-  # nolint next: object_name_linter
-  default.nix <- readLines(textConnection(default.nix))
-
   if (print) {
     cat(default.nix, sep = "\n")
   }
 
   if (!file.exists(default.nix_path) || overwrite) {
     if (!dir.exists(project_path)) {
-      dir.create(project_path)
+      dir.create(project_path, recursive = TRUE)
     }
-    file.create(default.nix_path)
-    writeLines(default.nix, default.nix_path)
+    con <- file(default.nix_path, open = "wb", encoding = "native.enc")
+    on.exit(close(con))
+
+    writeLines(enc2utf8(default.nix), con = con, useBytes = TRUE)
 
     if (file.exists(.Rprofile_path)) {
       if (!any(grepl(
@@ -387,4 +386,6 @@ for more details."
       )
     )
   }
+
+  on.exit(close(con))
 }

R/rix_init.R

@@ -140,13 +140,12 @@ rix_init <- function(project_path = ".",
   rprofile_quoted <- nix_rprofile()
   rprofile_deparsed <- deparse_chr1(expr = rprofile_quoted, collapse = "\n")
   rprofile_file <- file.path(project_path, ".Rprofile")
+  rprofile_con <- file(rprofile_file, open = "wb", encoding = "native.enc")
 
   rprofile_text <- get_rprofile_text(rprofile_deparsed)
+  on.exit(close(rprofile_con))
   write_rprofile <- function(rprofile_text, rprofile_file) {
-    writeLines(
-      text = rprofile_text,
-      con = file(rprofile_file)
-    )
+    writeLines(enc2utf8(rprofile_text), rprofile_con, useBytes = TRUE)
   }
 
   is_nix_r <- is_nix_r_session()
@@ -169,7 +168,7 @@ rix_init <- function(project_path = ".",
           )
         }
       } else {
-        write_rprofile(rprofile_text, rprofile_file)
+        write_rprofile(rprofile_text, rprofile_file = rprofile_con)
         if (isFALSE(is_quiet)) {
           message_rprofile(action_string = "Added", project_path = project_path)
         }
@@ -179,7 +178,7 @@ rix_init <- function(project_path = ".",
     create_backup = {
       if (isTRUE(rprofile_exists)) {
         file.copy(from = rprofile_file, to = rprofile_backup)
-        write_rprofile(rprofile_text, rprofile_file)
+        write_rprofile(rprofile_text, rprofile_file = rprofile_con)
         if (isFALSE(is_quiet)) {
           cat(
             "\n==> Backed up existing `.Rprofile` in file:\n", rprofile_backup,
@@ -193,13 +192,13 @@ rix_init <- function(project_path = ".",
 
         if (message_type == "verbose") {
           cat("\n* Current lines of local `.Rprofile` are\n:")
-          cat(readLines(con = rprofile_file), sep = "\n")
+          cat(readLines(con = rprofile_con), sep = "\n")
         }
         set_message_session_PATH(message_type = message_type)
       }
     },
     overwrite = {
-      write_rprofile(rprofile_text, rprofile_file)
+      write_rprofile(rprofile_text, rprofile_file = rprofile_con)
       if (isTRUE(rprofile_exists)) {
         message_rprofile(
           action_string = "Overwrote", project_path = project_path
@@ -211,7 +210,7 @@ rix_init <- function(project_path = ".",
       }
     },
     append = {
-      cat(paste0(rprofile_text, "\n"), file = rprofile_file, append = TRUE)
+      cat(paste0(rprofile_text, "\n"), file = rprofile_con, append = TRUE)
       message_rprofile(
         action_string = "Appended", project_path = project_path
       )
@@ -220,13 +219,8 @@ rix_init <- function(project_path = ".",
 
   if (message_type == "verbose") {
     cat("\n\n* Current lines of local `.Rprofile` are:\n\n")
-    cat(readLines(con = file(rprofile_file)), sep = "\n")
+    cat(readLines(con = rprofile_action), sep = "\n")
   }
-
-  on.exit(
-    close(file(rprofile_file)),
-    add = TRUE
-  )
 }
 
 #' Get character vector of length two with comment and code write `.Rprofile`

R/with_nix.R

@@ -326,10 +326,12 @@ with_nix <- function(expr,
     if (nzchar(LD_LIBRARY_PATH_default)) {
       # set old LD_LIBRARY_PATH (only if system's R session and if it wasn't
       # `""`)
-      on.exit({
-        Sys.setenv(LD_LIBRARY_PATH = LD_LIBRARY_PATH_default)
-      },
-      add = TRUE)
+      on.exit(
+        {
+          Sys.setenv(LD_LIBRARY_PATH = LD_LIBRARY_PATH_default)
+        },
+        add = TRUE
+      )
     }
   }
 

tests/testthat/test-fetchers.R

@@ -1,4 +1,5 @@
 testthat::test_that("Test fetchgit works", {
+  testthat::skip_on_cran()
   testthat::expect_equal(
     fetchgit(
       list(
@@ -12,6 +13,7 @@ testthat::test_that("Test fetchgit works", {
 })
 
 testthat::test_that("Test fetchgit fails gracefully", {
+  testthat::skip_on_cran()
   testthat::expect_error(
     fetchgit(
       list(
@@ -24,6 +26,7 @@ testthat::test_that("Test fetchgit fails gracefully", {
 })
 
 testthat::test_that("Test fetchgit works with gitlab packages", {
+  testthat::skip_on_cran()
   testthat::expect_equal(
     fetchgit(
       list(
@@ -39,20 +42,23 @@ testthat::test_that("Test fetchgit works with gitlab packages", {
 
 
 testthat::test_that("Test fetchzip works", {
+  testthat::skip_on_cran()
   testthat::expect_equal(
     fetchzip("AER@1.2-8"),
     "\n    (pkgs.rPackages.buildRPackage {\n      name = \"AER\";\n      src = pkgs.fetchzip {\n       url = \"https://cran.r-project.org/src/contrib/Archive/AER/AER_1.2-8.tar.gz\";\n       sha256 = \"sha256-OqxXcnUX/2C6wfD5fuNayc8OU+mstI3tt4eBVGQZ2S0=\";\n      };\n      propagatedBuildInputs = builtins.attrValues {\n        inherit (pkgs.rPackages) \n          car\n          lmtest\n          sandwich\n          survival\n          zoo\n          Formula;\n      };\n    })\n"
   )
 })
 
 testthat::test_that("Test fetchzip fails gracefully", {
+  testthat::skip_on_cran()
   testthat::expect_error(
     fetchzip("AER@999999"),
     "Are these correct?"
   )
 })
 
 testthat::test_that("Test fetchgits", {
+  testthat::skip_on_cran()
   testthat::expect_equal(
     fetchgits(
       list(
@@ -73,6 +79,7 @@ testthat::test_that("Test fetchgits", {
 })
 
 testthat::test_that("Test fetchzips works", {
+  testthat::skip_on_cran()
   testthat::expect_equal(
     fetchzips(
       c("dplyr@0.8.0", "AER@1.2-8")
@@ -83,6 +90,7 @@ testthat::test_that("Test fetchzips works", {
 
 
 testthat::test_that("Test fetchpkgs works", {
+  testthat::skip_on_cran()
   testthat::expect_equal(
     fetchpkgs(
       git_pkgs = list(

tests/testthat/test-rix.R

@@ -1,5 +1,6 @@
 testthat::test_that("rix(), ide is 'rstudio', Linux", {
-  skip_if(Sys.info()["sysname"] == "Darwin")
+  os_type <- Sys.info()["sysname"]
+  skip_if(os_type == "Darwin" || os_type == "Windows")
 
   path_default_nix <- paste0(
     tempdir(), paste0(sample(letters, 5), collapse = "")
@@ -48,6 +49,9 @@ testthat::test_that("rix(), ide is 'rstudio', Linux", {
 
 
 testthat::test_that("rix(), ide is 'other' or 'code'", {
+  os_type <- Sys.info()["sysname"]
+  skip_if(os_type == "Windows")
+
   path_default_nix <- paste0(
     tempdir(), paste0(sample(letters, 5), collapse = "")
   )
@@ -114,6 +118,9 @@ testthat::test_that("rix(), ide is 'other' or 'code'", {
 
 
 testthat::test_that("Quarto gets added to sys packages", {
+  os_type <- Sys.info()["sysname"]
+  skip_if(os_type == "Windows")
+
   path_default_nix <- normalizePath(tempdir())
 
   save_default_nix_test <- function(pkgs, interface, path_default_nix) {
@@ -161,7 +168,8 @@ testthat::test_that("Quarto gets added to sys packages", {
 })
 
 testthat::test_that("If on darwin and ide = rstudio, raise warning", {
-  skip_if(Sys.info()["sysname"] != "Darwin")
+  os_type <- Sys.info()["sysname"]
+  skip_if(os_type != "Darwin" || os_type == "Windows")
 
   path_default_nix <- normalizePath(tempdir())
 
@@ -299,6 +307,9 @@ testthat::test_that("If R version is == 3.5.3, raise warning", {
 })
 
 testthat::test_that("rix(), bleeding_edge", {
+  os_type <- Sys.info()["sysname"]
+  skip_if(os_type == "Windows")
+
   path_default_nix <- paste0(
     tempdir(), paste0(sample(letters, 5), collapse = "")
   )
@@ -400,18 +411,22 @@ testthat::test_that("rix(), frozen_edge", {
   )
 
 
-  on.exit({
-    system(
-      paste0("sed -i 's/", frozen_edge_commit, "/REVISION/' _snaps/rix/frozen_edge_default.nix")
-    )
-    unlink(path_default_nix, recursive = TRUE, force = FALSE)
-  },
-  add = TRUE
+  on.exit(
+    {
+      system(
+        paste0("sed -i 's/", frozen_edge_commit, "/REVISION/' _snaps/rix/frozen_edge_default.nix")
+      )
+      unlink(path_default_nix, recursive = TRUE, force = FALSE)
+    },
+    add = TRUE
   )
 })
 
 
 testthat::test_that("rix(), only one Github package", {
+  os_type <- Sys.info()["sysname"]
+  skip_if(os_type == "Windows")
+
   path_default_nix <- paste0(
     tempdir(), paste0(sample(letters, 5), collapse = "")
   )