R/path_tools.R

In sourcoise: Source a Script and Cache

remove_ext <- function(name) {
  stringr::str_remove(name, "\\.[r|R]$")
}

find_src <- function(root, name) {
  if(fs::is_absolute_path(name)) {
    logger::log_warn("Source script path is absolute, that is not recommanded")
    path <- name
  }
  else
    path <- fs::path_join(c(root, name)) |> fs::path_norm()
  fn <- stringr::str_c(path, ".r")
  if(fs::file_exists(fn)) return(fn)
  fn <- stringr::str_c(path, ".R")
  if(fs::file_exists(fn)) return(fn)
  return(NULL)
}

try_find_src <- function(root, name) {
  pat <- glue::glue("{name}\\.[Rr]$")
  ff <- fs::dir_ls(path = root, regexp=pat, recurse=TRUE)
  ff |> purrr::discard(~ stringr::str_detect(.x, "/_"))
}

try_find_root <- function(root=NULL, src_in = getOption("sourcoise.src_in"), quiet = TRUE) {
  if(!is.null(root))
    return(root)
  if(src_in == "project") {
    if(Sys.getenv("QUARTO_PROJECT_DIR") == "") {
      safe_find_root <- purrr::safely(rprojroot::find_root)
      root <- safe_find_root(
        rprojroot::is_quarto_project | rprojroot::is_r_package | rprojroot::is_rstudio_project)
      if(is.null(root$error))
        return(root$result |> fs::path_abs() |> fs::path_norm())
      else {
        if(!quiet)
          cli::cli_alert_warning("{root$error}")
        return(NULL)
      }
    }
    return(Sys.getenv("QUARTO_PROJECT_DIR") |> fs::path_abs() |> fs::path_norm())
  }

  if(src_in == "file") {
    paths <- find_project_root(NULL, NULL)
    return( fs::path_join(c(paths$project_path, paths$doc_path)) |> fs::path_norm() )
  }
  root <- NULL
}


find_project_root <- function(project_path = NULL, doc_path = NULL) {
  if(is.null(doc_path)) {
    if(Sys.getenv("QUARTO_DOCUMENT_PATH") != "" | quarto::is_using_quarto())
      doc_path <- Sys.getenv("QUARTO_DOCUMENT_PATH") |> fs::path_abs() |> fs::path_norm()
    else
      doc_path <- getwd() |> fs::path_abs() |> fs::path_norm()
  }
  if(is.null(project_path)) {
    project_path <- Sys.getenv("QUARTO_PROJECT_DIR")
    if(project_path == "") {
      safe_find_root <- purrr::safely(rprojroot::find_root)
      project_path <- safe_find_root(rprojroot::is_quarto_project)
      if(!is.null(project_path$error))
        project_path <- safe_find_root(rprojroot::is_rstudio_project)
      if(!is.null(project_path$error))
        project_path$result <- getwd()
      project_path <- project_path$result
    }
  }
  project_path <- project_path |> fs::path_norm() |> fs::path_abs()
  doc_path <- doc_path |> fs::path_norm() |> fs::path_abs() |> fs::path_rel(project_path)
  return(list(project_path = project_path, doc_path = doc_path))
}