R/rix_helpers.R

In rix: Reproducible Data Science Environments with 'Nix'

#' generate_header Internal function used to generate the header of the
#' `default.nix` file.
#' @param nix_repo Character. nixpkgs reop to use (upstream or rstats-on-nix
#' fork) with latest commit hash.
#' @param r_version Character. R version to look for, for example, "4.2.0". If a
#' nixpkgs revision is provided instead, this gets returned.
#' @param rix_call Character, call to rix().
#' @param ide Character, the ide to use.
#' @noRd
generate_header <- function(nix_repo, r_version, rix_call, ide) {
  if (ide %in% c("code", "positron")) {
    allow_unfree <- " config.allowUnfree = true; "
  } else {
    allow_unfree <- ""
  }
  if (identical(Sys.getenv("TESTTHAT"), "true")) {
    sprintf(
      '
let
  pkgs = import (fetchTarball "%s") {%s};
',
      nix_repo$url,
      allow_unfree
    )
  } else {
    # Generate the correct text for the header depending on wether
    # an R version or a Nix revision is supplied to `r_ver`
    if (!is.null(r_version) && nchar(r_version) > 20) {
      r_ver_text <- paste0("as it was as of nixpkgs revision: ", r_version)
    } else if (is.null(r_version)) {
      r_ver_text <- nix_repo$r_ver
    } else {
      r_ver_text <- paste0("version ", r_version)
    }

    # Get the rix version
    rix_version <- utils::packageVersion("rix")

    nix_url <- nix_repo$url

    nix_revision <- nix_repo$latest_commit

    # Get the ide

    if (grepl("NixOS", nix_url)) {
      sprintf(
        '# This file was generated by the {rix} R package v%s on %s
# with following call:
%s
# It uses upstream nixpkgs\' revision %s for reproducibility purposes
# which will install R %s.
# Report any issues to https://github.com/ropensci/rix
let
 pkgs = import (fetchTarball "%s") {%s};
',
        rix_version,
        Sys.Date(),
        generate_rix_call(rix_call, nix_repo),
        nix_revision,
        r_ver_text,
        nix_url,
        allow_unfree
      )
    } else {
      # if we're using rstats-on-nix
      sprintf(
        '# This file was generated by the {rix} R package v%s on %s
# with following call:
%s
# It uses the `rstats-on-nix` fork of `nixpkgs` which provides improved
# compatibility with older R versions and R packages for Linux/WSL and
# Apple Silicon computers.
# Report any issues to https://github.com/ropensci/rix
let
 pkgs = import (fetchTarball "%s") {%s};
',
        rix_version,
        Sys.Date(),
        generate_rix_call(rix_call, nix_repo),
        nix_url,
        allow_unfree
      )
    }
  }
}

#' generate_rix_call Internal function used to generate the call to `rix()` as
#' shown in `default.nix`
#' @param rix_call Character, call to rix().
#' @param nix_repo Character. nixpkgs reop to use (upstream or rstats-on-nix
#' fork) with latest commit hash.
#' @noRd
generate_rix_call <- function(rix_call, nix_repo) {
  if (grepl("NixOS", nix_repo$url)) {
    rix_call$r_ver <- nix_repo$latest_commit
  } else {
    rix_call$r_ver <- nix_repo$r_ver
  }

  rix_call <- paste0("# >", deparse1(rix_call))

  gsub(",", ",\n#  >", rix_call)
}


#' Internal function that formats the R package names correctly for Nix.
#' @param r_pkgs Character, list of R packages to install.
#' @noRd
get_rpkgs <- function(r_pkgs, ide) {
  # in case users pass something like c("dplyr", "tidyr@1.0.0")
  # r_pkgs will be "dplyr" only
  # and "tidyr@1.0.0" needs to be handled by fetchzips
  r_and_archive_pkgs <- detect_versions(r_pkgs)

  # overwrite r_pkgs
  r_pkgs <- r_and_archive_pkgs$cran_packages

  # get archive_pkgs
  archive_pkgs <- r_and_archive_pkgs$archive_packages

  r_pkgs <- if (ide %in% c("code", "codium")) {
    c(r_pkgs, "languageserver")
  } else {
    r_pkgs
  }

  r_pkgs <- sort(r_pkgs)

  # nolint start: object_name_linter
  rPackages <- paste(c("", r_pkgs), collapse = "\n      ")

  rPackages <- gsub("\\.", "_", rPackages)
  # nolint end

  list(
    "rPackages" = rPackages,
    "archive_pkgs" = archive_pkgs
  )
}

