1#' An alternative to sessionInfo() to print session information
2#'
3#' This function tweaks the output of \code{\link{sessionInfo}()}: (1) It adds
4#' the RStudio version information if running in the RStudio IDE; (2) It removes
5#' the information about matrix products, BLAS, and LAPACK; (3) It removes the
6#' names of base R packages; (4) It prints out package versions in a single
7#' group, and does not differentiate between loaded and attached packages.
8#'
9#' It also allows you to only print out the versions of specified packages (via
10#' the \code{packages} argument) and optionally their recursive dependencies.
11#' For these specified packages (if provided), if a function
12#' \code{xfun_session_info()} exists in a package, it will be called and
13#' expected to return a character vector to be appended to the output of
14#' \code{session_info()}. This provides a mechanism for other packages to inject
15#' more information into the \code{session_info} output. For example,
16#' \pkg{rmarkdown} (>= 1.20.2) has a function \code{xfun_session_info()} that
17#' returns the version of Pandoc, which can be very useful information for
18#' diagnostics.
19#' @param packages A character vector of package names, of which the versions
20#'   will be printed. If not specified, it means all loaded and attached
21#'   packages in the current R session.
22#' @param dependencies Whether to print out the versions of the recursive
23#'   dependencies of packages.
24#' @return A character vector of the session information marked as
25#'   \code{\link{raw_string}()}.
26#' @export
27#' @examplesIf interactive()
28#' xfun::session_info()
29#' if (xfun::loadable('MASS')) xfun::session_info('MASS')
30session_info = function(packages = NULL, dependencies = TRUE) {
31  res = sessionInfo()
32  res$matprod = res$BLAS = res$LAPACK = NULL
33  if (loadable('rstudioapi') && rstudioapi::isAvailable()) {
34    res$running = paste0(res$running, ', RStudio ', rstudioapi::getVersion())
35  }
36
37  tweak_info = function(obj, extra = NULL) {
38    res = capture.output(print(obj))
39    i = grep('^(attached base packages|Matrix products):\\s*$', res, ignore.case = TRUE)
40    if (length(i)) res = res[-c(i, i + 1)]
41    res = gsubi('^\\s*locale:\\s*$', 'Locale:', res)
42    res = gsub('^\\s*\\[[0-9]+]\\s*', '  ', res)  # remove vector indices like [1]
43    res = gsubi('^\\s*other attached packages:\\s*$', 'Package version:', res)
44    # print the locale info on a single line if possible
45    if (length(i <- which(res == 'Locale:')) == 1 && res[i + 2] == '') {
46      res[i] = paste(res[i], gsub('\\s*/\\s*', ' / ', gsub('^\\s+', '', res[i + 1])))
47      res = res[-(i + 1)]
48    }
49    raw_string(c(res, extra))
50  }
51
52  version_info = function(pkgs) {
53    res = lapply(pkgs, function(p) {
54      list(Version = as.character(packageVersion(p)), Package = p)
55    })
56    as.list(setNames(res, pkgs))
57  }
58
59  res$basePkgs = raw_string(list())
60  info = c(res$otherPkgs, res$loadedOnly)
61  if (length(packages) > 0) {
62    info = info[intersect(names(info), packages)]
63    info = c(info, version_info(setdiff(packages, names(info))))
64  }
65  res$loadedOnly = NULL
66  if (dependencies) {
67    deps = pkg_dep(names(info), installed.packages(), recursive = TRUE)
68    deps = sort(setdiff(deps, names(info)))
69    info = c(info, version_info(deps))
70  }
71  if (length(packages) > 0 || dependencies) info = info[sort(names(info))]
72  res$otherPkgs = info
73  extra = unlist(lapply(packages, function(p) tryCatch(
74    c('', getFromNamespace('xfun_session_info', p)()), error = function(e) NULL)
75  ))
76
77  tweak_info(res, extra)
78}
79
80#' Perform a task once in an R session
81#'
82#' Perform a task once in an R session, e.g., emit a message or warning. Then
83#' give users an optional hint on how not to perform this task at all.
84#' @param task Any R code expression to be evaluated once to perform a task,
85#'   e.g., \code{warning('Danger!')} or \code{message('Today is ', Sys.Date())}.
86#' @param option An R option name. This name should be as unique as possible in
87#'   \code{\link{options}()}. After the task has been successfully performed,
88#'   this option will be set to \code{FALSE} in the current R session, to
89#'   prevent the task from being performed again the next time when
90#'   \code{do_once()} is called.
91#' @param hint A character vector to provide a hint to users on how not to
92#'   perform the task or see the message again in the current R session. Set
93#'   \code{hint = ""} if you do not want to provide the hint.
94#' @return The value returned by the \code{task}, invisibly.
95#' @export
96#' @examples
97#' do_once(message("Today's date is ", Sys.Date()), "xfun.date.reminder")
98#' # if you run it again, it will not emit the message again
99#' do_once(message("Today's date is ", Sys.Date()), "xfun.date.reminder")
100#'
101#' do_once({Sys.sleep(2); 1 + 1}, "xfun.task.1plus1")
102#' do_once({Sys.sleep(2); 1 + 1}, "xfun.task.1plus1")
103do_once = function(task, option, hint = c(
104  'You will not see this message again in this R session.',
105  'If you never want to see this message,',
106  sprintf('you may set options(%s = FALSE) in your .Rprofile.', option)
107)) {
108  if (isFALSE(getOption(option))) return(invisible())
109  task
110  hint = paste(hint, collapse = ' ')
111  if (hint != '') message(hint)
112  options(setNames(list(FALSE), option))
113  invisible(task)
114}
115