1#' Write into or over a file
2#'
3#' Helpers to write into or over a new or pre-existing file. Designed mostly for
4#' for internal use. File is written with UTF-8 encoding.
5#'
6#' @name write-this
7#' @param path Path to target file. It is created if it does not exist, but the
8#'   parent directory must exist.
9#' @param lines Character vector of lines. For `write_union()`, these are lines
10#'   to add to the target file, if not already present. For `write_over()`,
11#'   these are the exact lines desired in the target file.
12#' @param quiet Logical. Whether to message about what is happening.
13#' @return Logical indicating whether a write occurred, invisibly.
14#' @keywords internal
15#'
16#' @examples
17#' \dontshow{
18#' .old_wd <- setwd(tempdir())
19#' }
20#' write_union("a_file", letters[1:3])
21#' readLines("a_file")
22#' write_union("a_file", letters[1:5])
23#' readLines("a_file")
24#'
25#' write_over("another_file", letters[1:3])
26#' readLines("another_file")
27#' write_over("another_file", letters[1:3])
28#' \dontrun{
29#' ## will error if user isn't present to approve the overwrite
30#' write_over("another_file", letters[3:1])
31#' }
32#'
33#' ## clean up
34#' file.remove("a_file", "another_file")
35#' \dontshow{
36#' setwd(.old_wd)
37#' }
38NULL
39
40#' @describeIn write-this writes lines to a file, taking the union of what's
41#'   already there, if anything, and some new lines. Note, there is no explicit
42#'   promise about the line order. Designed to modify simple config files like
43#'   `.Rbuildignore` and `.gitignore`.
44#' @export
45write_union <- function(path, lines, quiet = FALSE) {
46  stopifnot(is.character(lines))
47  path <- user_path_prep(path)
48
49  if (file_exists(path)) {
50    existing_lines <- read_utf8(path)
51  } else {
52    existing_lines <- character()
53  }
54
55  new <- setdiff(lines, existing_lines)
56  if (length(new) == 0) {
57    return(invisible(FALSE))
58  }
59
60  if (!quiet) {
61    ui_done("Adding {ui_value(new)} to {ui_path(proj_rel_path(path))}")
62  }
63
64  all <- c(existing_lines, new)
65  write_utf8(path, all)
66}
67
68#' @describeIn write-this writes a file with specific lines, creating it if
69#'   necessary or overwriting existing, if proposed contents are not identical
70#'   and user is available to give permission.
71#' @param contents Character vector of lines.
72#' @export
73write_over <- function(path, lines, quiet = FALSE) {
74  stopifnot(is.character(lines), length(lines) > 0)
75  path <- user_path_prep(path)
76
77  if (same_contents(path, lines)) {
78    return(invisible(FALSE))
79  }
80
81  if (can_overwrite(path)) {
82    if (!quiet) {
83      ui_done("Writing {ui_path(path)}")
84    }
85    write_utf8(path, lines)
86  } else {
87    if (!quiet) {
88      ui_done("Leaving {ui_path(path)} unchanged")
89    }
90    invisible(FALSE)
91  }
92}
93
94read_utf8 <- function(path, n = -1L) {
95  base::readLines(path, n = n, encoding = "UTF-8", warn = FALSE)
96}
97
98write_utf8 <- function(path, lines, append = FALSE, line_ending = NULL) {
99  stopifnot(is.character(path))
100  stopifnot(is.character(lines))
101
102  file_mode <- if (append) "ab" else "wb"
103  con <- file(path, open = file_mode, encoding = "utf-8")
104  withr::defer(close(con))
105
106  if (is.null(line_ending)) {
107    if (is_in_proj(path)) {              # path is in active project
108      line_ending <- proj_line_ending()
109    } else if (possibly_in_proj(path)) { # path is some other project
110      line_ending <-
111        with_project(proj_find(path), proj_line_ending(), quiet = TRUE)
112    } else {
113      line_ending <- platform_line_ending()
114    }
115  }
116
117  # convert embedded newlines
118  lines <- gsub("\r?\n", line_ending, lines)
119  base::writeLines(enc2utf8(lines), con, sep = line_ending, useBytes = TRUE)
120
121  invisible(TRUE)
122}
123
124same_contents <- function(path, contents) {
125  if (!file_exists(path)) {
126    return(FALSE)
127  }
128
129  identical(read_utf8(path), contents)
130}
131