Nothing
#' Apply a manual edit patch
#'
#' @description
#'
#' `r lifecycle::badge("stable")`
#'
#' It is best to allow the "manual edit" RStudio 'Addin' to write this function
#' in your script for you. After a tracked manual edit is performed, a patch
#' file is created and saved in the "patches" subdirectory of
#' `nm_dir("models")`. This function applies the patch to the object.
#'
#' @param m An nm object.
#' @param patch_id Character name of patch. Corresponds to the file name in
#' the "patches" subdirectory of `nm_dir("models")`.
#' @param return_merge_conf_ctl Logical (default = `FALSE`). If there a merge
#' conflict produced, should the ctl file be returned?
#'
#' @details Generally best to to apply patches before automatic edits and
#' changes in directories e.g. via `run_in()`. If patches are applied to
#' NONMEM control file sections that are likely to change in the future, the
#' patch may fail to apply. In this case, it is best to view the patch (via
#' the "view patch" RStudio 'Addin') and manually re-implement the changes again
#' in a new manual edit.
#'
#' @return An nm object with modified `ctl_contents` field.
#'
#' @export
apply_manual_edit <- function(m, patch_id, return_merge_conf_ctl = FALSE) {
UseMethod("apply_manual_edit")
}
#' @export
apply_manual_edit.nm_generic <- function(m, patch_id, return_merge_conf_ctl = FALSE) {
## retrain backwards compatibility with "patch-sdlkfjs.." format patch ids.
patch_id <- gsub("patch-", "", patch_id)
patch_name <- paste0("patch-", patch_id)
patch_path <- file.path(nm_dir("models"), "patches", patch_name)
patch_file_exists <- file.exists(patch_path)
if (!patch_file_exists) stop("patch file doesn't exist")
patch_contents <- readLines(patch_path)
temp_ctl_path <- patch_contents[grepl("^---", patch_contents)]
temp_ctl_path <- gsub("\\S+\\s.{2}(.*)", "\\1", temp_ctl_path)
#temp_ctl_path <- file.path(run_in(m), paste0("base-", patch_id))
mnew <- m %>%
simple_field(ctl_path = temp_ctl_path, ctl_name = basename(temp_ctl_path))
mnew %>% text() %>% writeLines(temp_ctl_path)
on.exit(unlink(temp_ctl_path))
patch_cmd <- paste("git apply -C1", patch_path)
suppressWarnings(
res <- system_cmd(patch_cmd, intern = TRUE) ## win = no need to use system_nm, no file sync issues
)
merge_conf_msg <- "apply_manual_edit() hit an unresolvable merge conflict,
this is normally due to the control file having changed significantly
since the manual edit was performed. Right clicking the patch text and
selecting Addins -> View patch will show the edits the patch is attempting
to apply. This can be used to create a new patch."
resolve_merge_msg <- "You can resolve this conflict by selecting the code
and ensuring the apply_manual_edit() is the last pipe highlighted
and then selecting Addins -> Resolve manual edit conflict"
if (isTRUE(attributes(res)$status > 0)) {
## try again with whitespace fix, needed for some versions of git
patch_cmd <- paste("git apply --whitespace=fix -C1", patch_path)
suppressWarnings(
res <- system_cmd(patch_cmd, intern = TRUE)
)
if (isTRUE(attributes(res)$status > 0)) {
if (!git_cmd_available) stop("need git available from system() for this to work")
## get current commit for later resetting
git_log <- git2r::commits()
if( length(git_log) == 0) {
usethis::ui_stop(merge_conf_msg)
}
orig_commit <- git_log[[1]]
## Look for the commit in the history
find_commit <- paste("pre-manual edit: ", patch_id)
found_commits <- git_log[sapply(git_log, function(commit) commit$message) %in% find_commit]
commit_found <- length(found_commits) == 1
if (commit_found) {
check_git_uservalues()
## create a commit so the 3way can be done
system("git reset", intern = TRUE) ## for some reason git2r::reset() doesn't reset
git2r::add(path = temp_ctl_path)
on.exit(system(paste("git reset", orig_commit$sha), intern = TRUE), add = TRUE)
## If no changes are present, we can exit
commit_diff <- git2r::diff(git2r::repository(), index = TRUE, as_char = TRUE)
commit_diff <- strsplit(commit_diff, "\n")[[1]]
empty_commit_coming <- length(commit_diff) == 0
if (empty_commit_coming) {
usethis::ui_stop(merge_conf_msg)
}
commit_msg <- paste("temp commit: ", ctl_path(m))
git2r::commit(message = commit_msg)
patch_cmd <- paste("git am -C1 --3way <", patch_path)
res <- suppressWarnings(
system_cmd(patch_cmd, intern = TRUE)
)
if (any(grepl("git config", res))) {
usethis::ui_stop("Need to set project level user.name and user.email:
{usethis::ui_code(\"usethis::use_git_config(scope = 'project', user.name = 'Jane', user.email = 'jane@example.com')\")}
retry when finished")
}
if (isTRUE(attributes(res)$status > 0)) { ## error detected
## two options:
## merge conflict
## other fail (e.g. whitespace)
git2r::add(path = temp_ctl_path)
added_stuff <- git2r::diff(git2r::repository(), index = TRUE, as_char = TRUE)
conflict_present <- FALSE
if (length(added_stuff) == 1) {
conflict_present <- any(grepl("\\+<<<<<<<", added_stuff))
}
## can now use conflict_present
if (conflict_present) {
#on.exit(system("git am --abort", intern = TRUE))
warn_msg <- paste0("manual edit merge conflict detected:\n\n",
"-------------------------------------------\n",
added_stuff,
"-------------------------------------------\n")
if (return_merge_conf_ctl) return(readLines(temp_ctl_path))
usethis::ui_info(warn_msg)
usethis::ui_stop(resolve_merge_msg)
## instead can we just fix the merge conflict here?
## reproducibility and predictability must be no. 1
## involuntarily fixing merge conflict could result in strange
## behaviour. The patch wouldnt' match up to what is done.
}
patch_cmd <- paste("git am --whitespace=fix -C1 --3way <", patch_path)
res <- system_cmd(patch_cmd, intern = TRUE)
if (isTRUE(attributes(res)$status > 0)) { ## error detected
## two options:
## merge conflict
## other fail (non whitespace but other)
git2r::add(path = temp_ctl_path)
added_stuff <- git2r::diff(git2r::repository(), index = TRUE, as_char = TRUE)
conflict_present <- FALSE
if (length(added_stuff) == 1) {
conflict_present <- any(grepl("\\+<<<<<<< ours", added_stuff))
}
if (conflict_present) {
warn_msg <- paste0("manual edit merge conflict detected:\n\n",
"-------------------------------------------\n",
added_stuff,
"-------------------------------------------\n")
if (return_merge_conf_ctl) return(readLines(temp_ctl_path))
usethis::ui_info(warn_msg)
usethis::ui_stop(resolve_merge_msg)
}
}
}
} else {
usethis::ui_stop(merge_conf_msg)
}
}
}
out_file <- readLines(temp_ctl_path)
m <- m %>% ctl_contents_simple(out_file)
invisible(m)
}
#' @export
apply_manual_edit.nm_list <- Vectorize_nm_list(apply_manual_edit.nm_generic, SIMPLIFY = FALSE)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.