#' generate_rpkgs Internal function that generates the string containing the
#' correct Nix expression to get R packages.
#' @param rPackages Character, list of R packages to install.
#' @param flag_rpkgs Character, are there any R packages at all?
#' @noRd
# nolint start: object_name_linter
generate_rpkgs <- function(rPackages, flag_rpkgs) {
  if (flag_rpkgs == "") {
    NULL
  } else {
    sprintf(
      "
  rpkgs = builtins.attrValues {
    inherit (pkgs.rPackages) %s;
  };
",
      rPackages
    )
  }
}
# nolint end

#' generate_local_r_pkgs Internal function that generates the string containing
#' the correct Nix expression for installing local packages
#' @param local_r_pkgs Character, list of local R packages to install.
#' @param flag_local_r_pkgs Character, are there any local R packages at all?
#' @noRd
generate_local_r_pkgs <- function(local_r_pkgs, flag_local_r_pkgs) {
  if (flag_local_r_pkgs == "") {
    NULL
  } else {
    sprintf(
      "
  local_r_pkgs = [
    %s
  ];
",
      fetchlocals(local_r_pkgs)
    )
  }
}

#' generate_tex_pkgs Internal function that generates the string containing the
#' correct Nix expression to get LaTeX packages.
#' @param tex_pkgs Character, list of LaTeX packages to install.
#' @noRd
generate_tex_pkgs <- function(tex_pkgs) {
  if (!is.null(tex_pkgs)) {
    tex_pkgs <- unique(c("scheme-small", sort(tex_pkgs)))

    tex_pkgs <- paste(c("", tex_pkgs), collapse = "\n      ")

    sprintf(
      "
  tex = (pkgs.texlive.combine {
    inherit (pkgs.texlive) %s;
  });
",
      tex_pkgs
    )
  }
}

#' generate_py_conf Internal function that generates the string containing the
#' correct Nix expression to get Python packages.
#' @param py_conf List. A list of two elements, `py_version` and `py_conf`.
#'   `py_version` must be of the form `"3.12"` for Python 3.12 and `py_conf`
#'   must be an atomic vector of packages names, for example
#'   `py_conf = c("polars", "plotnine", "great-tables")`.
#' @param flag_py_conf Character, are there any Python packages at all?
#' @noRd
generate_py_conf <- function(py_conf, flag_py_conf) {
  if (flag_py_conf == "") {
    NULL
  } else {
    py_version <- paste0(
      "python",
      gsub("\\.", "", py_conf$py_version),
      "Packages"
    )

    # I'm adding pip and ipykernel because Positron complains otherwise
    py_conf <- paste(
      c("", "pip", "ipykernel", sort(py_conf$py_pkgs)),
      collapse = "\n      "
    )

    sprintf(
      "
  pyconf = builtins.attrValues {
    inherit (pkgs.%s) %s;
  };
",
      py_version,
      py_conf
    )
  }
}

#' generate_jl_conf Internal function that generates the string containing the
#' correct Nix expression to get Jlthon packages.
#' @param jl_conf List. A list of two elements, `jl_version` and `jl_conf`.
#'   `jl_version` must be of the form `"1.10"` for Julia 1.10. Leave empty to
#'   use the latest version, or use `"lts"` for the long term support version.
#'   `jl_conf` must be an atomic vector of packages names, for example `jl_conf
#'   = c("TidierData", "TidierPlots")`.
#' @param flag_jl_conf Character, are there any Jlthon packages at all?
#' @noRd
generate_jl_conf <- function(jl_conf, flag_jl_conf) {
  if (flag_jl_conf == "") {
    NULL
  } else {
    if (jl_conf$jl_version == "" || is.null(jl_conf$jl_version)) {
      jl_version <- "julia"
    } else if (jl_conf$jl_version == "lts") {
      jl_version <- "julia-lts"
    } else {
      jl_version <- paste0(
        "julia_",
        gsub("\\.", "", jl_conf$jl_version)
      )
    }
    jl_pkgs <- paste(
      c("", sprintf("\"%s\"", sort(jl_conf$jl_pkgs))),
      collapse = "\n      "
    )

    sprintf(
      "
  jlconf = pkgs.%s.withPackages [ %s
  ];
",
      jl_version,
      jl_pkgs
    )
  }
}

#' get_system_pkgs Internal function that formats the system package names
#' correctly for Nix.
#' @param system_pkgs Character, list of system packages to install.
#' @param r_pkgs Character, list of R packages to install.
#' @param py_conf List. A list of two elements, `py_version` and `py_conf`.
#'   `py_version` must be of the form `"3.12"` for Python 3.12 and `py_conf`
#'   must be an atomic vector of packages names, for example
#'   `py_conf = c("polars", "plotnine", "great-tables")`.
#' @param ide Character, ide to use.
#' @noRd
get_system_pkgs <- function(system_pkgs, r_pkgs, py_conf, ide) {
  # We always need these packages

  which_ide <- switch(
    ide,
    "code" = "vscode",
    "codium" = "vscodium",
    "positron" = "positron-bin",
    NULL
  )

  if (is.null(py_conf)) {
    py_version <- NULL
  } else {
    py_version <- paste0("python", gsub("\\.", "", py_conf$py_version))
  }

  system_pkgs <- sort(c(
    system_pkgs,
    which_ide,
    "R",
    "glibcLocales",
    "nix",
    py_version
  ))

  # If the user wants the R {quarto} package, then the quarto software needs to
  # be installed

  if (any(grepl("quarto", r_pkgs))) {
    system_pkgs <- unique(c(system_pkgs, "quarto", "which", "pandoc"))
  }
  if (any(grepl("rmarkdown", r_pkgs))) {
    system_pkgs <- unique(c(system_pkgs, "pandoc", "which"))
  }
  paste(c("", system_pkgs), collapse = "\n      ")
}


#' generate_system_pkgs Internal function that generates the string containing
#' the correct Nix expression to get system packages.
#' @param system_pkgs Character, list of system packages to install.
#' @param r_pkgs Character, list of R packages packages to install.
#' @param py_conf List. A list of two elements, `py_version` and `py_conf`.
#'   `py_version` must be of the form `"3.12"` for Python 3.12 and `py_conf`
#'   must be an atomic vector of packages names, for example
#'   `py_conf = c("polars", "plotnine", "great-tables")`.
#' @param ide Character, ide to use.
#' @noRd
generate_system_pkgs <- function(system_pkgs, r_pkgs, py_conf, ide) {
  sprintf(
    "
  system_packages = builtins.attrValues {
    inherit (pkgs) %s;
  };
",
    get_system_pkgs(system_pkgs, r_pkgs, py_conf, ide)
  )
}


#' generate_git_archived_pkgs Internal function that generates the string
#' containing the correct Nix expression to get system packages.
#' @param git_pkgs Character, list of R packages to install from GitHub.
#' @param archive_pkgs Character, list of R packages to install from the CRAN
#' archives.
#' @param flag_git_archive Character, are there R packages from GitHub at all?
#' @param ... Further arguments passed down to methods.
#' @noRd
generate_git_archived_pkgs <- function(
  git_pkgs,
  archive_pkgs,
  flag_git_archive,
  ...
) {
  if (flag_git_archive == "") {
    NULL
  } else {
    fetchpkgs(git_pkgs, archive_pkgs, ...)
  }
}

#' generate_locale_variables Internal function that generates the string
#' containing the correct Nix expression to set locales.
#' @noRd
generate_locale_variables <- function() {
  locale_defaults <- list(
    LANG = "en_US.UTF-8",
    LC_ALL = "en_US.UTF-8",
    LC_TIME = "en_US.UTF-8",
    LC_MONETARY = "en_US.UTF-8",
    LC_PAPER = "en_US.UTF-8",
    LC_MEASUREMENT = "en_US.UTF-8"
  )

  locale_variables <- getOption(
    "rix.nix_locale_variables",
    default = locale_defaults
  )

  valid_vars <- all(names(locale_variables) %in% names(locale_defaults))

  if (!isTRUE(valid_vars)) {
    stop(
      "`options(rix.nix_locale_variables = list())` ",
      "only allows the following element names (locale variables):\n",
      paste(names(locale_defaults), collapse = "; "),
      call. = FALSE
    )
  }

  locale_vars <-
    Map(
      function(x, nm) paste0(nm, " = ", '"', x, '"', ";"),
      nm = names(locale_variables),
      x = locale_variables
    )

  paste(locale_vars, collapse = "\n    ")
}


#' generate_wrapped_pkgs Internal function that generates the string containing
#' the correct Nix expression to get wrapped packages.
#' @param ide Character, defaults to "other". If you wish to use RStudio to work
#'   interactively use "rstudio" or "rserver" for the server version. Use "code"
#'   for Visual Studio Code. You can also use "radian", an interactive REPL. For
#'   other editors, use "other". This has been tested with RStudio, VS Code and
#'   Emacs. If other editors don't work, please open an issue.
#' @param attrib Character, set the correct wrapper for the Nix expression.
#' @param flag_git_archive Character, are there R packages from GitHub at all?
#' @param flag_rpkgs Character, are there any R packages at all?
#' @param flag_local_r_pkgs Character, are there any local R packages at all?
#' @noRd
generate_wrapped_pkgs <- function(
  ide,
  attrib,
  flag_git_archive,
  flag_rpkgs,
  flag_local_r_pkgs
) {
  if (flag_rpkgs == "") {
    return(NULL)
  } else if (ide %in% names(attrib)) {
    sprintf(
      "
  wrapped_pkgs = pkgs.%s.override {
    packages = [ %s %s %s ];
  };
",
      attrib[ide],
      flag_git_archive,
      flag_rpkgs,
      flag_local_r_pkgs
    )
  } else {
    NULL
  }
}


#' generate_wrapped_pkgs Internal function that generates the string containing
#' the correct Nix expression to get wrapped packages.
#' @param flag_git_archive Character, are there R packages from GitHub at all?
#' @param flag_rpkgs Character, are there any R packages at all?
#' @param flag_tex_pkgs Character, are there any LaTex packages at all?
#' @param flag_py_conf Character, are there any Python packages at all?
#' @param flag_jl_conf Character, are there any Julia packages at all?
#' @param flag_local_r_pkgs Character, are there any wrapped packages at all?
#' @param flag_wrapper Character, are there any wrapped packages at all?
#' @param shell_hook Character, the mkShell's shellHook.
#' @noRd
generate_shell <- function(
  flag_git_archive,
  flag_rpkgs,
  flag_tex_pkgs,
  py_conf,
  flag_py_conf,
  flag_jl_conf,
  flag_local_r_pkgs,
  flag_wrapper,
  shell_hook
) {
  gsub(
    "(?<=\\S) {2,}",
    " ",
    sprintf(
      "
  shell = pkgs.mkShell {
    %s
    %s
    %s
    buildInputs = [ %s %s %s %s %s system_packages %s %s ];
    %s
  };",
      generate_locale_archive(detect_os()),
      generate_locale_variables(),
      generate_set_reticulate(py_conf, flag_py_conf),
      flag_git_archive,
      flag_rpkgs,
      flag_tex_pkgs,
      flag_py_conf,
      flag_jl_conf,
      flag_local_r_pkgs,
      flag_wrapper,
      shell_hook
    ),
    perl = TRUE
  )
}

#' generate_inherit Inherit pkgs shell for compatibility with rixpress
#' @noRd
generate_inherit <- function() {
  sprintf(
    "
in
  {
    inherit pkgs shell;
  }"
  )
}

#' remove_empty_lines Internal function to post-processes `default.nix`
#' files. Remove 2+ consecutive empty lines, only leaving one.
#' @param default.nix Character, default.nix lines.
#' @importFrom utils head
#' @noRd
remove_empty_lines <- function(default.nix) {
  keep <- !(default.nix == "" & c(FALSE, head(default.nix, -1) == ""))

  default.nix[keep]
}

#' generate_set_reticulate Helper to set path to reticulate
#' @noRd
generate_set_reticulate <- function(py_conf, flag_py_conf) {
  if (flag_py_conf == "") {
    ""
  } else {
    py_version <- paste0(
      "python",
      gsub("\\.", "", py_conf$py_version)
    )
    paste0('RETICULATE_PYTHON = "${pkgs.', py_version, '}/bin/python";\n')
  }
}