xfun/ 0000755 0001750 0001750 00000000000 14156202722 011365 5 ustar nilesh nilesh xfun/MD5 0000644 0001750 0001750 00000014766 14156202722 011713 0 ustar nilesh nilesh fde56b670e191e297b3883aa7dbe967a *DESCRIPTION
8250820174625f11b20c020347b7dcbf *LICENSE
098b5bb61b3f54dd972521a5e6972bf6 *NAMESPACE
294167efcf3160023e9a3ba08fa4bdcd *NEWS.md
7514edb7e95c22a89c7e128113c9e0a9 *R/api.R
8f724db3b8d1f08b73c26bdb6d8289dc *R/base64.R
2e6e13535e1a7e2e2b52650c012bc67b *R/cache.R
c474de9a7511f4a62c4e3b27085c359b *R/command.R
65916e7b842743ea1c780e32a6fe8ba0 *R/cran.R
da476e65f9c7e7777b710225920922f9 *R/data-structure.R
852ab016d104e500f36672c2986eea7d *R/encoding.R
806ee424ea2ebf901fd5c6dc06913351 *R/github.R
d99ae3a077480364f92ebdbc13151eca *R/image.R
474072003ca8abf53a3beb5437db3e09 *R/io.R
ad3ecfb8bcaaaf3f1b125f590f09bed4 *R/json.R
8957df6fb53638c994b66b23d2527e67 *R/markdown.R
f6d758bc0c85eb8183e219887611615b *R/os.R
d1f541f3e7d2da40e9f1b4d25a1263a2 *R/packages.R
b1be6321fae32faaac497ee07dddbba8 *R/paths.R
5ac67fd766ae12bb6dcc2cd67a065708 *R/revcheck.R
f1dd49b6d5a6050c1245f5235ea2f46f *R/rstudio.R
b4fe11fe4d752389b91eb74b638dd08a *R/session.R
66762e0e52f73a47830c4d2897e9d121 *R/string.R
645758fdc4417b033b9033cf3bcc93a3 *R/utils.R
f80b9875d6a99ec9764baac489b82c96 *build/vignette.rds
d74d28ea060faa50eabc2cb51dcd7f5f *inst/doc/xfun.R
8d2df1b5212ae9cbf016b6b1dcafa591 *inst/doc/xfun.Rmd
ad838d4e80ca9516be4fa10ec63e3e3c *inst/doc/xfun.html
9293b4398c636200df8bf31ce8e6ad3f *inst/scripts/call-fun.R
48b1848f9a4462dce14959981d3dd5ee *inst/scripts/child-pids.sh
4e4105a570be434f2780a252d213d2f0 *man/Rscript.Rd
2095a3404944f96680d87090a5eb4ae3 *man/Rscript_call.Rd
145823073737fb317192a88f96b0b1e8 *man/attr.Rd
ca6c7788a264a72d2e3faf0f8841f041 *man/base64_encode.Rd
db1d44246fbcf87868eba69b9658599f *man/base64_uri.Rd
6719fc46cae567295cc779acd23b1865 *man/base_pkgs.Rd
51fbefb2a2900335638689ea448e7529 *man/bg_process.Rd
489eabc96ce8fd2dda419985d45a19d4 *man/broken_packages.Rd
f625fb2c2cf35d3af13c12c54f3e0ca6 *man/bump_version.Rd
48c8efea1328bb224584b1c1163cabe4 *man/cache_rds.Rd
1db89afb274e3242c8203311b053c486 *man/crandalf_check.Rd
ae6faa59cb181830adb3fe5a709dc906 *man/del_empty_dir.Rd
17c8c03f01c5442c94c340c4f0f8dbba *man/dir_create.Rd
a81979c659896b5ee7bb1cae68641244 *man/dir_exists.Rd
02fc26d7ef574043275531c603c7b0f7 *man/do_once.Rd
3f7d5ef05c3132da8cfcd64063d3f97a *man/download_file.Rd
0b28e0664be98878cee170bc2b5ce751 *man/embed_file.Rd
143c1962aa4b46f36b0eeaf6033cd151 *man/existing_files.Rd
983d5f39170b08de321bdce8f296906a *man/exit_call.Rd
af6732d5714f63a5724c9f862ac00541 *man/file_ext.Rd
4e06ec02507a27ecafdcc920ca11f034 *man/file_string.Rd
9b2199d55eefe9f5fc89398107f7bc32 *man/format_bytes.Rd
f87d3e3ea7ed4ee3d9fd1ff92d3f81d3 *man/from_root.Rd
3e3a695bf18c6e184be9a9fef9ffa894 *man/github_releases.Rd
cac7f63f5b733f50418416994ea6a6df *man/grep_sub.Rd
09ac3348e9b66291e9ef038b1388d8d8 *man/gsub_file.Rd
12dfedf428830334f6fb5a68e01a34c0 *man/in_dir.Rd
dce8624d399af10cae29915e8f1328eb *man/install_dir.Rd
92eb34f64cc68efcdaa6b306b24d9e08 *man/install_github.Rd
6b29efad62d48a40ea8ae985e615f208 *man/isFALSE.Rd
45e103ba007b5fb6d158046757bdeab4 *man/is_R_CMD_check.Rd
16d27d8341634f2bc29fd7dd90da848f *man/is_abs_path.Rd
b27aa5dc7640437154c8c94236b1efbf *man/is_ascii.Rd
f5b00a908de21bb882212acfd88bd4f0 *man/is_sub_path.Rd
0f3241f25dfd91aec6b8604c1bad452a *man/is_web_path.Rd
7dfd6f1893bc8efe6c5af489d20cf49a *man/magic_path.Rd
3dd4fec6fd5efef35e092a2172366510 *man/mark_dirs.Rd
4f93dc72505cbb2aec19a7608eaca29d *man/msg_cat.Rd
2673261a55dc25a250876ac35e47cca2 *man/native_encode.Rd
4908a401d737bfc0d7544706f5ade82b *man/news2md.Rd
d14fd644e7f358e5a86bb8e150130409 *man/normalize_path.Rd
736537ffe052881a429024524db0b22d *man/numbers_to_words.Rd
f5e104151d84e332e189c69572e4600d *man/optipng.Rd
172f886a4e06c47f9cb05f06781d3072 *man/os.Rd
7cbfa9aa2787f1abe314fcd39fd320c4 *man/parse_only.Rd
734421228bb595e8c6702bfdf9897b5c *man/pkg_attach.Rd
c13f49676720646fd4bb8d6187f1dc1f *man/proc_kill.Rd
c30c82ba0cb1bfc6b984cb27925edfea *man/process_file.Rd
52d2a5363ff48c1c6cfa3c5cef9d5f13 *man/proj_root.Rd
beb2cf47c519361c8e3dbe13ca0f3b9e *man/prose_index.Rd
30ea18271d700ba35e246dfc4683d190 *man/protect_math.Rd
1a5280c440d309598289acac4358d325 *man/raw_string.Rd
6dbfe43344fbc9bbb3cd3a02709652e2 *man/read_all.Rd
fb0fe349704b92dd4857fe9ff93c46cb *man/read_bin.Rd
4a9885ee1c7d6dc9b82547726b4e6a66 *man/read_utf8.Rd
7b8f8c176c529fc33ac10bf995448eaf *man/relative_path.Rd
93e07573f831ea574bbecf858abb36ad *man/rename_seq.Rd
71ea0a134abe22c69f2637a123c4b66a *man/rest_api.Rd
fcd23b53a0ae6faba958317ead0ea294 *man/retry.Rd
2c191fa12748c7a2fa1254f404215a48 *man/rev_check.Rd
e58fe40d97ec051d35da2ab08145b108 *man/rstudio_type.Rd
ed767135afc65d66523e669608fae972 *man/same_path.Rd
21315a257e15b1c713c9f5d189155fc4 *man/session_info.Rd
eafb96b44b0b6024ca5bf38fbee6a4e1 *man/set_envvar.Rd
15db5d87f4cc66894ea4b1e972ab22b7 *man/split_lines.Rd
756826889c63014ff14dd88c1ffb68dd *man/split_source.Rd
6b826a293afba42edddf52412f11aeb6 *man/strict_list.Rd
8779a107140a0f5caeba6f5b08087733 *man/stringsAsStrings.Rd
a9b52e9187526c818b365eb7dfb854f1 *man/submit_cran.Rd
3260665d8d414b55805b7ca127f26dbd *man/system3.Rd
f71cda431eef30f13eba86189f5595eb *man/tinify.Rd
4331e8a8ad2287858a3fb8654ea0a4f4 *man/tojson.Rd
8fb0d37a55e8a31c007f47d921b62b79 *man/tree.Rd
c36d9132b3151a75d8a8439e66caad4e *man/try_error.Rd
1f21a2a55da87a2ba8ae5f053e133860 *man/try_silent.Rd
adcdbea1761c1afde1b6fa203c0c7384 *man/upload_ftp.Rd
de02426f6899317ea568ac93c1f98034 *man/url_accessible.Rd
4030df7964f5ccc19b8c8da7e9109ffa *man/url_filename.Rd
0254214fc4c894d20c7031e1367d886d *man/valid_syntax.Rd
e3d3cb360fbfdb3c6974e14eb5f09870 *src/Makevars
fa80cdcc801757b3bc591312ecaf1942 *src/base64.c
89a01103c4d3a20538970ed9ff993e4f *src/init.c
5c6caacc74f72def39c4cc64d980c71b *tests/test-ci.R
fe60425d528bf3786b7f3c84eb595307 *tests/test-ci/test-cran.R
040b51b8b64bc6d060bfb339214a1b9c *tests/test-ci/test-revcheck.R
82604fe7a77a94208c71d3d2093044a6 *tests/test-cran.R
d22e97c07da3639ddd1204ca0ccdbd7e *tests/test-cran/test-base64.R
5cfa000e0acd7844a06a1899db8f671e *tests/test-cran/test-command.R
64585c8d0560cadc3166b78501678284 *tests/test-cran/test-data-structure.R
e61a29b8fe1cc7165d75e8c59c5864e7 *tests/test-cran/test-encoding.R
3a4db13fe05553a3752cd8cc65a4ac90 *tests/test-cran/test-io.R
ba1eca1ad0cb05809de01075c324b84b *tests/test-cran/test-json.R
6fd6e9f776b294342ef714104d2ec7cf *tests/test-cran/test-markdown.R
6a92c86595dff18728b9be676a066d38 *tests/test-cran/test-packages.R
8fcf9f5c3eb9c835efc6689dfd549a64 *tests/test-cran/test-paths.R
f11df567ae059fd1d364f8290a778757 *tests/test-cran/test-string.R
70e2184db79e0acd800d8cac64a5cd65 *tests/test-cran/test-utils.R
8d2df1b5212ae9cbf016b6b1dcafa591 *vignettes/xfun.Rmd
xfun/NEWS.md 0000644 0001750 0001750 00000040621 14156156426 012477 0 ustar nilesh nilesh # CHANGES IN xfun VERSION 0.29
- `github_releases()` can fetch all releases (tags) of a Github repo now.
- Added an argument `.error` to `download_file()` so that users can customize the error message when the download fails.
- Added functions `rest_api_raw()` and `rest_api()` to get data from a REST API; also added the function `github_api()` to get data from the Github API based on `rest_api_raw()`.
- Added a wrapper function `system3()` based on `system2()` to mark the character output of `system2()` as UTF-8 if appropriate.
- Added a function `existing_files()` to return file paths that exist (a shorthand of `x[file.exists(x)]`).
- Added a function `read_all()` to read multiple files and concatenate the content into a character vector.
- `url_accessible()` uses `curlGetHeaders()` by default (instead of `download_file()`) to test if a URL is accessible when the **curl** package is not available.
- When `options(xfun.rev_check.compare = FALSE)`, `rev_check()` will run `R CMD check` on reverse dependencies against a source package but not the CRAN version of this package. By default, this option is `TRUE`, meaning that `R CMD check` will run against both versions of the package.
# CHANGES IN xfun VERSION 0.28
- Added a new function `url_accessible()` to test if a URL can be downloaded.
- Added a new function `try_error()` to try an expression and see if it throws an error.
# CHANGES IN xfun VERSION 0.27
- Exported and documented the function `xfun::base_pkgs()` (to return base R package names).
- Changed the default value of the `status_only` argument of `compare_Rcheck()` from `FALSE` to `TRUE`.
- Added new functions `crandalf_check()` and `crandalf_results()` for checking (especially large numbers of) reverse dependencies of packages via [**crandalf**](https://github.com/yihui/crandalf).
- Added new functions `append_utf8()` and `append_unique()` based on `read_utf8()` and `write_utf8()` to append content to files or connections.
# CHANGES IN xfun VERSION 0.26
- The `windows_only` argument of `native_encode()` has been removed. Now `native_encode()` only tries the conversion to native encoding on platforms where `l10n_info()[['UTF-8']]` does not return `TRUE`.
- Added a `solaris` argument to `upload_win_builder()`.
# CHANGES IN xfun VERSION 0.25
- Fixed a bug in `broken_packages()` (thanks, @PythonCoderUnicorn, rstudio/rmarkdown#1990).
- Added a `files` argument to `optipng()` so that users can specify the list of PNG files instead of running `optipng` on a whole directory.
# CHANGES IN xfun VERSION 0.24
- Exported the internal function `broken_packages()` to reinstall broken R packages.
- Fixed the bug in `proj_root()` #54 (thanks, @clarkliming).
# CHANGES IN xfun VERSION 0.23
## NEW FEATURES
- Added a `tinify()` function to compress PNG/JPEG images via [the Tinify API](https://tinypng.com/developers).
- Added a `news2md()` function to convert package news to the Markdown format. This is mainly for converting the plain-text `NEWS` file and the `NEWS.Rd` file to `NEWS.md`.
- Added a `format_bytes()` function to format numbers of bytes using a specified unit, e.g., `1024` can be formatted as `1 Kb`.
- When using `pkg_load2()` in an **renv** project, it will use `renv::install()` to install missing packages by default to take advantage of **renv**'s caching feature (thanks, @chunyunma @cderv, #52).
- `upload_win_builder()` no longer requires the system command `curl` to be available; if `curl` is not available, the R package **curl** will be used instead, which means this R package must be installed. In addition to uploading to the `ftp` server of win-builder, it's also possible to upload to } tag.
}
\examples{
logo = xfun:::R_logo()
img = htmltools::img(src = xfun::base64_uri(logo), alt = "R logo")
if (interactive()) htmltools::browsable(img)
}
xfun/man/is_sub_path.Rd 0000644 0001750 0001750 00000001435 14156162700 014733 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{is_sub_path}
\alias{is_sub_path}
\title{Test if a path is a subpath of a dir}
\usage{
is_sub_path(x, dir, n = nchar(dir))
}
\arguments{
\item{x}{A vector of paths.}
\item{dir}{A vector of directory paths.}
\item{n}{The length of \code{dir} paths.}
}
\value{
A logical vector.
}
\description{
Check if the path starts with the dir path.
}
\note{
You may want to normalize the values of the \code{x} and \code{dir}
arguments first (with \code{xfun::\link{normalize_path}()}), to make sure
the path separators are consistent.
}
\examples{
xfun::is_sub_path("a/b/c.txt", "a/b") # TRUE
xfun::is_sub_path("a/b/c.txt", "d/b") # FALSE
xfun::is_sub_path("a/b/c.txt", "a\\\\b") # FALSE (even on Windows)
}
xfun/man/magic_path.Rd 0000644 0001750 0001750 00000003041 14156162700 014522 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{magic_path}
\alias{magic_path}
\title{Find a file or directory under a root directory}
\usage{
magic_path(
...,
root = proj_root(),
relative = TRUE,
error = TRUE,
message = getOption("xfun.magic_path.message", TRUE),
n_dirs = getOption("xfun.magic_path.n_dirs", 10000)
)
}
\arguments{
\item{...}{A character vector of path components.}
\item{root}{The root directory under which to search for the path. If
\code{NULL}, the current working directory is used.}
\item{relative}{Whether to return a relative path.}
\item{error}{Whether to signal an error if the path is not found, or multiple
paths are found.}
\item{message}{Whether to emit a message when multiple paths are found and
\code{error = FALSE}.}
\item{n_dirs}{The number of subdirectories to recursively search. The
recursive search may be time-consuming when there are a large number of
subdirectories under the root directory. If you really want to search for
all subdirectories, you may try \code{n_dirs = Inf}.}
}
\value{
The path found under the root directory, or an error when \code{error
= TRUE} and the path is not found (or multiple paths are found).
}
\description{
Given a path, try to find it recursively under a root directory. The input
path can be an incomplete path, e.g., it can be a base filename, and
\code{magic_path()} will try to find this file under subdirectories.
}
\examples{
\dontrun{
xfun::magic_path("mtcars.csv") # find any file that has the base name mtcars.csv
}
}
xfun/man/tinify.Rd 0000644 0001750 0001750 00000005772 14156162700 013745 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/image.R
\name{tinify}
\alias{tinify}
\title{Use the Tinify API to compress PNG and JPEG images}
\usage{
tinify(
input,
output,
quiet = FALSE,
force = FALSE,
key = getOption("xfun.tinify.key", Sys.getenv("R_XFUN_TINIFY_KEY")),
history = getOption("xfun.tinify.history", Sys.getenv("R_XFUN_TINIFY_HISTORY"))
)
}
\arguments{
\item{input}{A vector of input paths of images.}
\item{output}{A vector of output paths or a function that takes \code{input}
and returns a vector of output paths (e.g., \code{output = \link{identity}}
means \code{output = input}). By default, if the \code{history} argument is
not a provided, \code{output} is \code{input} with a suffix \code{-min}
(e.g., when \code{input = 'foo.png'}, \code{output = 'foo-min.png'}),
otherwise \code{output} is the same as \code{input}, which means the
original image files will be overwritten.}
\item{quiet}{Whether to suppress detailed information about the compression,
which is of the form \samp{input.png (10 Kb) ==> output.png (5 Kb, 50\%);
compression count: 42}. The percentage after \code{output.png} stands for
the compression ratio, and the compression count shows the number of
compressions used for the current month.}
\item{force}{Whether to compress an image again when it appears to have been
compressed before. This argument only makes sense when the \code{history}
argument is provided.}
\item{key}{The Tinify API key. It can be set via either the global option
\code{xfun.tinify.key} (you may set it in \file{~/.Rprofile}) or the
environment variable \code{R_XFUN_TINIFY_KEY} (you may set it in
\file{~/.Renviron}).}
\item{history}{Path to a history file to record the MD5 checksum of
compressed images. If the checksum of an expected output image exists in
this file and \code{force = FALSE}, the compression will be skipped. This
can help you avoid unnecessary API calls.}
}
\value{
The output file paths.
}
\description{
Compress PNG/JPEG images with \samp{api.tinify.com}, and download the
compressed images. This function requires R packages \pkg{curl} and
\pkg{jsonlite}.
}
\details{
You are recommended to set the API key in \file{.Rprofile} or
\file{.Renviron}. After that, the only required argument of this function is
\code{input}. If the original images can be overwritten by the compressed
images, you may either use \code{output = identity}, or set the value of the
\code{history} argument in \file{.Rprofile} or \file{.Renviron}.
}
\examples{\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
f = file.path(R.home("doc"), "html", "logo.jpg")
xfun::tinify(f) # remember to set the API key before trying this
\dontshow{\}) # examplesIf}
}
\references{
Tinify API: \url{https://tinypng.com/developers}.
}
\seealso{
The \pkg{tinieR} package (\url{https://github.com/jmablog/tinieR/})
is a more comprehensive implementation of the Tinify API, whereas
\code{xfun::tinify()} has only implemented the feature of shrinking images.
}
xfun/man/attr.Rd 0000644 0001750 0001750 00000000776 14156162700 013414 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{attr}
\alias{attr}
\title{Obtain an attribute of an object without partial matching}
\usage{
attr(...)
}
\arguments{
\item{...}{Passed to \code{base::\link[base]{attr}()} (without the
\code{exact} argument).}
}
\description{
An abbreviation of \code{base::\link[base]{attr}(exact = TRUE)}.
}
\examples{
z = structure(list(a = 1), foo = 2)
base::attr(z, "f") # 2
xfun::attr(z, "f") # NULL
xfun::attr(z, "foo") # 2
}
xfun/man/os.Rd 0000644 0001750 0001750 00000001056 14156162700 013053 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/os.R
\name{is_windows}
\alias{is_windows}
\alias{is_unix}
\alias{is_macos}
\alias{is_linux}
\title{Test for types of operating systems}
\usage{
is_windows()
is_unix()
is_macos()
is_linux()
}
\description{
Functions based on \code{.Platform$OS.type} and \code{Sys.info()} to test if
the current operating system is Windows, macOS, Unix, or Linux.
}
\examples{
library(xfun)
# only one of the following statements should be true
is_windows()
is_unix() && is_macos()
is_linux()
}
xfun/man/valid_syntax.Rd 0000644 0001750 0001750 00000001216 14156162701 015136 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/string.R
\name{valid_syntax}
\alias{valid_syntax}
\title{Check if the syntax of the code is valid}
\usage{
valid_syntax(code, silent = TRUE)
}
\arguments{
\item{code}{A character vector of R source code.}
\item{silent}{Whether to suppress the error message when the code is not
valid.}
}
\value{
\code{TRUE} if the code could be parsed, otherwise \code{FALSE}.
}
\description{
Try to \code{\link{parse}()} the code and see if an error occurs.
}
\examples{
xfun::valid_syntax("1+1")
xfun::valid_syntax("1+")
xfun::valid_syntax(c("if(T){1+1}", "else {2+2}"), silent = FALSE)
}
xfun/man/set_envvar.Rd 0000644 0001750 0001750 00000001554 14156162700 014611 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{set_envvar}
\alias{set_envvar}
\title{Set environment variables}
\usage{
set_envvar(vars)
}
\arguments{
\item{vars}{A named character vector of the form \code{c(VARIABLE = VALUE)}.
If any value is \code{NA}, this function will try to unset the variable.}
}
\value{
Old values of the variables (if not set, \code{NA}).
}
\description{
Set environment variables from a named character vector, and return the old
values of the variables, so they could be restored later.
}
\details{
The motivation of this function is that \code{\link{Sys.setenv}()} does not
return the old values of the environment variables, so it is not
straightforward to restore the variables later.
}
\examples{
vars = xfun::set_envvar(c(FOO = "1234"))
Sys.getenv("FOO")
xfun::set_envvar(vars)
Sys.getenv("FOO")
}
xfun/man/rev_check.Rd 0000644 0001750 0001750 00000015611 14156162700 014365 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/revcheck.R
\name{rev_check}
\alias{rev_check}
\alias{compare_Rcheck}
\title{Run \command{R CMD check} on the reverse dependencies of a package}
\usage{
rev_check(
pkg,
which = "all",
recheck = NULL,
ignore = NULL,
update = TRUE,
timeout = getOption("xfun.rev_check.timeout", 15 * 60),
src = file.path(src_dir, pkg),
src_dir = getOption("xfun.rev_check.src_dir")
)
compare_Rcheck(status_only = TRUE, output = "00check_diffs.md")
}
\arguments{
\item{pkg}{The package name.}
\item{which}{Which types of reverse dependencies to check. See
\code{tools::\link[tools]{package_dependencies}()} for possible values. The
special value \code{'hard'} means the hard dependencies, i.e.,
\code{c('Depends', 'Imports', 'LinkingTo')}.}
\item{recheck}{A vector of package names to be (re)checked. If not provided
and there are any \file{*.Rcheck} directories left by certain packages
(this often means these packages failed the last time), \code{recheck} will
be these packages; if there are no \file{*.Rcheck} directories but a text
file \file{recheck} exists, \code{recheck} will be the character vector
read from this file. This provides a way for you to manually specify the
packages to be checked. If there are no packages to be rechecked, all
reverse dependencies will be checked.}
\item{ignore}{A vector of package names to be ignored in \command{R CMD
check}. If this argument is missing and a file \file{00ignore} exists, the
file will be read as a character vector and passed to this argument.}
\item{update}{Whether to update all packages before the check.}
\item{timeout}{Timeout in seconds for \command{R CMD check} to check each
package. The (approximate) total time can be limited by the global option
\code{xfun.rev_check.timeout_total}.}
\item{src}{The path of the source package directory.}
\item{src_dir}{The parent directory of the source package directory. This can
be set in a global option if all your source packages are under a common
parent directory.}
\item{status_only}{If \code{TRUE}, only compare the final statuses of the
checks (the last line of \file{00check.log}), and delete \file{*.Rcheck}
and \file{*.Rcheck2} if the statuses are identical, otherwise write out the
full diffs of the logs. If \code{FALSE}, compare the full logs under
\file{*.Rcheck} and \file{*.Rcheck2}.}
\item{output}{The output Markdown file to which the diffs in check logs will
be written. If the \pkg{markdown} package is available, the Markdown file
will be converted to HTML, so you can see the diffs more clearly.}
}
\value{
A named numeric vector with the names being package names of reverse
dependencies; \code{0} indicates check success, \code{1} indicates failure,
and \code{2} indicates that a package was not checked due to global
timeout.
}
\description{
Install the source package, figure out the reverse dependencies on CRAN,
download all of their source packages, and run \command{R CMD check} on them
in parallel.
}
\details{
Everything occurs under the current working directory, and you are
recommended to call this function under a designated directory, especially
when the number of reverse dependencies is large, because all source packages
will be downloaded to this directory, and all \file{*.Rcheck} directories
will be generated under this directory, too.
If a source tarball of the expected version has been downloaded before (under
the \file{tarball} directory), it will not be downloaded again (to save time
and bandwidth).
After a package has been checked, the associated \file{*.Rcheck} directory
will be deleted if the check was successful (no warnings or errors or notes),
which means if you see a \file{*.Rcheck} directory, it means the check
failed, and you need to take a look at the log files under that directory.
The time to finish the check is recorded for each package. As the check goes
on, the total remaining time will be roughly estimated via \code{n *
mean(times)}, where \code{n} is the number of packages remaining to be
checked, and \code{times} is a vector of elapsed time of packages that have
been checked.
If a check on a reverse dependency failed, its \file{*.Rcheck} directory will
be renamed to \file{*.Rcheck2}, and another check will be run against the
CRAN version of the package unless \code{options(xfun.rev_check.compare =
FALSE)} is set. If the logs of the two checks are the same, it means no new
problems were introduced in the package, and you can probably ignore this
particular reverse dependency. The function \code{compare_Rcheck()} can be
used to create a summary of all the differences in the check logs under
\file{*.Rcheck} and \file{*.Rcheck2}. This will be done automatically if
\code{options(xfun.rev_check.summary = TRUE)} has been set.
A recommended workflow is to use a special directory to run
\code{rev_check()}, set the global \code{\link{options}}
\code{xfun.rev_check.src_dir} and \code{repos} in the R startup (see
\code{?\link{Startup}}) profile file \code{.Rprofile} under this directory,
and (optionally) set \code{R_LIBS_USER} in \file{.Renviron} to use a special
library path (so that your usual library will not be cluttered). Then run
\code{xfun::rev_check(pkg)} once, investigate and fix the problems or (if you
believe it was not your fault) ignore broken packages in the file
\file{00ignore}, and run \code{xfun::rev_check(pkg)} again to recheck the
failed packages. Repeat this process until all \file{*.Rcheck} directories
are gone.
As an example, I set \code{options(repos = c(CRAN =
'https://cran.rstudio.com'), xfun.rev_check.src_dir = '~/Dropbox/repo')} in
\file{.Rprofile}, and \code{R_LIBS_USER=~/R-tmp} in \file{.Renviron}. Then I
can run, for example, \code{xfun::rev_check('knitr')} repeatedly under a
special directory \file{~/Downloads/revcheck}. Reverse dependencies and their
dependencies will be installed to \file{~/R-tmp}, and \pkg{knitr} will be
installed from \file{~/Dropbox/repo/kintr}.
}
\seealso{
\code{devtools::revdep_check()} is more sophisticated, but currently
has a few major issues that affect me: (1) It always deletes the
\file{*.Rcheck} directories
(\url{https://github.com/r-lib/devtools/issues/1395}), which makes it
difficult to know more information about the failures; (2) It does not
fully install the source package before checking its reverse dependencies
(\url{https://github.com/r-lib/devtools/pull/1397}); (3) I feel it is
fairly difficult to iterate the check (ignore the successful packages and
only check the failed packages); by comparison, \code{xfun::rev_check()}
only requires you to run a short command repeatedly (failed packages are
indicated by the existing \file{*.Rcheck} directories, and automatically
checked again the next time).
\code{xfun::rev_check()} borrowed a very nice feature from
\code{devtools::revdep_check()}: estimating and displaying the remaining
time. This is particularly useful for packages with huge numbers of reverse
dependencies.
}
xfun/man/file_string.Rd 0000644 0001750 0001750 00000001007 14156162700 014733 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/io.R
\name{file_string}
\alias{file_string}
\title{Read a text file and concatenate the lines by \code{'\n'}}
\usage{
file_string(file)
}
\arguments{
\item{file}{Path to a text file (should be encoded in UTF-8).}
}
\value{
A character string of text lines concatenated by \code{'\n'}.
}
\description{
The source code of this function should be self-explanatory.
}
\examples{
xfun::file_string(system.file("DESCRIPTION", package = "xfun"))
}
xfun/man/is_R_CMD_check.Rd 0000644 0001750 0001750 00000000755 14156162700 015153 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/cran.R
\name{is_R_CMD_check}
\alias{is_R_CMD_check}
\alias{is_CRAN_incoming}
\alias{check_package_name}
\alias{check_old_package}
\title{Some utility functions for checking packages}
\usage{
is_R_CMD_check()
is_CRAN_incoming()
check_package_name()
check_old_package(name, version)
}
\description{
Miscellaneous utility functions to obtain information about the package
checking environment.
}
\keyword{internal}
xfun/man/rename_seq.Rd 0000644 0001750 0001750 00000003323 14156162700 014550 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{rename_seq}
\alias{rename_seq}
\title{Rename files with a sequential numeric prefix}
\usage{
rename_seq(
pattern = "^[0-9]+-.+[.]Rmd$",
format = "auto",
replace = TRUE,
start = 1,
dry_run = TRUE
)
}
\arguments{
\item{pattern}{A regular expression for \code{\link{list.files}()} to obtain
the files to be renamed. For example, to rename \code{.jpeg} files, use
\code{pattern = "[.]jpeg$"}.}
\item{format}{The format for the numeric prefix. This is passed to
\code{\link{sprintf}()}. The default format is \code{"\%0Nd"} where \code{N
= floor(log10(n)) + 1} and \code{n} is the number of files, which means the
prefix may be padded with zeros. For example, if there are 150 files to be
renamed, the format will be \code{"\%03d"} and the prefixes will be
\code{001}, \code{002}, ..., \code{150}.}
\item{replace}{Whether to remove existing numeric prefixes in filenames.}
\item{start}{The starting number for the prefix (it can start from 0).}
\item{dry_run}{Whether to not really rename files. To be safe, the default is
\code{TRUE}. If you have looked at the new filenames and are sure the new
names are what you want, you may rerun \code{rename_seq()} with
\code{dry_run = FALSE)} to actually rename files.}
}
\value{
A named character vector. The names are original filenames, and the
vector itself is the new filenames.
}
\description{
Rename a series of files and add an incremental numeric prefix to the
filenames. For example, files \file{a.txt}, \file{b.txt}, and \file{c.txt}
can be renamed to \file{1-a.txt}, \file{2-b.txt}, and \file{3-c.txt}.
}
\examples{
xfun::rename_seq()
xfun::rename_seq("[.](jpeg|png)$", format = "\%04d")
}
xfun/man/news2md.Rd 0000644 0001750 0001750 00000001757 14156162700 014021 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/packages.R
\name{news2md}
\alias{news2md}
\title{Convert package news to the Markdown format}
\usage{
news2md(package, ..., output = "NEWS.md", category = TRUE)
}
\arguments{
\item{package, ...}{Arguments to be passed to \code{\link{news}()}.}
\item{output}{The output file path.}
\item{category}{Whether to keep the category names.}
}
\value{
If \code{output = NA}, returns the Markdown content as a character
vector, otherwise the content is written to the output file.
}
\description{
Read the package news with \code{\link{news}()}, convert the result to
Markdown, and write to an output file (e.g., \file{NEWS.md}). Each package
version appears in a first-level header, each category (e.g., \samp{NEW
FEATURES} or \samp{BUG FIXES}) is in a second-level header, and the news
items are written into bullet lists.
}
\examples{
# news for the current version of R
xfun::news2md("R", Version == getRversion(), output = NA)
}
xfun/man/tree.Rd 0000644 0001750 0001750 00000001746 14156162700 013377 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{tree}
\alias{tree}
\title{Turn the output of \code{\link{str}()} into a tree diagram}
\usage{
tree(...)
}
\arguments{
\item{...}{Arguments to be passed to \code{\link{str}()} (note that the
\code{comp.str} is hardcoded inside this function, and it is the only
argument that you cannot customize).}
}
\value{
A character string as a \code{\link{raw_string}()}.
}
\description{
The super useful function \code{str()} uses \verb{..} to indicate the level
of sub-elements of an object, which may be difficult to read. This function
uses vertical pipes to connect all sub-elements on the same level, so it is
clearer which elements belong to the same parent element in an object with a
nested structure (such as a nested list).
}
\examples{
fit = lsfit(1:9, 1:9)
str(fit)
xfun::tree(fit)
fit = lm(dist ~ speed, data = cars)
str(fit)
xfun::tree(fit)
# some trivial examples
xfun::tree(1:10)
xfun::tree(iris)
}
xfun/man/broken_packages.Rd 0000644 0001750 0001750 00000001337 14156162700 015552 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/packages.R
\name{broken_packages}
\alias{broken_packages}
\title{Find out broken packages and reinstall them}
\usage{
broken_packages(reinstall = TRUE)
}
\arguments{
\item{reinstall}{Whether to reinstall the broken packages, or only list their
names.}
}
\value{
A character vector of names of broken package.
}
\description{
If a package is broken (i.e., not \code{\link{loadable}()}), reinstall it.
}
\details{
Installed R packages could be broken for several reasons. One common reason
is that you have upgraded R to a newer \code{x.y} version, e.g., from
\code{4.0.5} to \code{4.1.0}, in which case you need to reinstall previously
installed packages.
}
xfun/man/base_pkgs.Rd 0000644 0001750 0001750 00000001001 14156162700 014356 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/packages.R
\name{base_pkgs}
\alias{base_pkgs}
\title{Get base R package names}
\usage{
base_pkgs()
}
\value{
A character vector of base R package names.
}
\description{
Return names of packages from \code{\link{installed.packages}()} of which the
priority is \code{"base"}.
}
\examples{\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
xfun::base_pkgs()
\dontshow{\}) # examplesIf}
}
xfun/man/relative_path.Rd 0000644 0001750 0001750 00000002312 14156162700 015255 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{relative_path}
\alias{relative_path}
\title{Get the relative path of a path relative to a directory}
\usage{
relative_path(x, dir = ".", use.. = TRUE, error = TRUE)
}
\arguments{
\item{x}{A vector of paths to be converted to relative paths.}
\item{dir}{Path to a directory.}
\item{use..}{Whether to use double-dots (\file{..}) in the relative path. A
double-dot indicates the parent directory (starting from the directory
provided by the \code{dir} argument).}
\item{error}{Whether to signal an error if a path cannot be converted to a
relative path.}
}
\value{
A vector of relative paths if the conversion succeeded; otherwise the
original paths when \code{error = FALSE}, and an error when \code{error =
TRUE}.
}
\description{
Given a directory, return the relative path that is relative to this
directory. For example, the path \file{foo/bar.txt} relative to the directory
\file{foo/} is \file{bar.txt}, and the path \file{/a/b/c.txt} relative to
\file{/d/e/} is \file{../../a/b/c.txt}.
}
\examples{
xfun::relative_path("foo/bar.txt", "foo/")
xfun::relative_path("foo/bar/a.txt", "foo/haha/")
xfun::relative_path(getwd())
}
xfun/man/isFALSE.Rd 0000644 0001750 0001750 00000000626 14156162700 013622 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{isFALSE}
\alias{isFALSE}
\title{Test if an object is identical to \code{FALSE}}
\usage{
isFALSE(x)
}
\arguments{
\item{x}{An R object.}
}
\description{
A simple abbreviation of \code{identical(x, FALSE)}.
}
\examples{
library(xfun)
isFALSE(TRUE) # false
isFALSE(FALSE) # true
isFALSE(c(FALSE, FALSE)) # false
}
xfun/man/rest_api.Rd 0000644 0001750 0001750 00000005721 14156162700 014243 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/api.R, R/github.R
\name{rest_api}
\alias{rest_api}
\alias{rest_api_raw}
\alias{github_api}
\title{Get data from a REST API}
\usage{
rest_api(...)
rest_api_raw(root, endpoint, token = "", params = list(), headers = NULL)
github_api(
endpoint,
token = "",
params = list(),
headers = NULL,
raw = !loadable("jsonlite")
)
}
\arguments{
\item{...}{Arguments to be passed to \code{rest_api_raw()}.}
\item{root}{The API root URL.}
\item{endpoint}{The API endpoint.}
\item{token}{A named character string (e.g., \code{c(token = "xxxx")}), which
will be used to create an authorization header of the form
\samp{Authorization: NAME TOKEN} for the API call, where \samp{NAME} is the
name of the string and \samp{TOKEN} is the string. If the string does not
have a name, \samp{Basic} will be used as the default name.}
\item{params}{A list of query parameters to be sent with the API call.}
\item{headers}{A named character vector of HTTP headers, e.g., \code{c(Accept
= "application/vnd.github.v3+json")}.}
\item{raw}{Whether to return the raw response or parse the response with
\pkg{jsonlite}.}
}
\value{
A character vector (the raw JSON response) or an R object parsed from
the JSON text.
}
\description{
Read data from a REST API and optionally with an authorization token in the
request header. The function \code{rest_api_raw()} returns the raw text of
the response, and \code{rest_api()} will parse the response with
\code{jsonlite::fromJSON()} (assuming that the response is in the JSON
format).
}
\details{
These functions are simple wrappers based on \code{\link{url}()} and
\code{\link{read_utf8}()}. Specifically, the \code{headers} argument is
passed to \code{url()}, and \code{read_utf8()} will send a \samp{GET} request
to the API server. This means these functions only support the \samp{GET}
method. If you need to use other HTTP methods (such as \samp{POST}), you have
to use other packages such as \pkg{curl} and \pkg{httr}.
\code{github_api()} is a wrapper function based on
\code{rest_api_raw()} to obtain data from the Github API:
\url{https://docs.github.com/en/rest}. You can provide a personal access
token (PAT) via the \code{token} argument, or via one of the environment
variables \var{GITHUB_PAT}, \var{GITHUB_TOKEN}, \var{GH_TOKEN}. A PAT
allows for a much higher rate limit in API calls. Without a token, you can
only make 60 calls in an hour.
}
\examples{\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
# a normal GET request
xfun::rest_api("https://httpbin.org", "/get")
xfun::rest_api_raw("https://httpbin.org", "/get")
# send the request with an auth header
xfun::rest_api("https://httpbin.org", "/headers", "OPEN SESAME!")
# with query parameters
xfun::rest_api("https://httpbin.org", "/response-headers", params = list(foo = "bar"))
# get the rate limit info from Github
xfun::github_api("/rate_limit")
\dontshow{\}) # examplesIf}
}
xfun/man/url_filename.Rd 0000644 0001750 0001750 00000001247 14156162701 015077 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{url_filename}
\alias{url_filename}
\title{Extract filenames from a URLs}
\usage{
url_filename(x)
}
\arguments{
\item{x}{A character vector of URLs.}
}
\value{
A character vector of filenames at the end of URLs.
}
\description{
Get the base names of URLs via \code{\link{basename}()}, and remove the
possible query parameters or hash from the names.
}
\examples{
xfun::url_filename("https://yihui.org/images/logo.png")
xfun::url_filename("https://yihui.org/index.html")
xfun::url_filename("https://yihui.org/index.html?foo=bar")
xfun::url_filename("https://yihui.org/index.html#about")
}
xfun/man/proj_root.Rd 0000644 0001750 0001750 00000004006 14156162700 014445 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\docType{data}
\name{proj_root}
\alias{proj_root}
\alias{root_rules}
\title{Return the (possible) root directory of a project}
\format{
An object of class \code{matrix} (inherits from \code{array}) with 2 rows and 2 columns.
}
\usage{
proj_root(path = "./", rules = root_rules)
root_rules
}
\arguments{
\item{path}{The initial path to start the search. If it is a file path, its
parent directory will be used.}
\item{rules}{A matrix of character strings of two columns: the first column
contains regular expressions to look for filenames that match the patterns,
and the second column contains regular expressions to match the content of
the matched files. The regular expression can be an empty string, meaning
that it will match anything.}
}
\value{
Path to the root directory if found, otherwise \code{NULL}.
}
\description{
Given a path of a file (or dir) in a potential project (e.g., an R package or
an RStudio project), return the path to the project root directory.
}
\details{
The search for the root directory is performed by a series of tests,
currently including looking for a \file{DESCRIPTION} file that contains
\code{Package: *} (which usually indicates an R package), and a
\file{*.Rproj} file that contains \code{Version: *} (which usually indicates
an RStudio project). If files with the expected patterns are not found in the
initial directory, the search will be performed recursively in upper-level
directories.
}
\note{
This function was inspired by the \pkg{rprojroot} package, but is much
less sophisticated. It is a rather simple function designed to be used in
some of packages that I maintain, and may not meet the need of general
users until this note is removed in the future (which should be unlikely).
If you are sure that you are working on the types of projects mentioned in
the \sQuote{Details} section, this function may be helpful to you,
otherwise please consider using \pkg{rprojroot} instead.
}
\keyword{datasets}
xfun/man/protect_math.Rd 0000644 0001750 0001750 00000003243 14156162700 015123 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/markdown.R
\name{protect_math}
\alias{protect_math}
\title{Protect math expressions in pairs of backticks in Markdown}
\usage{
protect_math(x)
}
\arguments{
\item{x}{A character vector of text in Markdown.}
}
\value{
A character vector with math expressions in backticks.
}
\description{
For Markdown renderers that do not support LaTeX math, we need to protect
math expressions as verbatim code (in a pair of backticks), because some
characters in the math expressions may be interpreted as Markdown syntax
(e.g., a pair of underscores may make text italic). This function detects
math expressions in Markdown (by heuristics), and wrap them in backticks.
}
\details{
Expressions in pairs of dollar signs or double dollar signs are treated as
math, if there are no spaces after the starting dollar sign, or before the
ending dollar sign. There should be spaces before the starting dollar sign,
unless the math expression starts from the very beginning of a line. For a
pair of single dollar signs, the ending dollar sign should not be followed by
a number. With these assumptions, there should not be too many false
positives when detecing math expressions.
Besides, LaTeX environments (\verb{\begin{*}} and \verb{\end{*}}) are also
protected in backticks.
}
\note{
If you are using Pandoc or the \pkg{rmarkdown} package, there is no
need to use this function, because Pandoc's Markdown can recognize math
expressions.
}
\examples{
library(xfun)
protect_math(c("hi $a+b$", "hello $$\\\\alpha$$", "no math here: $x is $10 dollars"))
protect_math(c("hi $$", "\\\\begin{equation}", "x + y = z", "\\\\end{equation}"))
}
xfun/man/same_path.Rd 0000644 0001750 0001750 00000001006 14156162700 014366 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{same_path}
\alias{same_path}
\title{Test if two paths are the same after they are normalized}
\usage{
same_path(p1, p2, ...)
}
\arguments{
\item{p1, p2}{Two vectors of paths.}
\item{...}{Arguments to be passed to \code{\link{normalize_path}()}.}
}
\description{
Compare two paths after normalizing them with the same separator (\code{/}).
}
\examples{
library(xfun)
same_path("~/foo", file.path(Sys.getenv("HOME"), "foo"))
}
xfun/man/read_bin.Rd 0000644 0001750 0001750 00000001303 14156162700 014170 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/io.R
\name{read_bin}
\alias{read_bin}
\title{Read all records of a binary file as a raw vector by default}
\usage{
read_bin(file, what = "raw", n = file.info(file)$size, ...)
}
\arguments{
\item{file, what, n, ...}{Arguments to be passed to \code{readBin()}.}
}
\value{
A vector returned from \code{readBin()}.
}
\description{
This is a wrapper function of \code{\link{readBin}()} with default arguments
\code{what = "raw"} and \code{n = \link{file.size}(file)}, which means it
will read the full content of a binary file as a raw vector by default.
}
\examples{
f = tempfile()
cat("abc", file = f)
xfun::read_bin(f)
unlink(f)
}
xfun/man/github_releases.Rd 0000644 0001750 0001750 00000002051 14156162700 015573 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/github.R
\name{github_releases}
\alias{github_releases}
\title{Get the tags of Github releases of a repository}
\usage{
github_releases(
repo,
tag = "",
pattern = "v[0-9.]+",
use_jsonlite = loadable("jsonlite")
)
}
\arguments{
\item{repo}{The repository name of the form \code{user/repo}, e.g.,
\code{"yihui/xfun"}.}
\item{tag}{A tag as a character string. If provided, it will be returned if
the tag exists. If \code{tag = "latest"}, the tag of the latest release is
returned.}
\item{pattern}{A regular expression to match the tags.}
\item{use_jsonlite}{Whether to use \pkg{jsonlite} to parse the releases info.}
}
\value{
A character vector of (GIT) tags.
}
\description{
Use the Github API (\code{\link{github_api}()}) to obtain the tags of the
releases.
}
\examples{\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
xfun::github_releases("yihui/xfun")
xfun::github_releases("gohugoio/hugo")
\dontshow{\}) # examplesIf}
}
xfun/man/exit_call.Rd 0000644 0001750 0001750 00000002241 14156162700 014373 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{exit_call}
\alias{exit_call}
\title{Call \code{on.exit()} in a parent function}
\usage{
exit_call(fun, n = 2, ...)
}
\arguments{
\item{fun}{A function to be called when the parent function exits.}
\item{n}{The parent frame number. For \code{n = 1}, \code{exit_call(fun)} is
the same as \code{on.exit(fun())}; \code{n = 2} means adding
\code{on.exit(fun())} in the parent function; \code{n = 3} means the
grandparent, etc.}
\item{...}{Other arguments to be passed to \code{on.exit()}.}
}
\description{
The function \code{\link{on.exit}()} is often used to perform tasks when the
current function exits. This \code{exit_call()} function allows calling a
function when a parent function exits (thinking of it as inserting an
\code{on.exit()} call into the parent function).
}
\examples{
f = function(x) {
print(x)
xfun::exit_call(function() print("The parent function is exiting!"))
}
g = function(y) {
f(y)
print("f() has been called!")
}
g("An argument of g()!")
}
\references{
This function was inspired by Kevin Ushey:
\url{https://yihui.org/en/2017/12/on-exit-parent/}
}
xfun/man/is_ascii.Rd 0000644 0001750 0001750 00000001056 14156162700 014215 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/encoding.R
\name{is_ascii}
\alias{is_ascii}
\title{Check if a character vector consists of entirely ASCII characters}
\usage{
is_ascii(x)
}
\arguments{
\item{x}{A character vector.}
}
\value{
A logical vector indicating whether each element of the character
vector is ASCII.
}
\description{
Converts the encoding of a character vector to \code{'ascii'}, and check if
the result is \code{NA}.
}
\examples{
library(xfun)
is_ascii(letters) # yes
is_ascii(intToUtf8(8212)) # no
}
xfun/man/existing_files.Rd 0000644 0001750 0001750 00000001200 14156162700 015435 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{existing_files}
\alias{existing_files}
\title{Find file paths that exist}
\usage{
existing_files(x, first = FALSE)
}
\arguments{
\item{x}{A vector of file paths.}
\item{first}{Whether to return the first existing path. If \code{TRUE} and no
specified files exist, it will signal an error.}
}
\value{
A vector of existing file paths.
}
\description{
This is a shorthand of \code{x[file.exists(x)]}, and optionally returns the
first existing file path.
}
\examples{
xfun::existing_files(c("foo.txt", system.file("DESCRIPTION", package = "xfun")))
}
xfun/man/rstudio_type.Rd 0000644 0001750 0001750 00000002121 14156162700 015156 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/rstudio.R
\name{rstudio_type}
\alias{rstudio_type}
\title{Type a character vector into the RStudio source editor}
\usage{
rstudio_type(x, pause = function() 0.1, mistake = 0, save = 0)
}
\arguments{
\item{x}{A character vector.}
\item{pause}{A function to return a number in seconds to pause after typing
each character.}
\item{mistake}{The probability of making random mistakes when typing the next
character. A random mistake is a random string typed into the editor and
deleted immediately.}
\item{save}{The probability of saving the document after typing each
character. Note that If a document is not opened from a file, it will never
be saved.}
}
\description{
Use the \pkg{rstudioapi} package to insert characters one by one into the
RStudio source editor, as if they were typed by a human.
}
\examples{
library(xfun)
if (loadable("rstudioapi") && rstudioapi::isAvailable()) {
rstudio_type("Hello, RStudio! xfun::rstudio_type() looks pretty cool!",
pause = function() runif(1, 0, 0.5), mistake = 0.1)
}
}
xfun/man/dir_exists.Rd 0000644 0001750 0001750 00000001277 14156162700 014614 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{dir_exists}
\alias{dir_exists}
\alias{file_exists}
\title{Test the existence of files and directories}
\usage{
dir_exists(x)
file_exists(x)
}
\arguments{
\item{x}{A vector of paths.}
}
\value{
A logical vector.
}
\description{
These are wrapper functions of \code{utils::\link{file_test}()} to test the
existence of directories and files. Note that \code{file_exists()} only tests
files but not directories, which is the main difference between
\code{\link{file.exists}()} in base R. If you use are using the R version
3.2.0 or above, \code{dir_exists()} is the same as \code{\link{dir.exists}()}
in base R.
}
xfun/man/submit_cran.Rd 0000644 0001750 0001750 00000002034 14156162700 014735 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/cran.R
\name{submit_cran}
\alias{submit_cran}
\title{Submit a source package to CRAN}
\usage{
submit_cran(file = pkg_build(), comment = "")
}
\arguments{
\item{file}{The path to the source package tarball. By default, the current
working directory is treated as the package root directory, and
automatically built into a tarball, which is deleted after submission. This
means you should run \code{xfun::submit_cran()} in the root directory of a
package project, unless you want to pass a path explicitly to the
\code{file} argument.}
\item{comment}{Submission comments for CRAN. By default, if a file
\file{cran-comments.md} exists, its content will be read and used as the
comment.}
}
\description{
Build a source package and submit it to CRAN with the \pkg{curl} package.
}
\seealso{
\code{devtools::submit_cran()} does the same job, with a few more
dependencies in addition to \pkg{curl} (such as \pkg{cli});
\code{xfun::submit_cran()} only depends on \pkg{curl}.
}
xfun/man/install_github.Rd 0000644 0001750 0001750 00000001331 14156162700 015436 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/packages.R
\name{install_github}
\alias{install_github}
\title{An alias of \code{remotes::install_github()}}
\usage{
install_github(...)
}
\arguments{
\item{...}{Arguments to be passed to
\code{remotes::\link[remotes]{install_github}()}.}
}
\description{
This alias is to make autocomplete faster via \code{xfun::install_github},
because most \code{remotes::install_*} functions are never what I want. I
only use \code{install_github} and it is inconvenient to autocomplete it,
e.g. \code{install_git} always comes before \code{install_github}, but I
never use it. In RStudio, I only need to type \code{xfun::ig} to get
\code{xfun::install_github}.
}
xfun/man/system3.Rd 0000644 0001750 0001750 00000002004 14156162700 014033 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/command.R
\name{system3}
\alias{system3}
\title{Run \code{system2()} and mark its character output as UTF-8 if appropriate}
\usage{
system3(...)
}
\arguments{
\item{...}{Passed to \code{\link{system2}()}.}
}
\value{
The value returned by \code{system2()}.
}
\description{
This is a wrapper function based on \code{system2()}. If \code{system2()}
returns character output (e.g., with the argument \code{stdout = TRUE}),
check if the output is encoded in UTF-8. If it is, mark it with UTF-8
explicitly.
}
\examples{\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
a = shQuote(c("-e", "print(intToUtf8(c(20320, 22909)))"))
x2 = system2("Rscript", a, stdout = TRUE)
Encoding(x2) # unknown
x3 = xfun::system3("Rscript", a, stdout = TRUE)
# encoding of x3 should be UTF-8 if the current locale is UTF-8
!l10n_info()[["UTF-8"]] || Encoding(x3) == "UTF-8" # should be TRUE
\dontshow{\}) # examplesIf}
}
xfun/man/pkg_attach.Rd 0000644 0001750 0001750 00000007146 14156162700 014545 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/packages.R
\name{pkg_attach}
\alias{pkg_attach}
\alias{pkg_load}
\alias{loadable}
\alias{pkg_available}
\alias{pkg_attach2}
\alias{pkg_load2}
\title{Attach or load packages, and automatically install missing packages if
requested}
\usage{
pkg_attach(
...,
install = FALSE,
message = getOption("xfun.pkg_attach.message", TRUE)
)
pkg_load(..., error = TRUE, install = FALSE)
loadable(pkg, strict = TRUE, new_session = FALSE)
pkg_available(pkg, version = NULL)
pkg_attach2(...)
pkg_load2(...)
}
\arguments{
\item{...}{Package names (character vectors, and must always be quoted).}
\item{install}{Whether to automatically install packages that are not
available using \code{\link{install.packages}()}. Besides \code{TRUE} and
\code{FALSE}, the value of this argument can also be a function to install
packages (\code{install = TRUE} is equivalent to \code{install =
install.packages}), or a character string \code{"pak"} (equivalent to
\code{install = pak::pkg_install}, which requires the \pkg{pak} package).
You are recommended to set a CRAN mirror in the global option \code{repos}
via \code{\link{options}()} if you want to automatically install packages.}
\item{message}{Whether to show the package startup messages (if any startup
messages are provided in a package).}
\item{error}{Whether to signal an error when certain packages cannot be loaded.}
\item{pkg}{A single package name.}
\item{strict}{If \code{TRUE}, use \code{\link{requireNamespace}()} to test if
a package is loadable; otherwise only check if the package is in
\code{\link{.packages}(TRUE)} (this does not really load the package, so it
is less rigorous but on the other hand, it can keep the current R session
clean).}
\item{new_session}{Whether to test if a package is loadable in a new R
session. Note that \code{new_session = TRUE} implies \code{strict = TRUE}.}
\item{version}{A minimal version number. If \code{NULL}, only test if a
package is available and do not check its version.}
}
\value{
\code{pkg_attach()} returns \code{NULL} invisibly. \code{pkg_load()}
returns a logical vector, indicating whether the packages can be loaded.
}
\description{
\code{pkg_attach()} is a vectorized version of \code{\link{library}()} over
the \code{package} argument to attach multiple packages in a single function
call. \code{pkg_load()} is a vectorized version of
\code{\link{requireNamespace}()} to load packages (without attaching them).
The functions \code{pkg_attach2()} and \code{pkg_load2()} are wrappers of
\code{pkg_attach(install = TRUE)} and \code{pkg_load(install = TRUE)},
respectively. \code{loadable()} is an abbreviation of
\code{requireNamespace(quietly = TRUE)}. \code{pkg_available()} tests if a
package with a minimal version is available.
}
\details{
These are convenience functions that aim to solve these common problems: (1)
We often need to attach or load multiple packages, and it is tedious to type
several \code{library()} calls; (2) We are likely to want to install the
packages when attaching/loading them but they have not been installed.
}
\examples{
library(xfun)
pkg_attach("stats", "graphics")
# pkg_attach2('servr') # automatically install servr if it is not installed
(pkg_load("stats", "graphics"))
}
\seealso{
\code{pkg_attach2()} is similar to \code{pacman::p_load()}, but does
not allow non-standard evaluation (NSE) of the \code{...} argument, i.e.,
you must pass a real character vector of package names to it, and all names
must be quoted. Allowing NSE adds too much complexity with too little gain
(the only gain is that it saves your effort in typing two quotes).
}
xfun/man/crandalf_check.Rd 0000644 0001750 0001750 00000004526 14156162700 015346 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/revcheck.R
\name{crandalf_check}
\alias{crandalf_check}
\alias{crandalf_results}
\title{Submit check jobs to crandalf}
\usage{
crandalf_check(pkg, size = 400, jobs = Inf, which = "all")
crandalf_results(pkg, repo = NA, limit = 200, wait = 5 * 60)
}
\arguments{
\item{pkg}{The package name of which the reverse dependencies are to be
checked.}
\item{size}{The number of reverse dependencies to be checked in each job.}
\item{jobs}{The number of jobs to run in Github Actions (by default, all jobs
are submitted, but you can choose to submit the first few jobs).}
\item{which}{The type of dependencies (see \code{\link{rev_check}()}).}
\item{repo}{The crandalf repo on Github (of the form \code{user/repo} such as
\code{"yihui/crandalf"}). Usually you do not need to specify it, unless you
are not calling this function inside the crandalf project, because
\command{gh} should be able to figure out the repo automatically.}
\item{limit}{The maximum of records for \command{gh run list} to retrieve.
You only need a larger number if the check results are very early in the
Github Action history.}
\item{wait}{Number of seconds to wait if not all jobs have been completed on
Github. By default, this function checks the status every 5 minutes until
all jobs are completed. Set \code{wait} to 0 to disable waiting (and throw
an error immediately when any jobs are not completed).}
}
\description{
Check the reverse dependencies of a package using the crandalf service:
\url{https://github.com/yihui/crandalf}. If the number of reverse
dependencies is large, they will be split into batches and pushed to crandalf
one by one.
}
\details{
Due to the time limit of a single job on Github Actions (6 hours), you will
have to split the large number of reverse dependencies into batches and check
them sequentially on Github (at most 5 jobs in parallel). The function
\code{crandalf_check()} does this automatically when necessary. It requires
the \command{git} command to be available.
The function \code{crandalf_results()} fetches check results from Github
after all checks are completed, merge the results, and show a full summary of
check results. It requires \code{gh} (Github CLI:
\url{https://cli.github.com/manual/}) to be installed and you also need to
authenticate with your Github account beforehand.
}
xfun/man/mark_dirs.Rd 0000644 0001750 0001750 00000001265 14156162700 014407 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{mark_dirs}
\alias{mark_dirs}
\title{Mark some paths as directories}
\usage{
mark_dirs(x)
}
\arguments{
\item{x}{Character vector of paths to files and directories.}
}
\description{
Add a trailing backlash to a file path if this is a directory. This is useful
in messages to the console for example to quickly identify directories from
files.
}
\details{
If \code{x} is a vector of relative paths, directory test is done with
path relative to the current working dir. Use \code{xfun::\link{in_dir}()} or
use absolute paths.
}
\examples{
mark_dirs(list.files(find.package("xfun"), full.names = TRUE))
}
xfun/man/split_source.Rd 0000644 0001750 0001750 00000001052 14156162700 015141 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/string.R
\name{split_source}
\alias{split_source}
\title{Split source lines into complete expressions}
\usage{
split_source(x)
}
\arguments{
\item{x}{A character vector of R source code.}
}
\value{
A list of character vectors, and each vector contains a complete R
expression.
}
\description{
Parse the lines of code one by one to find complete expressions in the code,
and put them in a list.
}
\examples{
xfun::split_source(c("if (TRUE) {", "1 + 1", "}", "print(1:5)"))
}
xfun/man/install_dir.Rd 0000644 0001750 0001750 00000001466 14156162700 014743 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/packages.R
\name{install_dir}
\alias{install_dir}
\title{Install a source package from a directory}
\usage{
install_dir(pkg, build = TRUE, build_opts = NULL, install_opts = NULL)
}
\arguments{
\item{pkg}{The package source directory.}
\item{build}{Whether to build a tarball from the source directory. If
\code{FALSE}, run \command{R CMD INSTALL} on the directory directly (note
that vignettes will not be automatically built).}
\item{build_opts}{The options for \command{R CMD build}.}
\item{install_opts}{The options for \command{R CMD INSTALL}.}
}
\value{
Invisible status from \command{R CMD INSTALL}.
}
\description{
Run \command{R CMD build} to build a tarball from a source directory, and run
\command{R CMD INSTALL} to install it.
}
xfun/man/upload_ftp.Rd 0000644 0001750 0001750 00000002660 14156162700 014571 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/command.R
\name{upload_ftp}
\alias{upload_ftp}
\alias{upload_win_builder}
\title{Upload to an FTP server via \command{curl}}
\usage{
upload_ftp(file, server, dir = "")
upload_win_builder(
file = pkg_build(),
version = c("R-devel", "R-release", "R-oldrelease"),
server = c("ftp", "https"),
solaris = pkg_available("rhub")
)
}
\arguments{
\item{file}{Path to a local file.}
\item{server}{The address of the FTP server. For \code{upload_win_builder()},
\code{server = 'https'} means uploading to
\code{'https://win-builder.r-project.org/upload.aspx'}.}
\item{dir}{The remote directory to which the file should be uploaded.}
\item{version}{The R version(s) on win-builder.}
\item{solaris}{Whether to also upload the package to the Rhub server to check
it on Solaris.}
}
\value{
Status code returned from \code{\link{system2}()} or
\code{curl::curl_fetch_memory()}.
}
\description{
The function \code{upload_ftp()} runs the command \command{curl -T file
server} to upload a file to an FTP server if the system command
\command{curl} is available, otherwise it uses the R package \pkg{curl}. The
function \code{upload_win_builder()} uses \code{upload_ftp()} to upload
packages to the win-builder server.
}
\details{
These functions were written mainly to save package developers the trouble of
going to the win-builder web page and uploading packages there manually.
}
xfun/man/file_ext.Rd 0000644 0001750 0001750 00000002340 14156162700 014226 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{file_ext}
\alias{file_ext}
\alias{sans_ext}
\alias{with_ext}
\title{Manipulate filename extensions}
\usage{
file_ext(x)
sans_ext(x)
with_ext(x, ext)
}
\arguments{
\item{x}{A character of file paths.}
\item{ext}{A vector of new extensions. It must be either of length 1, or the
same length as \code{x}.}
}
\value{
A character vector of the same length as \code{x}.
}
\description{
Functions to obtain (\code{file_ext()}), remove (\code{sans_ext()}), and
change (\code{with_ext()}) extensions in filenames.
}
\details{
\code{file_ext()} is similar to \code{tools::\link{file_ext}()}, and
\code{sans_ext()} is similar to \code{tools::\link{file_path_sans_ext}()}.
The main differences are that they treat \code{tar.(gz|bz2|xz)} and
\code{nb.html} as extensions (but functions in the \pkg{tools} package
doesn't allow double extensions by default), and allow characters \code{~}
and \code{#} to be present at the end of a filename.
}
\examples{
library(xfun)
p = c("abc.doc", "def123.tex", "path/to/foo.Rmd", "backup.ppt~", "pkg.tar.xz")
file_ext(p)
sans_ext(p)
with_ext(p, ".txt")
with_ext(p, c(".ppt", ".sty", ".Rnw", "doc", "zip"))
with_ext(p, "html")
}
xfun/man/raw_string.Rd 0000644 0001750 0001750 00000001741 14156162700 014612 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/data-structure.R
\name{raw_string}
\alias{raw_string}
\alias{print.xfun_raw_string}
\title{Print a character vector in its raw form}
\usage{
raw_string(x)
\method{print}{xfun_raw_string}(x, ...)
}
\arguments{
\item{x}{For \code{raw_string()}, a character vector. For the print method,
the \code{raw_string()} object.}
\item{...}{Other arguments (currently ignored).}
}
\description{
The function \code{raw_string()} assigns the class \code{xfun_raw_string} to
the character vector, and the corresponding printing function
\code{print.xfun_raw_string()} uses \code{cat(x, sep = '\n')} to write the
character vector to the console, which will suppress the leading indices
(such as \code{[1]}) and double quotes, and it may be easier to read the
characters in the raw form (especially when there are escape sequences).
}
\examples{
library(xfun)
raw_string(head(LETTERS))
raw_string(c("a \"b\"", "hello\tworld!"))
}
xfun/man/process_file.Rd 0000644 0001750 0001750 00000002245 14156162700 015110 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/io.R
\name{process_file}
\alias{process_file}
\alias{sort_file}
\title{Read a text file, process the text with a function, and write the text back}
\usage{
process_file(file, fun = identity, x = read_utf8(file))
sort_file(..., fun = sort)
}
\arguments{
\item{file}{Path to a text file.}
\item{fun}{A function to process the text.}
\item{x}{The content of the file.}
\item{...}{Arguments to be passed to \code{process_file()}.}
}
\value{
If \code{file} is provided, invisible \code{NULL} (the file is
updated as a side effect), otherwise the processed content (as a character
vector).
}
\description{
Read a text file with the UTF-8 encoding, apply a function to the text, and
write back to the original file.
}
\details{
\code{sort_file()} is an application of \code{process_file()}, with the
processing function being \code{\link{sort}()}, i.e., it sorts the text lines
in a file and write back the sorted text.
}
\examples{
f = tempfile()
xfun::write_utf8("Hello World", f)
xfun::process_file(f, function(x) gsub("World", "woRld", x))
xfun::read_utf8(f) # see if it has been updated
file.remove(f)
}
xfun/man/stringsAsStrings.Rd 0000644 0001750 0001750 00000001320 14156162700 015753 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{stringsAsStrings}
\alias{stringsAsStrings}
\alias{strings_please}
\title{Set the global option \code{\link{options}(stringsAsFactors = FALSE)} inside
a parent function and restore the option after the parent function exits}
\usage{
stringsAsStrings()
strings_please()
}
\description{
This is a shorthand of \code{opts = options(stringsAsFactors = FALSE);
on.exit(options(opts), add = TRUE)}; \code{strings_please()} is an alias of
\code{stringsAsStrings()}.
}
\examples{
f = function() {
xfun::strings_please()
data.frame(x = letters[1:4], y = factor(letters[1:4]))
}
str(f()) # the first column should be character
}
xfun/man/is_abs_path.Rd 0000644 0001750 0001750 00000001324 14156162700 014704 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{is_abs_path}
\alias{is_abs_path}
\alias{is_rel_path}
\title{Test if paths are relative or absolute}
\usage{
is_abs_path(x)
is_rel_path(x)
}
\arguments{
\item{x}{A vector of paths.}
}
\value{
A logical vector.
}
\description{
On Unix, check if the paths start with \file{/} or \file{~} (if they do, they
are absolute paths). On Windows, check if a path remains the same (via
\code{xfun::\link{same_path}()}) if it is prepended with \file{./} (if it
does, it is a relative path).
}
\examples{
xfun::is_abs_path(c("C:/foo", "foo.txt", "/Users/john/", tempdir()))
xfun::is_rel_path(c("C:/foo", "foo.txt", "/Users/john/", tempdir()))
}
xfun/man/cache_rds.Rd 0000644 0001750 0001750 00000014217 14156162700 014350 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/cache.R
\name{cache_rds}
\alias{cache_rds}
\title{Cache the value of an R expression to an RDS file}
\usage{
cache_rds(
expr = { },
rerun = FALSE,
file = "cache.rds",
dir = "cache/",
hash = NULL,
clean = getOption("xfun.cache_rds.clean", TRUE),
...
)
}
\arguments{
\item{expr}{An R expression.}
\item{rerun}{Whether to delete the RDS file, rerun the expression, and save
the result again (i.e., invalidate the cache if it exists).}
\item{file}{The \emph{base} (see Details) cache filename under the directory
specified by the \code{dir} argument. If not specified and this function is
called inside a code chunk of a \pkg{knitr} document (e.g., an R Markdown
document), the default is the current chunk label plus the extension
\file{.rds}.}
\item{dir}{The path of the RDS file is partially determined by
\code{paste0(dir, file)}. If not specified and the \pkg{knitr} package is
available, the default value of \code{dir} is the \pkg{knitr} chunk option
\code{cache.path} (so if you are compiling a \pkg{knitr} document, you do
not need to provide this \code{dir} argument explicitly), otherwise the
default is \file{cache/}. If you do not want to provide a \code{dir} but
simply a valid path to the \code{file} argument, you may use \code{dir =
""}.}
\item{hash}{A \code{list} object that contributes to the MD5 hash of the
cache filename (see Details). It can also take a special character value
\code{"auto"}. Other types of objects are ignored.}
\item{clean}{Whether to clean up the old cache files automatically when
\code{expr} has changed.}
\item{...}{Other arguments to be passed to \code{\link{saveRDS}()}.}
}
\value{
If the cache file does not exist, run the expression and save the
result to the file, otherwise read the cache file and return the value.
}
\description{
Save the value of an expression to a cache file (of the RDS format). Next
time the value is loaded from the file if it exists.
}
\details{
Note that the \code{file} argument does not provide the full cache filename.
The actual name of the cache file is of the form \file{BASENAME_HASH.rds},
where \file{BASENAME} is the base name provided via the \file{file} argument
(e.g., if \code{file = 'foo.rds'}, \code{BASENAME} would be \file{foo}), and
\file{HASH} is the MD5 hash (also called the \sQuote{checksum}) calculated
from the R code provided to the \code{expr} argument and the value of the
\code{hash} argument, which means when the code or the \code{hash} argument
changes, the \file{HASH} string may also change, and the old cache will be
invalidated (if it exists). If you want to find the cache file, look for
\file{.rds} files that contain 32 hexadecimal digits (consisting of 0-9 and
a-z) at the end of the filename.
The possible ways to invalidate the cache are: 1) change the code in
\code{expr} argument; 2) delete the cache file manually or automatically
through the argument \code{rerun = TRUE}; and 3) change the value of the
\code{hash} argument. The first two ways should be obvious. For the third
way, it makes it possible to automatically invalidate the cache based on
changes in certain R objects. For example, when you run \code{cache_rds({ x +
y })}, you may want to invalidate the cache to rerun \code{{ x + y }} when
the value of \code{x} or \code{y} has been changed, and you can tell
\code{cache_rds()} to do so by \code{cache_rds({ x + y }, hash = list(x,
y))}. The value of the argument \code{hash} is expected to be a list, but it
can also take a special value, \code{"auto"}, which means
\code{cache_rds(expr)} will try to automatically figure out the global
variables in \code{expr}, return a list of their values, and use this list as
the actual value of \code{hash}. This behavior is most likely to be what you
really want: if the code in \code{expr} uses an external global variable, you
may want to invalidate the cache if the value of the global variable has
changed. Here a \dQuote{global variable} means a variable not created locally
in \code{expr}, e.g., for \code{cache_rds({ x <- 1; x + y })}, \code{x} is a
local variable, and \code{y} is (most likely to be) a global variable, so
changes in \code{y} should invalidate the cache. However, you know your own
code the best. If you want to be completely sure when to invalidate the
cache, you can always provide a list of objects explicitly rather than
relying on \code{hash = "auto"}.
By default (the argument \code{clean = TRUE}), old cache files will be
automatically cleaned up. Sometimes you may want to use \code{clean = FALSE}
(set the R global option \code{options(xfun.cache_rds.clean = FALSE)} if you
want \code{FALSE} to be the default). For example, you may not have decided
which version of code to use, and you can keep the cache of both versions
with \code{clean = FALSE}, so when you switch between the two versions of
code, it will still be fast to run the code.
}
\note{
Changes in the code in the \code{expr} argument do not necessarily
always invalidate the cache, if the changed code is \code{\link{parse}d} to
the same expression as the previous version of the code. For example, if
you have run \code{cache_rds({Sys.sleep(5);1+1})} before, running
\code{cache_rds({ Sys.sleep( 5 ) ; 1 + 1 })} will use the cache, because
the two expressions are essentially the same (they only differ in white
spaces). Usually you can add/delete white spaces or comments to your code
in \code{expr} without invalidating the cache. See the package vignette
\code{vignette('xfun', package = 'xfun')} for more examples.
When this function is called in a code chunk of a \pkg{knitr} document, you
may not want to provide the filename or directory of the cache file,
because they have reasonable defaults.
Side-effects (such as plots or printed output) will not be cached. The
cache only stores the last value of the expression in \code{expr}.
}
\examples{
f = tempfile() # the cache file
compute = function(...) {
res = xfun::cache_rds({
Sys.sleep(1)
1:10
}, file = f, dir = "", ...)
res
}
compute() # takes one second
compute() # returns 1:10 immediately
compute() # fast again
compute(rerun = TRUE) # one second to rerun
compute()
file.remove(f)
}
xfun/man/from_root.Rd 0000644 0001750 0001750 00000002235 14156162700 014440 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{from_root}
\alias{from_root}
\title{Get the relative path of a path in a project relative to the current working
directory}
\usage{
from_root(..., root = proj_root(), error = TRUE)
}
\arguments{
\item{...}{A character vector of path components \emph{relative to the root
directory of the project}.}
\item{root}{The root directory of the project.}
\item{error}{Whether to signal an error if the path cannot be converted to a
relative path.}
}
\value{
A relative path, or an error when the project root directory cannot
be determined or the conversion failed and \code{error = TRUE}.
}
\description{
First compose an absolute path using the project root directory and the
relative path components, i.e., \code{\link{file.path}(root, ...)}. Then
convert it to a relative path with \code{\link{relative_path}()}, which is
relative to the current working directory.
}
\details{
This function was inspired by \code{here::here()}, and the major difference
is that it returns a relative path by default, which is more portable.
}
\examples{
\dontrun{
xfun::from_root("data", "mtcars.csv")
}
}
xfun/man/try_silent.Rd 0000644 0001750 0001750 00000000602 14156162700 014622 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{try_silent}
\alias{try_silent}
\title{Try to evaluate an expression silently}
\usage{
try_silent(expr)
}
\arguments{
\item{expr}{An R expression.}
}
\description{
An abbreviation of \code{try(silent = TRUE)}.
}
\examples{
library(xfun)
z = try_silent(stop("Wrong!"))
inherits(z, "try-error")
}
xfun/man/normalize_path.Rd 0000644 0001750 0001750 00000000677 14156162700 015456 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{normalize_path}
\alias{normalize_path}
\title{Normalize paths}
\usage{
normalize_path(x, winslash = "/", must_work = FALSE)
}
\arguments{
\item{x, winslash, must_work}{Arguments passed to
\code{\link{normalizePath}()}.}
}
\description{
A wrapper function of \code{normalizePath()} with different defaults.
}
\examples{
library(xfun)
normalize_path("~")
}
xfun/man/proc_kill.Rd 0000644 0001750 0001750 00000001200 14156162700 014377 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/command.R
\name{proc_kill}
\alias{proc_kill}
\title{Kill a process and (optionally) all its child processes}
\usage{
proc_kill(pid, recursive = TRUE, ...)
}
\arguments{
\item{pid}{The process ID.}
\item{recursive}{Whether to kill the child processes of the process.}
\item{...}{Arguments to be passed to \code{\link{system2}()} to run the
command to kill the process.}
}
\value{
The status code returned from \code{system2()}.
}
\description{
Run the command \command{taskkill /f /pid} on Windows and \command{kill} on
Unix, respectively, to kill a process.
}
xfun/man/retry.Rd 0000644 0001750 0001750 00000001667 14156162700 013607 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{retry}
\alias{retry}
\title{Retry calling a function for a number of times}
\usage{
retry(fun, ..., .times = 3, .pause = 5)
}
\arguments{
\item{fun}{A function.}
\item{...}{Arguments to be passed to the function.}
\item{.times}{The number of times.}
\item{.pause}{The number of seconds to wait before the next attempt.}
}
\description{
If the function returns an error, retry it for the specified number of
times, with a pause between attempts.
}
\details{
One application of this function is to download a web resource. Since the
download might fail sometimes, you may want to retry it for a few more times.
}
\examples{\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
# read the Github releases info of the repo yihui/xfun
xfun::retry(xfun::github_releases, "yihui/xfun")
\dontshow{\}) # examplesIf}
}
xfun/man/do_once.Rd 0000644 0001750 0001750 00000003132 14156162700 014035 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/session.R
\name{do_once}
\alias{do_once}
\title{Perform a task once in an R session}
\usage{
do_once(
task,
option,
hint = c("You will not see this message again in this R session.",
"If you never want to see this message,",
sprintf("you may set options(\%s = FALSE) in your .Rprofile.", option))
)
}
\arguments{
\item{task}{Any R code expression to be evaluated once to perform a task,
e.g., \code{warning('Danger!')} or \code{message('Today is ', Sys.Date())}.}
\item{option}{An R option name. This name should be as unique as possible in
\code{\link{options}()}. After the task has been successfully performed,
this option will be set to \code{FALSE} in the current R session, to
prevent the task from being performed again the next time when
\code{do_once()} is called.}
\item{hint}{A character vector to provide a hint to users on how not to
perform the task or see the message again in the current R session. Set
\code{hint = ""} if you do not want to provide the hint.}
}
\value{
The value returned by the \code{task}, invisibly.
}
\description{
Perform a task once in an R session, e.g., emit a message or warning. Then
give users an optional hint on how not to perform this task at all.
}
\examples{
do_once(message("Today's date is ", Sys.Date()), "xfun.date.reminder")
# if you run it again, it will not emit the message again
do_once(message("Today's date is ", Sys.Date()), "xfun.date.reminder")
do_once({
Sys.sleep(2)
1 + 1
}, "xfun.task.1plus1")
do_once({
Sys.sleep(2)
1 + 1
}, "xfun.task.1plus1")
}
xfun/man/is_web_path.Rd 0000644 0001750 0001750 00000000750 14156162700 014716 0 ustar nilesh nilesh % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/paths.R
\name{is_web_path}
\alias{is_web_path}
\title{Test if a path is a web path}
\usage{
is_web_path(x)
}
\arguments{
\item{x}{A vector of paths.}
}
\value{
A logical vector.
}
\description{
Check if a path starts with \file{http://} or \file{https://} or
\file{ftp://} or \file{ftps://}.
}
\examples{
xfun::is_web_path("https://www.r-project.org") # TRUE
xfun::is_web_path("www.r-project.org") # FALSE
}
xfun/src/ 0000755 0001750 0001750 00000000000 14156200274 012154 5 ustar nilesh nilesh xfun/src/Makevars 0000644 0001750 0001750 00000000020 13673475145 013656 0 ustar nilesh nilesh CXX_STD = CXX11
xfun/src/base64.c 0000644 0001750 0001750 00000014322 13732647320 013414 0 ustar nilesh nilesh #include
Published: ')
if (length(i) == 0) stop('Cannot find the publishing date from ', u)
d = as.Date(gsub('?td>', '', x[i[1] + 1]))
x = try(readLines(u <- sprintf('https://cran.r-project.org/src/contrib/Archive/%s/', p)))
if (inherits(x, 'try-error')) {
info[[p]] = d; next
}
r = '.+(\\d{4,}-\\d{2}-\\d{2}) .+'
d = c(d, as.Date(gsub(r, '\\1', grep(r, x, value = TRUE))))
info[[p]] = sort(d, decreasing = TRUE)
}
if (full) info else sort(do.call(c, lapply(info, `[`, 1)), decreasing = TRUE)
}
# return packages that haven't been updated for X days, and can be updated on CRAN
cran_updatable = function(days = 90, maintainer = 'Yihui Xie') {
info = cran_pkg_dates(TRUE, maintainer)
flag = unlist(lapply(info, function(d) {
sum(d > Sys.Date() - 180) < 6 && d[1] < Sys.Date() - days
}))
names(which(flag))
}
#' Some utility functions for checking packages
#'
#' Miscellaneous utility functions to obtain information about the package
#' checking environment.
#' @export
#' @keywords internal
is_R_CMD_check = function() {
!is.na(check_package_name()) || tolower(Sys.getenv('_R_CHECK_LICENSE_')) == 'true'
}
#' @rdname is_R_CMD_check
#' @export
is_CRAN_incoming = function() {
isTRUE(as.logical(Sys.getenv('_R_CHECK_CRAN_INCOMING_REMOTE_')))
}
#' @rdname is_R_CMD_check
#' @export
check_package_name = function() {
Sys.getenv('_R_CHECK_PACKAGE_NAME_', NA)
}
# is R CMD check running on a package that has a version lower or equal to `version`?
#' @rdname is_R_CMD_check
#' @export
check_old_package = function(name, version) {
if (is.na(pkg <- check_package_name()) || pkg != name) return(FALSE)
tryCatch(packageVersion(name) <= version, error = function(e) FALSE)
}
# return package maintainers (with email addresses)
pkg_maintainers = function(pkgs) {
info = tools::CRAN_package_db()
info = info[match(pkgs, info$Package), c('Package', 'Maintainer')]
setNames(info$Maintainer, info$Package)
}
#' Submit a source package to CRAN
#'
#' Build a source package and submit it to CRAN with the \pkg{curl} package.
#' @param file The path to the source package tarball. By default, the current
#' working directory is treated as the package root directory, and
#' automatically built into a tarball, which is deleted after submission. This
#' means you should run \code{xfun::submit_cran()} in the root directory of a
#' package project, unless you want to pass a path explicitly to the
#' \code{file} argument.
#' @param comment Submission comments for CRAN. By default, if a file
#' \file{cran-comments.md} exists, its content will be read and used as the
#' comment.
#' @seealso \code{devtools::submit_cran()} does the same job, with a few more
#' dependencies in addition to \pkg{curl} (such as \pkg{cli});
#' \code{xfun::submit_cran()} only depends on \pkg{curl}.
#' @export
submit_cran = function(file = pkg_build(), comment = '') {
# if the tarball is automatically created, delete it after submission
if (missing(file)) on.exit(file.remove(file), add = TRUE)
# read the maintainer's name/email
dir_create(d <- tempfile())
on.exit(unlink(d, recursive = TRUE), add = TRUE)
desc = file.path(gsub('_.*', '', basename(file)), 'DESCRIPTION')
untar(file, desc, exdir = d)
info = read.dcf(file.path(d, desc), fields = 'Maintainer')[1, 1]
info = unlist(strsplit(info, '( <|>)'))
# read submission comments from cran-comments.md if exists
if (missing(comment) && file_exists(f <- 'cran-comments.md')) {
comment = file_string(f)
}
params = list(
uploaded_file = curl::form_file(file), name = info[1], email = info[2],
upload = 'Upload package'
)
params$comment = if (length(comment)) comment
server = 'https://xmpalantir.wu.ac.at/cransubmit/index2.php'
# submit the form
h = curl::new_handle()
curl::handle_setform(h, .list = params)
res = curl::curl_fetch_memory(server, h)
# find the pkg_id from the response page
id = grep_sub(
'(.*Step 3<', rawToChar(res$content))) message(
'The package has been submitted. Please confirm the submission in email: ',
params$email
) else message('The submission may be unsuccessful.')
}
xfun/R/paths.R 0000644 0001750 0001750 00000047060 14145505647 013051 0 ustar nilesh nilesh #' Manipulate filename extensions
#'
#' Functions to obtain (\code{file_ext()}), remove (\code{sans_ext()}), and
#' change (\code{with_ext()}) extensions in filenames.
#'
#' \code{file_ext()} is similar to \code{tools::\link{file_ext}()}, and
#' \code{sans_ext()} is similar to \code{tools::\link{file_path_sans_ext}()}.
#' The main differences are that they treat \code{tar.(gz|bz2|xz)} and
#' \code{nb.html} as extensions (but functions in the \pkg{tools} package
#' doesn't allow double extensions by default), and allow characters \code{~}
#' and \code{#} to be present at the end of a filename.
#' @param x A character of file paths.
#' @export
#' @return A character vector of the same length as \code{x}.
#' @examples library(xfun)
#' p = c('abc.doc', 'def123.tex', 'path/to/foo.Rmd', 'backup.ppt~', 'pkg.tar.xz')
#' file_ext(p); sans_ext(p); with_ext(p, '.txt')
#' with_ext(p, c('.ppt', '.sty', '.Rnw', 'doc', 'zip')); with_ext(p, 'html')
file_ext = function(x) {
ext = character(length(x))
i = grep(reg_path, x)
ext[i] = sub(reg_path, '\\3', x[i])
ext
}
#' @rdname file_ext
#' @export
sans_ext = function(x) {
sub(reg_path, '\\1', x)
}
#' @param ext A vector of new extensions. It must be either of length 1, or the
#' same length as \code{x}.
#' @rdname file_ext
#' @export
with_ext = function(x, ext) {
if (anyNA(ext)) stop("NA is not allowed in 'ext'")
n1 = length(x); n2 = length(ext)
if (n1 * n2 == 0) return(x)
i = !grepl('^[.]', ext) & ext != ''
ext[i] = paste0('.', ext[i])
if (all(ext == '')) ext = ''
r = sub('[$]$', '?$', reg_ext) # make extensions in 'x' optional
if (length(ext) == 1) return(sub(r, ext, x))
if (n1 > 1 && n1 != n2) stop("'ext' must be of the same length as 'x'")
mapply(sub, r, ext, x, USE.NAMES = FALSE)
}
# regex to extract base path and extension from a file path
reg_ext = '([.](([[:alnum:]]+|tar[.](gz|bz2|xz)|nb[.]html)[~#]?))$'
reg_path = paste0('^(.*?)', reg_ext)
#' Normalize paths
#'
#' A wrapper function of \code{normalizePath()} with different defaults.
#' @param x,winslash,must_work Arguments passed to
#' \code{\link{normalizePath}()}.
#' @export
#' @examples library(xfun)
#' normalize_path('~')
normalize_path = function(x, winslash = '/', must_work = FALSE) {
res = normalizePath(x, winslash = winslash, mustWork = must_work)
if (is_windows()) res[is.na(x)] = NA
res
}
#' Test if two paths are the same after they are normalized
#'
#' Compare two paths after normalizing them with the same separator (\code{/}).
#' @param p1,p2 Two vectors of paths.
#' @param ... Arguments to be passed to \code{\link{normalize_path}()}.
#' @export
#' @examples library(xfun)
#' same_path('~/foo', file.path(Sys.getenv('HOME'), 'foo'))
same_path = function(p1, p2, ...) {
normalize_path(p1, ...) == normalize_path(p2, ...)
}
#' Find file paths that exist
#'
#' This is a shorthand of \code{x[file.exists(x)]}, and optionally returns the
#' first existing file path.
#' @param x A vector of file paths.
#' @param first Whether to return the first existing path. If \code{TRUE} and no
#' specified files exist, it will signal an error.
#' @return A vector of existing file paths.
#' @export
#' @examples
#' xfun::existing_files(c('foo.txt', system.file('DESCRIPTION', package='xfun')))
existing_files = function(x, first = FALSE) {
x = x[file_exists(x)]
if (!first) return(x)
x = head(x, 1)
if (length(x) != 1) stop('None of the specified files exist.')
x
}
#' Return the (possible) root directory of a project
#'
#' Given a path of a file (or dir) in a potential project (e.g., an R package or
#' an RStudio project), return the path to the project root directory.
#'
#' The search for the root directory is performed by a series of tests,
#' currently including looking for a \file{DESCRIPTION} file that contains
#' \code{Package: *} (which usually indicates an R package), and a
#' \file{*.Rproj} file that contains \code{Version: *} (which usually indicates
#' an RStudio project). If files with the expected patterns are not found in the
#' initial directory, the search will be performed recursively in upper-level
#' directories.
#' @param path The initial path to start the search. If it is a file path, its
#' parent directory will be used.
#' @param rules A matrix of character strings of two columns: the first column
#' contains regular expressions to look for filenames that match the patterns,
#' and the second column contains regular expressions to match the content of
#' the matched files. The regular expression can be an empty string, meaning
#' that it will match anything.
#' @return Path to the root directory if found, otherwise \code{NULL}.
#' @export
#' @note This function was inspired by the \pkg{rprojroot} package, but is much
#' less sophisticated. It is a rather simple function designed to be used in
#' some of packages that I maintain, and may not meet the need of general
#' users until this note is removed in the future (which should be unlikely).
#' If you are sure that you are working on the types of projects mentioned in
#' the \sQuote{Details} section, this function may be helpful to you,
#' otherwise please consider using \pkg{rprojroot} instead.
proj_root = function(path = './', rules = root_rules) {
path = normalize_path(path)
dir = if (dir_exists(path)) path else dirname(path)
if (same_path(dir, file.path(dir, '..'))) return()
if (is.null(dim(rules))) dim(rules) = c(1, length(rules))
for (i in seq_len(nrow(rules))) {
file = rules[i, 1]; pattern = rules[i, 2]
for (f in list.files(dir, file, full.names = TRUE)) {
if (pattern == '' || length(grep(pattern, read_utf8(f)))) return(dir)
}
}
proj_root(dirname(dir), rules)
}
#' @rdname proj_root
#' @export
root_rules = matrix(c(
'^DESCRIPTION$', '^Package: ',
'.+[.]Rproj$', '^Version: '
), ncol = 2, byrow = TRUE, dimnames = list(NULL, c('file', 'pattern')))
#' Get the relative path of a path relative to a directory
#'
#' Given a directory, return the relative path that is relative to this
#' directory. For example, the path \file{foo/bar.txt} relative to the directory
#' \file{foo/} is \file{bar.txt}, and the path \file{/a/b/c.txt} relative to
#' \file{/d/e/} is \file{../../a/b/c.txt}.
#' @param dir Path to a directory.
#' @param x A vector of paths to be converted to relative paths.
#' @param use.. Whether to use double-dots (\file{..}) in the relative path. A
#' double-dot indicates the parent directory (starting from the directory
#' provided by the \code{dir} argument).
#' @param error Whether to signal an error if a path cannot be converted to a
#' relative path.
#' @return A vector of relative paths if the conversion succeeded; otherwise the
#' original paths when \code{error = FALSE}, and an error when \code{error =
#' TRUE}.
#' @export
#' @examples
#' xfun::relative_path('foo/bar.txt', 'foo/')
#' xfun::relative_path('foo/bar/a.txt', 'foo/haha/')
#' xfun::relative_path(getwd())
relative_path = function(x, dir = '.', use.. = TRUE, error = TRUE) {
res = x
for (i in seq_along(x)) res[i] = relative_path_one(x[i], dir, use.., error)
res
}
relative_path_one = function(x, dir, use.., error) {
# on Windows, if a relative path doesn't exist, normalizePath() will use
# getwd() as its parent dir; however, normalizePath() just returns the
# relative path on *nix, and we have to assume it's relative to getwd()
abs_path = function(p) {
if (!file.exists(p) && is_unix() && is_rel_path(p)) p = file.path(getwd(), p)
normalize_path(p)
}
p = abs_path(x); n1 = nchar(p)
if ((n1 <- nchar(p)) == 0) return(x) # not sure what you mean
d = abs_path(dir); n2 = nchar(d)
if (is_sub_path(p, d, n2)) {
p2 = get_subpath(p, n1, n2)
if (p2 == '') p2 = '.' # if the subpath is empty, it means the current dir
return(p2)
}
if (!use..) {
if (error) stop("When use.. = FALSE, the path 'x' must be under the 'dir'")
return(x)
}
s = '../'; d1 = d
while (!is_sub_path(p, d2 <- dirname(d1))) {
if (same_path(d1, d2)) {
if (error) stop(
"The path 'x' cannot be converted to a relative path to 'dir'. ",
"Perhaps they are on different volumes of the disk."
)
return(x)
}
s = paste0('../', s)
d1 = d2 # go to one level up
}
paste0(s, get_subpath(p, n1, nchar(d2)))
}
#' Test if a path is a subpath of a dir
#'
#' Check if the path starts with the dir path.
#' @inheritParams is_abs_path
#' @param dir A vector of directory paths.
#' @param n The length of \code{dir} paths.
#' @return A logical vector.
#' @note You may want to normalize the values of the \code{x} and \code{dir}
#' arguments first (with \code{xfun::\link{normalize_path}()}), to make sure
#' the path separators are consistent.
#' @export
#' @examples
#' xfun::is_sub_path('a/b/c.txt', 'a/b') # TRUE
#' xfun::is_sub_path('a/b/c.txt', 'd/b') # FALSE
#' xfun::is_sub_path('a/b/c.txt', 'a\\b') # FALSE (even on Windows)
is_sub_path = function(x, dir, n = nchar(dir)) substr(x, 1, n) == dir
# remove the first n2 characters and the possible / from the path
get_subpath = function(p, n1, n2) {
p = substr(p, n2 + 1, n1)
sub('^/', '', p)
}
#' Test if paths are relative or absolute
#'
#' On Unix, check if the paths start with \file{/} or \file{~} (if they do, they
#' are absolute paths). On Windows, check if a path remains the same (via
#' \code{xfun::\link{same_path}()}) if it is prepended with \file{./} (if it
#' does, it is a relative path).
#' @param x A vector of paths.
#' @return A logical vector.
#' @export
#' @examples
#' xfun::is_abs_path(c('C:/foo', 'foo.txt', '/Users/john/', tempdir()))
#' xfun::is_rel_path(c('C:/foo', 'foo.txt', '/Users/john/', tempdir()))
is_abs_path = function(x) {
if (is_unix()) grepl('^[/~]', x) else !same_path(x, file.path('.', x))
}
#' @rdname is_abs_path
#' @export
is_rel_path = function(x) !is_abs_path(x)
#' Test if a path is a web path
#'
#' Check if a path starts with \file{http://} or \file{https://} or
#' \file{ftp://} or \file{ftps://}.
#' @inheritParams is_abs_path
#' @return A logical vector.
#' @export
#' @examples
#' xfun::is_web_path('https://www.r-project.org') # TRUE
#' xfun::is_web_path('www.r-project.org') # FALSE
is_web_path = function(x) {
grepl('^(f|ht)tps?://', x)
}
#' Get the relative path of a path in a project relative to the current working
#' directory
#'
#' First compose an absolute path using the project root directory and the
#' relative path components, i.e., \code{\link{file.path}(root, ...)}. Then
#' convert it to a relative path with \code{\link{relative_path}()}, which is
#' relative to the current working directory.
#'
#' This function was inspired by \code{here::here()}, and the major difference
#' is that it returns a relative path by default, which is more portable.
#' @param ... A character vector of path components \emph{relative to the root
#' directory of the project}.
#' @param root The root directory of the project.
#' @param error Whether to signal an error if the path cannot be converted to a
#' relative path.
#' @return A relative path, or an error when the project root directory cannot
#' be determined or the conversion failed and \code{error = TRUE}.
#' @export
#' @examples
#' \dontrun{
#' xfun::from_root('data', 'mtcars.csv')
#' }
from_root = function(..., root = proj_root(), error = TRUE) {
if (is.null(root)) stop('Cannot determin the root directory of the current project.')
p = file.path(root, ..., fsep = '/')
relative_path(p, error = error)
}
#' Find a file or directory under a root directory
#'
#' Given a path, try to find it recursively under a root directory. The input
#' path can be an incomplete path, e.g., it can be a base filename, and
#' \code{magic_path()} will try to find this file under subdirectories.
#' @param ... A character vector of path components.
#' @param root The root directory under which to search for the path. If
#' \code{NULL}, the current working directory is used.
#' @param relative Whether to return a relative path.
#' @param error Whether to signal an error if the path is not found, or multiple
#' paths are found.
#' @param message Whether to emit a message when multiple paths are found and
#' \code{error = FALSE}.
#' @param n_dirs The number of subdirectories to recursively search. The
#' recursive search may be time-consuming when there are a large number of
#' subdirectories under the root directory. If you really want to search for
#' all subdirectories, you may try \code{n_dirs = Inf}.
#' @return The path found under the root directory, or an error when \code{error
#' = TRUE} and the path is not found (or multiple paths are found).
#' @export
#' @examples
#' \dontrun{
#' xfun::magic_path('mtcars.csv') # find any file that has the base name mtcars.csv
#' }
magic_path = function(
..., root = proj_root(), relative = TRUE, error = TRUE,
message = getOption('xfun.magic_path.message', TRUE),
n_dirs = getOption('xfun.magic_path.n_dirs', 10000)
) {
if (file.exists(p <- file.path(...))) return(p)
if (is.null(root)) root = getwd()
nd = 0
# find a path 'f' recursively under a directory 'd'
find_it = function(f, d) {
if (nd > n_dirs) {
if (error) stop(
'Failed to find the path under ', n_dirs, ' subdirectories. If you want ',
'to search for the path in more subdirectories, increase the value of ',
"the 'n_dirs' argument of magic_path()."
)
return(p)
}
ds = list.files(d, full.names = TRUE)
ds = ds[dir_exists(ds)]
if ((n1 <- length(ds)) == 0) return()
nd <<- nd + n1
fs = file.path(ds, f)
fs = fs[file.exists(fs)]
if ((n2 <- length(fs)) == 1) return(fs)
if (n2 > 1) {
msg = c(
'Found more than one path containg the input path "', f, '":\n\n',
paste('*', fs, collapse = '\n')
)
if (error) stop(msg)
if (message) base::message(msg, '\n\nReturned the first one.')
return(fs[1])
}
# look into subdirectories one by one
for (i in seq_len(n1)) {
fs = find_it(f, file.path(ds[i]))
if (length(fs)) return(fs)
}
}
f = find_it(p, root)
if (is.null(f)) {
if (error) stop('Could not find the path "', p, '" in any subdirectories.')
p
} else {
if (relative) relative_path(f, error = error) else f
}
}
#' Test the existence of files and directories
#'
#' These are wrapper functions of \code{utils::\link{file_test}()} to test the
#' existence of directories and files. Note that \code{file_exists()} only tests
#' files but not directories, which is the main difference between
#' \code{\link{file.exists}()} in base R. If you use are using the R version
#' 3.2.0 or above, \code{dir_exists()} is the same as \code{\link{dir.exists}()}
#' in base R.
#' @param x A vector of paths.
#' @export
#' @return A logical vector.
dir_exists = function(x) file_test('-d', x)
#' @rdname dir_exists
#' @export
file_exists = function(x) file_test('-f', x)
#' Create a directory recursively by default
#'
#' First check if a directory exists. If it does, return \code{TRUE}, otherwise
#' create it with \code{\link{dir.create}(recursive = TRUE)} by default.
#' @param x A path name.
#' @param recursive Whether to create all directory components in the path.
#' @param ... Other arguments to be passed to \code{\link{dir.create}()}.
#' @return A logical value indicating if the directory either exists or is
#' successfully created.
#' @export
dir_create = function(x, recursive = TRUE, ...) {
dir_exists(x) || dir.create(x, recursive = recursive)
}
#' Rename files with a sequential numeric prefix
#'
#' Rename a series of files and add an incremental numeric prefix to the
#' filenames. For example, files \file{a.txt}, \file{b.txt}, and \file{c.txt}
#' can be renamed to \file{1-a.txt}, \file{2-b.txt}, and \file{3-c.txt}.
#' @param pattern A regular expression for \code{\link{list.files}()} to obtain
#' the files to be renamed. For example, to rename \code{.jpeg} files, use
#' \code{pattern = "[.]jpeg$"}.
#' @param format The format for the numeric prefix. This is passed to
#' \code{\link{sprintf}()}. The default format is \code{"\%0Nd"} where \code{N
#' = floor(log10(n)) + 1} and \code{n} is the number of files, which means the
#' prefix may be padded with zeros. For example, if there are 150 files to be
#' renamed, the format will be \code{"\%03d"} and the prefixes will be
#' \code{001}, \code{002}, ..., \code{150}.
#' @param replace Whether to remove existing numeric prefixes in filenames.
#' @param start The starting number for the prefix (it can start from 0).
#' @param dry_run Whether to not really rename files. To be safe, the default is
#' \code{TRUE}. If you have looked at the new filenames and are sure the new
#' names are what you want, you may rerun \code{rename_seq()} with
#' \code{dry_run = FALSE)} to actually rename files.
#' @return A named character vector. The names are original filenames, and the
#' vector itself is the new filenames.
#' @export
#' @examples xfun::rename_seq()
#' xfun::rename_seq('[.](jpeg|png)$', format = '%04d')
rename_seq = function(
pattern = '^[0-9]+-.+[.]Rmd$', format = 'auto', replace = TRUE, start = 1,
dry_run = TRUE
) {
n = length(files <- list.files('.', pattern))
if (n == 0) return(files)
files2 = if (replace) sub('^[0-9]+-*', '', files) else files
if (format == 'auto') format = paste0('%0', floor(log10(n)) + 1, 'd')
files2 = paste(sprintf(format, seq_len(n) + start - 1), files2, sep = '-')
if (!dry_run) file.rename(files, files2)
structure(setNames(files2, files), class = 'xfun_rename_seq')
}
#' @export
print.xfun_rename_seq = function(x, ...) {
x = unclass(x)
tab = data.frame(original = names(x), ' ' = '->', new = unname(x), check.names = FALSE)
if (loadable('knitr')) tab = knitr::kable(tab, 'simple')
print(tab)
}
# return path to R's svg logo if it exists, otherwise return the jpg logo; or
# specify a regex to match the logo path, e.g., ext = 'jpg$'
R_logo = function(ext = NULL) {
x = file.path(R.home('doc'), 'html', c('Rlogo.svg', 'logo.jpg'))
if (!is.null(ext)) x = grep(ext, x, value = TRUE)
existing_files(x, first = TRUE)
}
#' Extract filenames from a URLs
#'
#' Get the base names of URLs via \code{\link{basename}()}, and remove the
#' possible query parameters or hash from the names.
#' @param x A character vector of URLs.
#' @return A character vector of filenames at the end of URLs.
#' @export
#' @examples
#' xfun::url_filename('https://yihui.org/images/logo.png')
#' xfun::url_filename('https://yihui.org/index.html')
#' xfun::url_filename('https://yihui.org/index.html?foo=bar')
#' xfun::url_filename('https://yihui.org/index.html#about')
url_filename = function(x) {
gsub('[?#].*$', '', basename(x)) # remove query/hash from url
}
#' Delete an empty directory
#'
#' Use \code{list.file()} to check if there are any files or subdirectories
#' under a directory. If not, delete this empty directory.
#' @param dir Path to a directory. If \code{NULL} or the directory does not
#' exist, no action will be performed.
#' @export
del_empty_dir = function(dir) {
if (is.null(dir) || !dir_exists(dir)) return()
files = list.files(dir, all.files = TRUE, no.. = TRUE)
if (length(files) == 0) unlink(dir, recursive = TRUE)
}
#' Mark some paths as directories
#'
#' Add a trailing backlash to a file path if this is a directory. This is useful
#' in messages to the console for example to quickly identify directories from
#' files.
#'
#' If \code{x} is a vector of relative paths, directory test is done with
#' path relative to the current working dir. Use \code{xfun::\link{in_dir}()} or
#' use absolute paths.
#'
#' @param x Character vector of paths to files and directories.
#' @examples
#' mark_dirs(list.files(find.package("xfun"), full.names = TRUE))
#' @export
mark_dirs = function(x) {
i = dir_exists(x) & !grepl("/$", x)
x[i] = paste0(x[i], "/")
x
}
xfun/R/encoding.R 0000644 0001750 0001750 00000002520 14105542162 013475 0 ustar nilesh nilesh #' Try to use the system native encoding to represent a character vector
#'
#' Apply \code{enc2native()} to the character vector, and check if
#' \code{enc2utf8()} can convert it back without a loss. If it does, return
#' \code{enc2native(x)}, otherwise return the original vector with a warning.
#' @param x A character vector.
#' @note On platforms that supports UTF-8 as the native encoding
#' (\code{\link{l10n_info}()[['UTF-8']]} returns \code{TRUE}), the conversion
#' will be skipped.
#' @export
#' @examples
#' library(xfun)
#' s = intToUtf8(c(20320, 22909))
#' Encoding(s)
#'
#' s2 = native_encode(s)
#' Encoding(s2)
native_encode = function(x) {
if (isTRUE(l10n_info()[['UTF-8']])) return(x)
if (identical(enc2utf8(x2 <- enc2native(x)), x)) return(x2)
warning('The character vector cannot be represented in the native encoding')
x
}
#' Check if a character vector consists of entirely ASCII characters
#'
#' Converts the encoding of a character vector to \code{'ascii'}, and check if
#' the result is \code{NA}.
#' @param x A character vector.
#' @return A logical vector indicating whether each element of the character
#' vector is ASCII.
#' @export
#' @examples library(xfun)
#' is_ascii(letters) # yes
#' is_ascii(intToUtf8(8212)) # no
is_ascii = function(x) {
out = !is.na(iconv(x, to = 'ascii'))
out[is.na(x)] = NA
out
}
xfun/R/image.R 0000644 0001750 0001750 00000012663 14133423115 012777 0 ustar nilesh nilesh # add a border to an image via ImageMagick
add_border = function(input, pixels = 1, color = 'black', output) {
input = normalizePath(input)
if (missing(output))
output = paste0(sans_ext(input), '-output.', file_ext(input))
system2('convert', shQuote(c(
input, '-shave', paste(pixels, pixels, sep = 'x'), '-bordercolor', color,
'-border', pixels, output)
))
optipng(dirname(output))
}
#' Use the Tinify API to compress PNG and JPEG images
#'
#' Compress PNG/JPEG images with \samp{api.tinify.com}, and download the
#' compressed images. This function requires R packages \pkg{curl} and
#' \pkg{jsonlite}.
#'
#' You are recommended to set the API key in \file{.Rprofile} or
#' \file{.Renviron}. After that, the only required argument of this function is
#' \code{input}. If the original images can be overwritten by the compressed
#' images, you may either use \code{output = identity}, or set the value of the
#' \code{history} argument in \file{.Rprofile} or \file{.Renviron}.
#' @param input A vector of input paths of images.
#' @param output A vector of output paths or a function that takes \code{input}
#' and returns a vector of output paths (e.g., \code{output = \link{identity}}
#' means \code{output = input}). By default, if the \code{history} argument is
#' not a provided, \code{output} is \code{input} with a suffix \code{-min}
#' (e.g., when \code{input = 'foo.png'}, \code{output = 'foo-min.png'}),
#' otherwise \code{output} is the same as \code{input}, which means the
#' original image files will be overwritten.
#' @param quiet Whether to suppress detailed information about the compression,
#' which is of the form \samp{input.png (10 Kb) ==> output.png (5 Kb, 50\%);
#' compression count: 42}. The percentage after \code{output.png} stands for
#' the compression ratio, and the compression count shows the number of
#' compressions used for the current month.
#' @param force Whether to compress an image again when it appears to have been
#' compressed before. This argument only makes sense when the \code{history}
#' argument is provided.
#' @param key The Tinify API key. It can be set via either the global option
#' \code{xfun.tinify.key} (you may set it in \file{~/.Rprofile}) or the
#' environment variable \code{R_XFUN_TINIFY_KEY} (you may set it in
#' \file{~/.Renviron}).
#' @param history Path to a history file to record the MD5 checksum of
#' compressed images. If the checksum of an expected output image exists in
#' this file and \code{force = FALSE}, the compression will be skipped. This
#' can help you avoid unnecessary API calls.
#' @return The output file paths.
#' @references Tinify API: \url{https://tinypng.com/developers}.
#' @seealso The \pkg{tinieR} package (\url{https://github.com/jmablog/tinieR/})
#' is a more comprehensive implementation of the Tinify API, whereas
#' \code{xfun::tinify()} has only implemented the feature of shrinking images.
#' @export
#' @examplesIf interactive()
#' f = file.path(R.home('doc'), 'html', 'logo.jpg')
#' xfun::tinify(f) # remember to set the API key before trying this
tinify = function(
input, output, quiet = FALSE, force = FALSE,
key = getOption('xfun.tinify.key', Sys.getenv('R_XFUN_TINIFY_KEY')),
history = getOption('xfun.tinify.history', Sys.getenv('R_XFUN_TINIFY_HISTORY'))
) {
if (!(is.character(key) && length(key) == 1 && key != '')) stop(
"The value of the 'key' argument must be a single non-empty character string."
)
if (any(i <- !file_exists(input))) stop(
'Input file(s) not found: ', paste(input[i], collapse = ', ')
)
if (missing(output)) {
output = if (is.character(history)) input else {
paste0(sans_ext(input), '-min.', file_ext(input))
}
} else if (is.function(output)) output = output(input)
# avoid optimizing the input image if its md5 checksum exists in history
save_history = function(file) {
if (!is.character(history)) return()
cat(paste0(tools::md5sum(file), '\n'), file = history, append = TRUE)
}
test_history = function(file) {
is.character(history) && all(file_exists(c(history, file))) &&
(tools::md5sum(file) %in% readLines(history))
}
auth = paste('Authorization: Basic', base64_encode(charToRaw(paste0('api:', key))))
mapply(input, output, FUN = function(i, o) {
if (!force && test_history(o)) {
if (!quiet) message(
'The image ', o, ' has been compressed before. ',
'To compress it again, call tinify() with force = TRUE.'
)
return()
}
if (grepl('[.]png$', i, ignore.case = TRUE))
optipng(files = i, stdout = if (quiet) FALSE else '')
res = curl::curl_upload(i, 'https://api.tinify.com/shrink', httpheader = auth, verbose = FALSE)
cnt = curl::parse_headers_list(res$headers)[['compression-count']]
res = jsonlite::fromJSON(rawToChar(res$content))
if (!is.character(u <- res$output$url)) stop2(
"Failed to shrink '", i, "'", sprintf(': %s (%s)', res$error, res$message)
)
if (!quiet) message(sprintf(
'%s (%s) ==> %s (%s, %.01f%%); compression count: %s',
i, format_bytes(res$input$size), o, format_bytes(res$output$size),
res$output$ratio * 100, if (length(cnt)) cnt else NA
))
# back up the original image and restore it if download failed
if (i == o) {
b = paste0(i, '~')
file.rename(i, b)
on.exit(if (file_exists(o)) file.remove(b) else file.rename(b, i), add = TRUE)
}
curl::curl_download(u, o)
save_history(o)
})
invisible(output)
}
xfun/R/api.R 0000644 0001750 0001750 00000005230 14143024424 012457 0 ustar nilesh nilesh #' Get data from a REST API
#'
#' Read data from a REST API and optionally with an authorization token in the
#' request header. The function \code{rest_api_raw()} returns the raw text of
#' the response, and \code{rest_api()} will parse the response with
#' \code{jsonlite::fromJSON()} (assuming that the response is in the JSON
#' format).
#'
#' These functions are simple wrappers based on \code{\link{url}()} and
#' \code{\link{read_utf8}()}. Specifically, the \code{headers} argument is
#' passed to \code{url()}, and \code{read_utf8()} will send a \samp{GET} request
#' to the API server. This means these functions only support the \samp{GET}
#' method. If you need to use other HTTP methods (such as \samp{POST}), you have
#' to use other packages such as \pkg{curl} and \pkg{httr}.
#' @param ... Arguments to be passed to \code{rest_api_raw()}.
#' @return A character vector (the raw JSON response) or an R object parsed from
#' the JSON text.
#' @export
#' @examplesIf interactive()
#' # a normal GET request
#' xfun::rest_api('https://httpbin.org', '/get')
#' xfun::rest_api_raw('https://httpbin.org', '/get')
#'
#' # send the request with an auth header
#' xfun::rest_api('https://httpbin.org', '/headers', 'OPEN SESAME!')
#'
#' # with query parameters
#' xfun::rest_api('https://httpbin.org', '/response-headers', params = list(foo = 'bar'))
#'
#' # get the rate limit info from Github
#' xfun::github_api('/rate_limit')
rest_api = function(...) {
res = rest_api_raw(...)
jsonlite::fromJSON(res, simplifyVector = FALSE)
}
#' @param root The API root URL.
#' @param endpoint The API endpoint.
#' @param token A named character string (e.g., \code{c(token = "xxxx")}), which
#' will be used to create an authorization header of the form
#' \samp{Authorization: NAME TOKEN} for the API call, where \samp{NAME} is the
#' name of the string and \samp{TOKEN} is the string. If the string does not
#' have a name, \samp{Basic} will be used as the default name.
#' @param params A list of query parameters to be sent with the API call.
#' @param headers A named character vector of HTTP headers, e.g., \code{c(Accept
#' = "application/vnd.github.v3+json")}.
#' @rdname rest_api
#' @export
rest_api_raw = function(root, endpoint, token = '', params = list(), headers = NULL) {
if (is.null(names(token))) names(token) = 'Basic'
endpoint = sub('^/?', '/', endpoint) # make sure it has a leading /
con = url(
paste0(root, endpoint, query_params(.list = params)), encoding = 'UTF-8',
headers = c(
headers, if (token != '') c(Authorization = sprintf('%s %s', names(token), token))
)
)
on.exit(close(con), add = TRUE)
raw_string(suppressWarnings(read_utf8(con)))
}
xfun/R/os.R 0000644 0001750 0001750 00000001233 13311015222 012316 0 ustar nilesh nilesh #' Test for types of operating systems
#'
#' Functions based on \code{.Platform$OS.type} and \code{Sys.info()} to test if
#' the current operating system is Windows, macOS, Unix, or Linux.
#' @rdname os
#' @export
#' @examples
#' library(xfun)
#' # only one of the following statements should be true
#' is_windows()
#' is_unix() && is_macos()
#' is_linux()
is_windows = function() .Platform$OS.type == 'windows'
#' @rdname os
#' @export
is_unix = function() .Platform$OS.type == 'unix'
#' @rdname os
#' @export
is_macos = function() unname(Sys.info()['sysname'] == 'Darwin')
#' @rdname os
#' @export
is_linux = function() unname(Sys.info()['sysname'] == 'Linux')
xfun/R/json.R 0000644 0001750 0001750 00000004440 14143240043 012656 0 ustar nilesh nilesh #' A simple JSON serializer
#'
#' A JSON serializer that only works on a limited types of R data (\code{NULL},
#' lists, logical scalars, character/numeric vectors). A character string of the
#' class \code{JS_EVAL} is treated as raw JavaScript, so will not be quoted. The
#' function \code{json_vector()} converts an atomic R vector to JSON.
#' @param x An R object.
#' @export
#' @return A character string.
#' @seealso The \pkg{jsonlite} package provides a full JSON serializer.
#' @examples library(xfun)
#' tojson(NULL); tojson(1:10); tojson(TRUE); tojson(FALSE)
#' cat(tojson(list(a = 1, b = list(c = 1:3, d = 'abc'))))
#' cat(tojson(list(c('a', 'b'), 1:5, TRUE)))
#'
#' # the class JS_EVAL is originally from htmlwidgets::JS()
#' JS = function(x) structure(x, class = 'JS_EVAL')
#' cat(tojson(list(a = 1:5, b = JS('function() {return true;}'))))
tojson = function(x) {
if (is.null(x)) return('null')
if (is.logical(x)) {
if (length(x) != 1 || any(is.na(x)))
stop('Logical values of length > 1 and NA are not supported')
return(tolower(as.character(x)))
}
if (is.character(x) && inherits(x, 'JS_EVAL')) return(paste(x, collapse = '\n'))
if (is.character(x) || is.numeric(x)) {
return(json_vector(x, length(x) != 1 || inherits(x, 'AsIs'), is.character(x)))
}
if (is.list(x)) {
if (length(x) == 0) return('{}')
return(if (is.null(names(x))) {
json_vector(unlist(lapply(x, tojson)), TRUE, quote = FALSE)
} else {
nms = quote_string(names(x))
paste0('{\n', paste(nms, unlist(lapply(x, tojson)), sep = ': ', collapse = ',\n'), '\n}')
})
}
stop('The class of x is not supported: ', paste(class(x), collapse = ', '))
}
#' @param to_array Whether to convert a vector to a JSON array (use \code{[]}).
#' @param quote Whether to double quote the elements.
#' @rdname tojson
#' @export
json_vector = function(x, to_array = FALSE, quote = TRUE) {
if (quote) {
x = quote_string(x)
x = gsub('\n', '\\\\n', x)
x = gsub('\b', '\\\\b', x)
x = gsub('\f', '\\\\f', x)
x = gsub('\r', '\\\\r', x)
x = gsub('\t', '\\\\t', x)
}
if (to_array) paste0('[', paste(x, collapse = ', '), ']') else x
}
# escape \ and " in strings, and quote them
quote_string = function(x) {
x = gsub('(["\\])', "\\\\\\1", x)
if (length(x)) x = paste0('"', x, '"')
x
}
xfun/R/data-structure.R 0000644 0001750 0001750 00000005621 13753064224 014671 0 ustar nilesh nilesh #' Strict lists
#'
#' A strict list is essentially a normal \code{\link{list}()} but it does not
#' allow partial matching with \code{$}.
#'
#' To me, partial matching is often more annoying and surprising than
#' convenient. It can lead to bugs that are very hard to discover, and I have
#' been bitten by it many times. When I write \code{x$name}, I always mean
#' precisely \code{name}. You should use a modern code editor to autocomplete
#' the \code{name} if it is too long to type, instead of using partial names.
#' @param ... Objects (list elements), possibly named. Ignored in the
#' \code{print()} method.
#' @export
#' @return Both \code{strict_list()} and \code{as_strict_list()} return a list
#' with the class \code{xfun_strict_list}. Whereas \code{as_strict_list()}
#' attempts to coerce its argument \code{x} to a list if necessary,
#' \code{strict_list()} just wraps its argument \code{...} in a list, i.e., it
#' will add another list level regardless if \code{...} already is of type
#' list.
#' @examples library(xfun)
#' (z = strict_list(aaa = 'I am aaa', b = 1:5))
#' z$a # NULL!
#' z$aaa # I am aaa
#' z$b
#' z$c = 'create a new element'
#'
#' z2 = unclass(z) # a normal list
#' z2$a # partial matching
#'
#' z3 = as_strict_list(z2) # a strict list again
#' z3$a # NULL again!
strict_list = function(...) {
as_strict_list(list(...))
}
# https://twitter.com/xieyihui/status/782462926862954496
#' @param x For \code{as_strict_list()}, the object to be coerced to a strict
#' list.
#'
#' For \code{print()}, a strict list.
#' @rdname strict_list
#' @export
as_strict_list = function(x) {
structure(as.list(x), class = 'xfun_strict_list')
}
#' @param name The name (a character string) of the list element.
#' @rdname strict_list
#' @export
`$.xfun_strict_list` = function(x, name) x[[name]]
#' @rdname strict_list
#' @export
print.xfun_strict_list = function(x, ...) {
print(unclass(x))
}
#' Print a character vector in its raw form
#'
#' The function \code{raw_string()} assigns the class \code{xfun_raw_string} to
#' the character vector, and the corresponding printing function
#' \code{print.xfun_raw_string()} uses \code{cat(x, sep = '\n')} to write the
#' character vector to the console, which will suppress the leading indices
#' (such as \code{[1]}) and double quotes, and it may be easier to read the
#' characters in the raw form (especially when there are escape sequences).
#' @param x For \code{raw_string()}, a character vector. For the print method,
#' the \code{raw_string()} object.
#' @export
#' @examples library(xfun)
#' raw_string(head(LETTERS))
#' raw_string(c('a "b"', 'hello\tworld!'))
raw_string = function(x) {
if (is.null(x)) x = as.character(x)
class(x) = c('xfun_raw_string', class(x))
x
}
#' @param ... Other arguments (currently ignored).
#' @rdname raw_string
#' @export
print.xfun_raw_string = function(x, ...) {
if (length(x)) cat(x, sep = '\n')
invisible(x)
}
xfun/R/io.R 0000644 0001750 0001750 00000033603 14153512256 012330 0 ustar nilesh nilesh #' Read / write files encoded in UTF-8
#'
#' Read or write files, assuming they are encoded in UTF-8. \code{read_utf8()}
#' is roughly \code{readLines(encoding = 'UTF-8')} (a warning will be issued if
#' non-UTF8 lines are found), and \code{write_utf8()} calls
#' \code{writeLines(enc2utf8(text), useBytes = TRUE)}.
#'
#' The function \code{append_utf8()} appends UTF-8 content to a file or
#' connection based on \code{read_utf8()} and \code{write_utf8()}, and
#' optionally sort the content. The function \code{append_unique()} appends
#' unique lines to a file or connection.
#' @param con A connection or a file path.
#' @param error Whether to signal an error when non-UTF8 characters are detected
#' (if \code{FALSE}, only a warning message is issued).
#' @param text A character vector (will be converted to UTF-8 via
#' \code{\link{enc2utf8}()}).
#' @param ... Other arguments passed to \code{\link{writeLines}()} (except
#' \code{useBytes}, which is \code{TRUE} in \code{write_utf8()}).
#' @export
read_utf8 = function(con, error = FALSE) {
# users may have set options(encoding = 'UTF-8'), which usually won't help but
# will bring more trouble than good, so we reset this option temporarily
opts = options(encoding = 'native.enc'); on.exit(options(opts), add = TRUE)
x = readLines(con, encoding = 'UTF-8', warn = FALSE)
i = invalid_utf8(x)
n = length(i)
if (n > 0) (if (error) stop else warning)(
if (is.character(con)) c('The file ', con, ' is not encoded in UTF-8. '),
'These lines contain invalid UTF-8 characters: ',
paste(c(head(i), if (n > 6) '...'), collapse = ', ')
)
x
}
#' @rdname read_utf8
#' @export
write_utf8 = function(text, con, ...) {
if (is.null(text)) text = character(0)
if (identical(con, '')) {
cat(text, sep = '\n', file = con)
} else {
# prevent re-encoding the text in the file() connection in writeLines()
# https://kevinushey.github.io/blog/2018/02/21/string-encoding-and-r/
opts = options(encoding = 'native.enc'); on.exit(options(opts), add = TRUE)
writeLines(enc2utf8(text), con, ..., useBytes = TRUE)
}
}
#' @param sort Logical (\code{FALSE} means not to sort the content) or a
#' function to sort the content; \code{TRUE} is equivalent to
#' \code{base::sort}.
#' @rdname read_utf8
#' @export
append_utf8 = function(text, con, sort = TRUE) {
x = read_utf8(con, error = TRUE)
x = c(x, text)
if (is.logical(sort)) sort = if (sort) base::sort else identity
if (is.function(sort)) x = sort(x)
write_utf8(x, con)
}
#' @rdname read_utf8
#' @export
append_unique = function(text, con, sort = function(x) base::sort(unique(x))) {
append_utf8(text, con, sort)
}
# which lines are invalid UTF-8
invalid_utf8 = function(x) {
which(!is_utf8(x))
}
test_utf8 = function(x) {
is.na(x) | !is.na(iconv(x, 'UTF-8', 'UTF-8'))
}
# validUTF8() was added to base R 3.3.0
is_utf8 = function(x) {
if ('validUTF8' %in% ls(baseenv())) validUTF8(x) else test_utf8(x)
}
#' Read a text file and concatenate the lines by \code{'\n'}
#'
#' The source code of this function should be self-explanatory.
#' @param file Path to a text file (should be encoded in UTF-8).
#' @return A character string of text lines concatenated by \code{'\n'}.
#' @export
#' @examples
#' xfun::file_string(system.file('DESCRIPTION', package = 'xfun'))
file_string = function(file) {
x = read_utf8(file)
# paste converts 0-length character() into 1-length ""
if (length(x)) x = paste(x, collapse = '\n')
raw_string(x)
}
#' Read all records of a binary file as a raw vector by default
#'
#' This is a wrapper function of \code{\link{readBin}()} with default arguments
#' \code{what = "raw"} and \code{n = \link{file.size}(file)}, which means it
#' will read the full content of a binary file as a raw vector by default.
#' @param file,what,n,... Arguments to be passed to \code{readBin()}.
#' @return A vector returned from \code{readBin()}.
#' @export
#' @examples
#' f = tempfile()
#' cat('abc', file = f)
#' xfun::read_bin(f)
#' unlink(f)
read_bin = function(file, what = 'raw', n = file.info(file)$size, ...) {
readBin(file, what, n, ...)
}
#' Read all text files and concatenate their content
#'
#' Read files one by one, and optionally add text before/after the content. Then
#' combine all content into one character vector.
#' @param files A vector of file paths.
#' @param before,after A function that takes one file path as the input and
#' returns values to be added before or after the content of the file.
#' Alternatively, they can be constant values to be added.
#' @return A character vector.
#' @export
#' @examples
#' # two files in this package
#' fs = system.file('scripts', c('call-fun.R', 'child-pids.sh'), package = 'xfun')
#' xfun::read_all(fs)
#'
#' # add file paths before file content and an empty line after content
#' xfun::read_all(fs, before = function(f) paste('#-----', f, '-----'), after = '')
#'
#' # add constants
#' xfun::read_all(fs, before = '/*', after = c('*/', ''))
read_all = function(files, before = function(f) NULL, after = function(f) NULL) {
b = before; a = after
x = unlist(lapply(files, function(f) {
c(if (is.function(b)) b(f) else b, read_utf8(f), if (is.function(a)) a(f) else a)
}))
raw_string(x)
}
#' Read a text file, process the text with a function, and write the text back
#'
#' Read a text file with the UTF-8 encoding, apply a function to the text, and
#' write back to the original file.
#'
#' \code{sort_file()} is an application of \code{process_file()}, with the
#' processing function being \code{\link{sort}()}, i.e., it sorts the text lines
#' in a file and write back the sorted text.
#' @param file Path to a text file.
#' @param fun A function to process the text.
#' @param x The content of the file.
#' @param ... Arguments to be passed to \code{process_file()}.
#' @return If \code{file} is provided, invisible \code{NULL} (the file is
#' updated as a side effect), otherwise the processed content (as a character
#' vector).
#' @export
#' @examples f = tempfile()
#' xfun::write_utf8('Hello World', f)
#' xfun::process_file(f, function(x) gsub('World', 'woRld', x))
#' xfun::read_utf8(f) # see if it has been updated
#' file.remove(f)
process_file = function(file, fun = identity, x = read_utf8(file)) {
x = fun(x)
if (missing(file)) x else write_utf8(x, file)
}
#' @rdname process_file
#' @export
sort_file = function(..., fun = sort) {
process_file(fun = fun, ...)
}
#' Search and replace strings in files
#'
#' These functions provide the "file" version of \code{\link{gsub}()}, i.e.,
#' they perform searching and replacement in files via \code{gsub()}.
#' @param file Path of a single file.
#' @param ... For \code{gsub_file()}, arguments passed to \code{gsub()}. For
#' other functions, arguments passed to \code{gsub_file()}. Note that the
#' argument \code{x} of \code{gsub()} is the content of the file.
#' @param rw_error Whether to signal an error if the file cannot be read or
#' written. If \code{FALSE}, the file will be ignored (with a warning).
#' @param files A vector of file paths.
#' @param dir Path to a directory (all files under this directory will be
#' replaced).
#' @param recursive Whether to find files recursively under a directory.
#' @param ext A vector of filename extensions (without the leading periods).
#' @param mimetype A regular expression to filter files based on their MIME
#' types, e.g., \code{'^text/'} for plain text files. This requires the
#' \pkg{mime} package.
#' @note These functions perform in-place replacement, i.e., the files will be
#' overwritten. Make sure you backup your files in advance, or use version
#' control!
#' @export
#' @examples library(xfun)
#' f = tempfile()
#' writeLines(c('hello', 'world'), f)
#' gsub_file(f, 'world', 'woRld', fixed = TRUE)
#' readLines(f)
gsub_file = function(file, ..., rw_error = TRUE) {
if (!(file.access(file, 2) == 0 && file.access(file, 4) == 0)) {
(if (rw_error) stop else warning)('Unable to read or write to ', file)
if (!rw_error) return(invisible())
}
x1 = tryCatch(read_utf8(file, error = TRUE), error = function(e) if (rw_error) stop(e))
if (is.null(x1)) return(invisible())
x2 = gsub(x = x1, ...)
if (!identical(x1, x2)) write_utf8(x2, file)
}
#' @rdname gsub_file
#' @export
gsub_files = function(files, ...) {
for (f in files) gsub_file(f, ...)
}
#' @rdname gsub_file
#' @export
gsub_dir = function(..., dir = '.', recursive = TRUE, ext = NULL, mimetype = '.*') {
files = list.files(dir, full.names = TRUE, recursive = recursive)
if (length(ext)) files = files[file_ext(files) %in% ext]
if (mimetype != '.*') files = files[grep(mimetype, mime::guess_type(files))]
gsub_files(files, ...)
}
#' @rdname gsub_file
#' @export
gsub_ext = function(ext, ..., dir = '.', recursive = TRUE) {
gsub_dir(..., dir = dir, recursive = recursive, ext = ext)
}
#' Perform replacement with \code{gsub()} on elements matched from \code{grep()}
#'
#' This function is a shorthand of \code{gsub(pattern, replacement,
#' grep(pattern, x, value = TRUE))}.
#' @param pattern,replacement,x,... Passed to \code{\link{grep}()} and
#' \code{gsub()}.
#' @return A character vector.
#' @export
#' @examples # find elements that matches 'a[b]+c' and capitalize 'b' with perl regex
#' xfun::grep_sub('a([b]+)c', 'a\\U\\1c', c('abc', 'abbbc', 'addc', '123'), perl = TRUE)
grep_sub = function(pattern, replacement, x, ...) {
x = grep(pattern, x, value = TRUE, ...)
gsub(pattern, replacement, x, ...)
}
#' Try various methods to download a file
#'
#' Try all possible methods in \code{\link{download.file}()} (e.g.,
#' \code{libcurl}, \code{curl}, \code{wget}, and \code{wininet}) and see if any
#' method can succeed. The reason to enumerate all methods is that sometimes the
#' default method does not work, e.g.,
#' \url{https://stat.ethz.ch/pipermail/r-devel/2016-June/072852.html}.
#' @param url The URL of the file.
#' @param output Path to the output file. By default, it is determined by
#' \code{\link{url_filename}()}.
#' @param ... Other arguments to be passed to \code{\link{download.file}()}
#' (except \code{method}).
#' @param .error An error message to signal when the download fails.
#' @note To allow downloading large files, the \code{timeout} option in
#' \code{\link{options}()} will be temporarily set to one hour (3600 seconds)
#' inside this function when this option has the default value of 60 seconds.
#' If you want a different \code{timeout} value, you may set it via
#' \code{options(timeout = N)}, where \code{N} is the number of seconds (not
#' 60).
#' @return The integer code \code{0} for success, or an error if none of the
#' methods work.
#' @export
download_file = function(
url, output = url_filename(url), ...,
.error = 'No download method works (auto/wininet/wget/curl/lynx)'
) {
if (getOption('timeout') == 60L) {
opts = options(timeout = 3600) # one hour
on.exit(options(opts), add = TRUE)
}
download = function(method = 'auto') suppressWarnings({
tryCatch(download.file(url, output, ..., method = method), error = function(e) 1L)
})
for (method in c(if (is_windows()) 'wininet', 'libcurl', 'auto')) {
if (download(method = method) == 0) return(0L)
}
# check for libcurl/curl/wget/lynx, call download.file with appropriate method
if (Sys.which('curl') != '') {
# curl needs to add a -L option to follow redirects
opts2 = if (is.null(getOption('download.file.extra')))
options(download.file.extra = c('-L', '--fail'))
res = download(method = 'curl')
options(opts2)
if (res == 0) return(res)
}
if (Sys.which('wget') != '') {
if ((res <- download(method = 'wget')) == 0) return(res)
}
if (Sys.which('lynx') != '') {
if ((res <- download(method = 'lynx')) == 0) return(res)
}
stop(.error)
}
#' Test if a URL is accessible
#'
#' Try to send a \code{HEAD} request to a URL using
#' \code{\link{curlGetHeaders}()} or the \pkg{curl} package, and see if it
#' returns a successful status code.
#' @param x A URL as a character string.
#' @param use_curl Whether to use the \pkg{curl} package or the
#' \code{curlGetHeaders()} function in base R to send the request to the URL.
#' By default, \pkg{curl} will be used when base R does not have the
#' \command{libcurl} capability (which should be rare).
#' @param ... Arguments to be passed to \code{curlGetHeaders()}.
#' @return \code{TRUE} or \code{FALSE}.
#' @export
#' @examples xfun::url_accessible('https://yihui.org')
url_accessible = function(x, use_curl = !capabilities('libcurl'), ...) {
try_status = function(code) tryCatch(code < 400, error = function(e) FALSE)
if (use_curl) {
h = curl::new_handle()
curl::handle_setopt(h, customrequest = 'HEAD', nobody = TRUE)
try_status(curl::curl_fetch_memory(x, h)$status_code)
} else {
# use curlGetHeaders() instead
try_status(attr(curlGetHeaders(x, ...), 'status'))
}
}
#' Generate a message with \code{cat()}
#'
#' This function is similar to \code{\link{message}()}, and the difference is
#' that \code{msg_cat()} uses \code{\link{cat}()} to write out the message,
#' which is sent to \code{\link{stdout}} instead of \code{\link{stderr}}. The
#' message can be suppressed by \code{\link{suppressMessages}()}.
#' @param ... Character strings of messages, which will be concatenated into one
#' string via \code{paste(c(...), collapse = '')}.
#' @note By default, a newline will not be appended to the message. If you need
#' a newline, you have to explicitly add it to the message (see
#' \sQuote{Examples}).
#' @return Invisible \code{NULL}, with the side-effect of printing the message.
#' @seealso This function was inspired by \code{rlang::inform()}.
#' @export
#' @examples
#' {
#' # a message without a newline at the end
#' xfun::msg_cat('Hello world!')
#' # add a newline at the end
#' xfun::msg_cat(' This message appears right after the previous one.\n')
#' }
#' suppressMessages(xfun::msg_cat('Hello world!'))
msg_cat = function(...) {
x = paste(c(...), collapse = '')
withRestarts({
signalCondition(simpleMessage(x))
cat(x)
}, muffleMessage = function() invisible(NULL))
}
xfun/R/cache.R 0000644 0001750 0001750 00000020461 14132441073 012755 0 ustar nilesh nilesh #' Cache the value of an R expression to an RDS file
#'
#' Save the value of an expression to a cache file (of the RDS format). Next
#' time the value is loaded from the file if it exists.
#'
#' Note that the \code{file} argument does not provide the full cache filename.
#' The actual name of the cache file is of the form \file{BASENAME_HASH.rds},
#' where \file{BASENAME} is the base name provided via the \file{file} argument
#' (e.g., if \code{file = 'foo.rds'}, \code{BASENAME} would be \file{foo}), and
#' \file{HASH} is the MD5 hash (also called the \sQuote{checksum}) calculated
#' from the R code provided to the \code{expr} argument and the value of the
#' \code{hash} argument, which means when the code or the \code{hash} argument
#' changes, the \file{HASH} string may also change, and the old cache will be
#' invalidated (if it exists). If you want to find the cache file, look for
#' \file{.rds} files that contain 32 hexadecimal digits (consisting of 0-9 and
#' a-z) at the end of the filename.
#'
#' The possible ways to invalidate the cache are: 1) change the code in
#' \code{expr} argument; 2) delete the cache file manually or automatically
#' through the argument \code{rerun = TRUE}; and 3) change the value of the
#' \code{hash} argument. The first two ways should be obvious. For the third
#' way, it makes it possible to automatically invalidate the cache based on
#' changes in certain R objects. For example, when you run \code{cache_rds({ x +
#' y })}, you may want to invalidate the cache to rerun \code{{ x + y }} when
#' the value of \code{x} or \code{y} has been changed, and you can tell
#' \code{cache_rds()} to do so by \code{cache_rds({ x + y }, hash = list(x,
#' y))}. The value of the argument \code{hash} is expected to be a list, but it
#' can also take a special value, \code{"auto"}, which means
#' \code{cache_rds(expr)} will try to automatically figure out the global
#' variables in \code{expr}, return a list of their values, and use this list as
#' the actual value of \code{hash}. This behavior is most likely to be what you
#' really want: if the code in \code{expr} uses an external global variable, you
#' may want to invalidate the cache if the value of the global variable has
#' changed. Here a \dQuote{global variable} means a variable not created locally
#' in \code{expr}, e.g., for \code{cache_rds({ x <- 1; x + y })}, \code{x} is a
#' local variable, and \code{y} is (most likely to be) a global variable, so
#' changes in \code{y} should invalidate the cache. However, you know your own
#' code the best. If you want to be completely sure when to invalidate the
#' cache, you can always provide a list of objects explicitly rather than
#' relying on \code{hash = "auto"}.
#'
#' By default (the argument \code{clean = TRUE}), old cache files will be
#' automatically cleaned up. Sometimes you may want to use \code{clean = FALSE}
#' (set the R global option \code{options(xfun.cache_rds.clean = FALSE)} if you
#' want \code{FALSE} to be the default). For example, you may not have decided
#' which version of code to use, and you can keep the cache of both versions
#' with \code{clean = FALSE}, so when you switch between the two versions of
#' code, it will still be fast to run the code.
#' @param expr An R expression.
#' @param rerun Whether to delete the RDS file, rerun the expression, and save
#' the result again (i.e., invalidate the cache if it exists).
#' @param file The \emph{base} (see Details) cache filename under the directory
#' specified by the \code{dir} argument. If not specified and this function is
#' called inside a code chunk of a \pkg{knitr} document (e.g., an R Markdown
#' document), the default is the current chunk label plus the extension
#' \file{.rds}.
#' @param dir The path of the RDS file is partially determined by
#' \code{paste0(dir, file)}. If not specified and the \pkg{knitr} package is
#' available, the default value of \code{dir} is the \pkg{knitr} chunk option
#' \code{cache.path} (so if you are compiling a \pkg{knitr} document, you do
#' not need to provide this \code{dir} argument explicitly), otherwise the
#' default is \file{cache/}. If you do not want to provide a \code{dir} but
#' simply a valid path to the \code{file} argument, you may use \code{dir =
#' ""}.
#' @param hash A \code{list} object that contributes to the MD5 hash of the
#' cache filename (see Details). It can also take a special character value
#' \code{"auto"}. Other types of objects are ignored.
#' @param clean Whether to clean up the old cache files automatically when
#' \code{expr} has changed.
#' @param ... Other arguments to be passed to \code{\link{saveRDS}()}.
#' @note Changes in the code in the \code{expr} argument do not necessarily
#' always invalidate the cache, if the changed code is \code{\link{parse}d} to
#' the same expression as the previous version of the code. For example, if
#' you have run \code{cache_rds({Sys.sleep(5);1+1})} before, running
#' \code{cache_rds({ Sys.sleep( 5 ) ; 1 + 1 })} will use the cache, because
#' the two expressions are essentially the same (they only differ in white
#' spaces). Usually you can add/delete white spaces or comments to your code
#' in \code{expr} without invalidating the cache. See the package vignette
#' \code{vignette('xfun', package = 'xfun')} for more examples.
#'
#' When this function is called in a code chunk of a \pkg{knitr} document, you
#' may not want to provide the filename or directory of the cache file,
#' because they have reasonable defaults.
#'
#' Side-effects (such as plots or printed output) will not be cached. The
#' cache only stores the last value of the expression in \code{expr}.
#' @return If the cache file does not exist, run the expression and save the
#' result to the file, otherwise read the cache file and return the value.
#' @export
#' @examples
#' f = tempfile() # the cache file
#' compute = function(...) {
#' res = xfun::cache_rds({
#' Sys.sleep(1)
#' 1:10
#' }, file = f, dir = '', ...)
#' res
#' }
#' compute() # takes one second
#' compute() # returns 1:10 immediately
#' compute() # fast again
#' compute(rerun = TRUE) # one second to rerun
#' compute()
#' file.remove(f)
cache_rds = function(
expr = {}, rerun = FALSE, file = 'cache.rds', dir = 'cache/',
hash = NULL, clean = getOption('xfun.cache_rds.clean', TRUE), ...
) {
if (loadable('knitr')) {
if (missing(file) && !is.null(lab <- knitr::opts_current$get('label')))
file = paste0(lab, '.rds')
if (missing(dir) && !is.null(d <- knitr::opts_current$get('cache.path')))
dir = d
}
path = paste0(dir, file)
if (!grepl(r <- '([.]rds)$', path)) path = paste0(path, '.rds')
code = deparse(substitute(expr))
md5 = md5sum_obj(code)
if (identical(hash, 'auto')) hash = global_vars(code, parent.frame(2))
if (is.list(hash)) md5 = md5sum_obj(c(md5, md5sum_obj(hash)))
path = sub(r, paste0('_', md5, '\\1'), path)
if (rerun) unlink(path)
if (clean) clean_cache(path)
if (file_exists(path)) readRDS(path) else {
obj = expr # lazy evaluation
dir.create(dirname(path), recursive = TRUE, showWarnings = FALSE)
saveRDS(obj, path, ...)
obj
}
}
# write an object to a file and return the md5 sum
md5sum_obj = function(x) {
f = tempfile(); on.exit(unlink(f), add = TRUE)
if (is.character(x)) writeLines(x, f) else saveRDS(x, f)
tools::md5sum(f)
}
# clean up old cache files (those with the same base names as the new cache
# file, e.g., if the new file is FOO_0123abc...z.rds, then FOO_9876def...x.rds
# should be deleted)
clean_cache = function(path) {
olds = list.files(dirname(path), '_[0-9a-f]{32}[.]rds$', full.names = TRUE)
olds = c(olds, path) # `path` may not exist; make sure it is in target paths
base = basename(olds)
keep = basename(path) == base # keep this file (will cache to this file)
base = substr(base, 1, nchar(base) - 37) # 37 = 1 (_) + 32 (md5 sum) + 4 (.rds)
unlink(olds[(base == base[keep][1]) & !keep])
}
# analyze code and find out global variables
find_globals = function(code) {
fun = eval(parse_only(c('function(){', code, '}')))
setdiff(codetools::findGlobals(fun), known_globals)
}
known_globals = c(
'{', '[', '(', ':', '<-', '=', '+', '-', '*', '/', '%%', '%/%', '%*%', '%o%', '%in%'
)
# return a list of values of global variables in code
global_vars = function(code, env) {
if (length(vars <- find_globals(code)) > 0) mget(vars, env)
}
xfun/R/command.R 0000644 0001750 0001750 00000033027 14145515224 013336 0 ustar nilesh nilesh #' Run \code{system2()} and mark its character output as UTF-8 if appropriate
#'
#' This is a wrapper function based on \code{system2()}. If \code{system2()}
#' returns character output (e.g., with the argument \code{stdout = TRUE}),
#' check if the output is encoded in UTF-8. If it is, mark it with UTF-8
#' explicitly.
#' @param ... Passed to \code{\link{system2}()}.
#' @return The value returned by \code{system2()}.
#' @export
#' @examplesIf interactive()
#' a = shQuote(c('-e', 'print(intToUtf8(c(20320, 22909)))'))
#' x2 = system2('Rscript', a, stdout = TRUE)
#' Encoding(x2) # unknown
#'
#' x3 = xfun::system3('Rscript', a, stdout = TRUE)
#' # encoding of x3 should be UTF-8 if the current locale is UTF-8
#' !l10n_info()[['UTF-8']] || Encoding(x3) == 'UTF-8' # should be TRUE
system3 = function(...) {
res = system2(...)
if (is.character(res)) {
if (all(is_utf8(res))) Encoding(res) = 'UTF-8'
}
if (is.integer(res) && res == 0) invisible(res) else res
}
#' Run OptiPNG on all PNG files under a directory
#'
#' Call the command \command{optipng} via \code{system2()} to optimize all PNG
#' files under a directory.
#' @param dir Path to a directory.
#' @param files Alternatively, you can choose the specific files to optimize.
#' @param ... Arguments to be passed to \code{system2()}.
#' @references OptiPNG: \url{http://optipng.sourceforge.net}.
#' @export
optipng = function(
dir = '.', files = list.files(dir, '[.]png$', recursive = TRUE, full.names = TRUE), ...
) {
if (Sys.which('optipng') != '') for (f in files) system2('optipng', shQuote(f), ...)
}
#' Run the commands \command{Rscript} and \command{R CMD}
#'
#' Wrapper functions to run the commands \command{Rscript} and \command{R CMD}.
#' @param args A character vector of command-line arguments.
#' @param ... Other arguments to be passed to \code{\link{system2}()}.
#' @export
#' @return A value returned by \code{system2()}.
#' @examples library(xfun)
#' Rscript(c('-e', '1+1'))
#' Rcmd(c('build', '--help'))
Rscript = function(args, ...) {
# unset R_TESTS for the new R session: https://stackoverflow.com/a/27994299
if (is_R_CMD_check()) {
v = set_envvar(c(R_TESTS = NA)); on.exit(set_envvar(v), add = TRUE)
}
system2(file.path(R.home('bin'), 'Rscript'), args, ...)
}
#' @rdname Rscript
#' @export
Rcmd = function(args, ...) {
system2(file.path(R.home('bin'), 'R'), c('CMD', args), ...)
}
#' Call a function in a new R session via \code{Rscript()}
#'
#' Save the argument values of a function in a temporary RDS file, open a new R
#' session via \code{\link{Rscript}()}, read the argument values, call the
#' function, and read the returned value back to the current R session.
#' @param fun A function, or a character string that can be parsed and evaluated
#' to a function.
#' @param args A list of argument values.
#' @param options A character vector of options to passed to
#' \code{\link{Rscript}}, e.g., \code{"--vanilla"}.
#' @param ...,wait Arguments to be passed to \code{\link{system2}()}.
#' @param fail The desired error message when an error occurred in calling the
#' function.
#' @export
#' @return The returned value of the function in the new R session.
#' @examples factorial(10)
#' # should return the same value
#' xfun::Rscript_call('factorial', list(10))
#'
#' # the first argument can be either a character string or a function
#' xfun::Rscript_call(factorial, list(10))
#'
#' # Run Rscript starting a vanilla R session
#' xfun::Rscript_call(factorial, list(10), options = c("--vanilla"))
Rscript_call = function(
fun, args = list(), options = NULL, ..., wait = TRUE,
fail = sprintf("Failed to run '%s' in a new R session.", deparse(substitute(fun))[1])
) {
f = replicate(2, tempfile(fileext = '.rds'))
on.exit(unlink(if (wait) f else f[2]), add = TRUE)
saveRDS(list(fun, args), f[1])
Rscript(
c(options, shQuote(c(pkg_file('scripts', 'call-fun.R'), f)))
,..., wait = wait
)
if (wait) if (file_exists(f[2])) readRDS(f[2]) else stop(fail, call. = FALSE)
}
# call a function in a background process
Rscript_bg = function(fun, args = list(), timeout = 10) {
pid = tempfile() # to store the process ID of the new R session
saveRDS(NULL, pid)
Rscript_call(function() {
saveRDS(Sys.getpid(), pid)
# remove this pid file when the function finishes
on.exit(unlink(pid), add = TRUE)
do.call(fun, args)
}, wait = FALSE)
id = NULL # read the above process ID into this R session
res = list(pid = id, is_alive = function() FALSE)
# check if the pid file still exists; if not, the process has ended
if (!file_exists(pid)) return(res)
t0 = Sys.time()
while (difftime(Sys.time(), t0, units = 'secs') < timeout) {
Sys.sleep(.1)
if (!file_exists(pid)) return(res)
if (length(id <- readRDS(pid)) == 1) break
}
if (length(id) == 0) stop(
'Failed to launch the background process in ', timeout, ' seconds (timeout).'
)
list(pid = id, is_alive = function() file_exists(pid))
}
#' Kill a process and (optionally) all its child processes
#'
#' Run the command \command{taskkill /f /pid} on Windows and \command{kill} on
#' Unix, respectively, to kill a process.
#' @param pid The process ID.
#' @param recursive Whether to kill the child processes of the process.
#' @param ... Arguments to be passed to \code{\link{system2}()} to run the
#' command to kill the process.
#' @return The status code returned from \code{system2()}.
#' @export
proc_kill = function(pid, recursive = TRUE, ...) {
if (is_windows()) {
system2('taskkill', c(if (recursive) '/t', '/f', '/pid', pid), ...)
} else {
system2('kill', c(pid, if (recursive) child_pids(pid)), ...)
}
}
# obtain pids of all child processes (recursively)
child_pids = function(id) {
x = system2('sh', shQuote(c(pkg_file('scripts', 'child-pids.sh'), id)), stdout = TRUE)
grep('^[0-9]+$', x, value = TRUE)
}
powershell = function(command) {
if (Sys.which('powershell') == '') return()
command = paste(command, collapse = ' ')
system2('powershell', c('-Command', shQuote(command)), stdout = TRUE)
}
# start a background process via the PowerShell cmdlet and return its pid
ps_process = function(command, args = character(), verbose = FALSE) {
powershell(c(
'echo (Start-Process', '-FilePath', shQuote(command), '-ArgumentList',
ps_quote(args), '-PassThru', '-WindowStyle',
sprintf('%s).ID', if (verbose) 'Normal' else 'Hidden')
))
}
# quote PowerShell arguments properly
ps_quote = function(x) {
x = gsub('"', '""', x) # '""' mean a literal '"'
# if an argument contains a space, surround it with escaped double quotes `"`"
i = grep('\\s', x)
x[i] = sprintf('`"%s`"', x[i])
sprintf('"%s"', paste(x, collapse = ' '))
}
#' Start a background process
#'
#' Start a background process using the PowerShell cmdlet \command{Start-Process
#' -PassThru} on Windows or the ampersand \command{&} on Unix, and return the
#' process ID.
#' @param command,args The system command and its arguments. They do not need to
#' be quoted, since they will be quoted via \code{\link{shQuote}()}
#' internally.
#' @param verbose If \code{FALSE}, suppress the output from \verb{stdout} (and
#' also \verb{stderr} on Windows). The default value of this argument can be
#' set via a global option, e.g., \code{options(xfun.bg_process.verbose =
#' TRUE)}.
#' @return The process ID as a character string.
#' @note On Windows, if PowerShell is not available, try to use
#' \code{\link{system2}(wait = FALSE)} to start the background process
#' instead. The process ID will be identified from the output of the command
#' \command{tasklist}. This method of looking for the process ID may not be
#' reliable. If the search is not successful in 30 seconds, it will throw an
#' error (timeout). If a longer time is needed, you may set
#' \code{options(xfun.bg_process.timeout)} to a larger value, but it should be
#' very rare that a process cannot be started in 30 seconds. When you reach
#' the timeout, it is more likely that the command actually failed.
#' @export
#' @seealso \code{\link{proc_kill}()} to kill a process.
bg_process = function(
command, args = character(), verbose = getOption('xfun.bg_process.verbose', FALSE)
) {
throw_error = function(...) stop(
'Failed to run the command', ..., ' in the background: ',
paste(shQuote(c(command, args)), collapse = ' '), call. = FALSE
)
# check the possible pid returned from system2()
check_pid = function(res) {
if (is.null(res)) return(res)
if (!is.null(attr(res, 'status'))) throw_error()
if (length(res) == 1 && grepl('^[0-9]+$', res)) return(res)
throw_error()
}
if (is_windows()) {
# first try 'Start-Process -PassThrough' to start a background process; if
# PowerShell is unavailable, fall back to system2(wait = FALSE), and the
# method to find out the pid is not 100% reliable
if (length(pid <- check_pid(ps_process(command, args, verbose))) == 1) return(pid)
message(
'It seems you do not have PowerShell installed. The process ID may be inaccurate.'
)
# format of task list: hugo.exe 4592 Console 1 35,188 K
tasklist = function() system2('tasklist', stdout = TRUE)
pid1 = tasklist()
system2(command, shQuote(args), wait = FALSE)
get_pid = function() {
# make sure the command points to an actual executable (e.g., resolve 'R'
# to 'R.exe')
if (!file_exists(command)) {
if (Sys.which(command) != '') command = Sys.which(command)
}
cmd = basename(command)
pid2 = setdiff(tasklist(), pid1)
# the process's info should start with the command name
pid2 = pid2[substr(pid2, 1, nchar(cmd)) == cmd]
if (length(pid2) == 0) return()
m = regexec('\\s+([0-9]+)\\s+', pid2)
for (v in regmatches(pid2, m)) if (length(v) >= 2) return(v[2])
}
t0 = Sys.time(); id = NULL; timeout = getOption('xfun.bg_process.timeout', 30)
while (difftime(Sys.time(), t0, units = 'secs') < timeout) {
if (length(id <- get_pid()) > 0) break
}
if (length(id) > 0) return(id)
system2(command, args, timeout = timeout) # see what the error is
throw_error(' in ', timeout, ' second(s)')
} else {
pid = tempfile(); on.exit(unlink(pid), add = TRUE)
code = paste(c(
shQuote(c(command, args)), if (!verbose) '> /dev/null', '& echo $! >', shQuote(pid)
), collapse = ' ')
system2('sh', c('-c', shQuote(code)))
return(check_pid(readLines(pid)))
}
}
#' Upload to an FTP server via \command{curl}
#'
#' The function \code{upload_ftp()} runs the command \command{curl -T file
#' server} to upload a file to an FTP server if the system command
#' \command{curl} is available, otherwise it uses the R package \pkg{curl}. The
#' function \code{upload_win_builder()} uses \code{upload_ftp()} to upload
#' packages to the win-builder server.
#'
#' These functions were written mainly to save package developers the trouble of
#' going to the win-builder web page and uploading packages there manually.
#' @param file Path to a local file.
#' @param server The address of the FTP server. For \code{upload_win_builder()},
#' \code{server = 'https'} means uploading to
#' \code{'https://win-builder.r-project.org/upload.aspx'}.
#' @param dir The remote directory to which the file should be uploaded.
#' @param version The R version(s) on win-builder.
#' @return Status code returned from \code{\link{system2}()} or
#' \code{curl::curl_fetch_memory()}.
#' @export
upload_ftp = function(file, server, dir = '') {
if (dir != '') dir = gsub('/*$', '/', dir)
server = paste0(server, dir)
if (Sys.which('curl') == '') {
curl::curl_upload(file, server)$status_code
} else {
system2('curl', shQuote(c('-T', file, server)))
}
}
#' @param solaris Whether to also upload the package to the Rhub server to check
#' it on Solaris.
#' @rdname upload_ftp
#' @export
upload_win_builder = function(
file = pkg_build(), version = c("R-devel", "R-release", "R-oldrelease"),
server = c('ftp', 'https'), solaris = pkg_available('rhub')
) {
if (missing(file)) on.exit(file.remove(file), add = TRUE)
if (system2('git', 'status', stderr = FALSE) == 0) system2('git', 'pull')
server = server[1]
server = switch(
server,
'ftp' = paste0(server, '://win-builder.r-project.org/'),
'https' = paste0(server, '://win-builder.r-project.org/upload.aspx'),
server
)
res = if (grepl('^ftp://', server)) {
lapply(version, upload_ftp, file = file, server = server)
} else {
vers = c('R-devel' = 2, 'R-release' = 1, 'R-oldrelease' = 3)
params = list(
FileUpload = file,
Button = 'Upload File',
# perhaps we should read these tokens dynamically from
# https://win-builder.r-project.org/upload.aspx
`__VIEWSTATE` = '/wEPDwULLTE0OTY5NTg0MTUPZBYCAgIPFgIeB2VuY3R5cGUFE211bHRpcGFydC9mb3JtLWRhdGFkZFHMrNH6JjHTyJ00T0dAADGf4oa0',
`__VIEWSTATEGENERATOR` = '69164837',
`__EVENTVALIDATION` = '/wEWBQKksYbrBgKM54rGBgK7q7GGCAKF2fXbAwLWlM+bAqR2dARbCNfKVu0vDawqWYgB5kKI'
)
lapply(version, function(i) {
names(params)[1:2] = paste0(names(params)[1:2], vers[i])
if (Sys.which('curl') == '') {
h = curl::new_handle()
params[[1]] = curl::form_file(params[[1]])
curl::handle_setform(h, .list = params)
curl::curl_fetch_memory(server, h)$status_code
} else {
params[1] = paste0('@', params[1])
system2('curl', shQuote(c(
rbind('-F', paste(names(params), params, sep = '=')),
server
)), stdout = FALSE)
}
})
}
if (solaris) rhub::check_on_solaris(
file, check_args = '--no-manual', show_status = FALSE,
env_vars = c(`_R_CHECK_FORCE_SUGGESTS_` = 'false')
)
setNames(unlist(res), version)
}
xfun/R/base64.R 0000644 0001750 0001750 00000006022 14057724152 013003 0 ustar nilesh nilesh #' Encode/decode data into/from base64 encoding.
#'
#' The function \code{base64_encode()} encodes a file or a raw vector into the
#' base64 encoding. The function \code{base64_decode()} decodes data from the
#' base64 encoding.
#' @param x For \code{base64_encode()}, a raw vector. If not raw, it is assumed
#' to be a file or a connection to be read via \code{readBin()}. For
#' \code{base64_decode()}, a string.
#' @param from If provided (and \code{x} is not provided), a connection or file
#' to be read via \code{readChar()}, and the result will be passed to the
#' argument \code{x}.
#' @return \code{base64_encode()} returns a character string.
#' \code{base64_decode()} returns a raw vector.
#' @useDynLib xfun, .registration = TRUE
#' @export
#' @examples xfun::base64_encode(as.raw(1:10))
#' logo = xfun:::R_logo()
#' xfun::base64_encode(logo)
base64_encode = function(x) {
if (!is.raw(x)) x = read_bin(x)
.Call('base64_enc', x, PACKAGE = 'xfun')
}
#' @export
#' @rdname base64_encode
#' @examples xfun::base64_decode("AQIDBAUGBwgJCg==")
base64_decode = function(x, from = NA) {
if (!is.na(from)) {
if (!missing(x)) stop("Please provide either 'x' or 'from', but not both.")
x = readChar(from, file.size(from), TRUE)
}
if (!is.character(x) || length(x) != 1) stop("'x' must be a single character string.")
.Call('base64_dec', x, PACKAGE = 'xfun')
}
# an R implementation of base64 encoding by Wush Wu moved from knitr (of
# historic interest only): https://github.com/yihui/knitr/pull/324
base64_encode_r = function(x) {
if (!is.raw(x)) x = read_bin(x)
chars = c(LETTERS, letters, 0:9, '+', '/')
n = length(s <- as.integer(x))
res = rep(NA, (n + 2) / 3 * 4)
i = 0L # index of res vector
j = 1L # index of base64_table
while (n > 2L) {
res[i <- i + 1L] = chars[s[j] %/% 4L + 1L]
res[i <- i + 1L] = chars[16 * (s[j] %% 4L) + s[j + 1L] %/% 16 + 1L]
res[i <- i + 1L] = chars[4L * (s[j + 1L] %% 16) + s[j + 2L] %/% 64L + 1L]
res[i <- i + 1L] = chars[s[j + 2L] %% 64L + 1L]
j = j + 3L
n = n - 3L
}
if (n) {
res[i <- i + 1L] = chars[s[j] %/% 4L + 1L]
if (n > 1L) {
res[i <- i + 1L] = chars[16 * (s[j] %% 4L) + s[j + 1L] %/% 16 + 1L]
res[i <- i + 1L] = chars[4L * (s[j + 1L] %% 16) + 1L]
res[i <- i + 1L] = '='
} else {
res[i <- i + 1L] = chars[16 * (s[j] %% 4L) + 1L]
res[i <- i + 1L] = '='
res[i <- i + 1L] = '='
}
}
paste(res[!is.na(res)], collapse = '')
}
#' Generate the Data URI for a file
#'
#' Encode the file in the base64 encoding, and add the media type. The data URI
#' can be used to embed data in HTML documents, e.g., in the \code{src}
#' attribute of the \verb{ } tag.
#' @param x A file path.
#' @return A string of the form \verb{data:
)
m = gregexpr('(?<=^|[\\s])[$](?! )[^$]+?(?Download filename}. The file can be downloaded when
#' the link is clicked in modern web browsers. For a directory, it will be
#' compressed as a zip archive first, and the zip file is passed to
#' \code{embed_file()}. For multiple files, they are also compressed to a zip
#' file first.
#'
#' These functions can be called in R code chunks in R Markdown documents with
#' HTML output formats. You may embed an arbitrary file or directory in the HTML
#' output file, so that readers of the HTML page can download it from the
#' browser. A common use case is to embed data files for readers to download.
#' @param path Path to the file(s) or directory.
#' @param name The default filename to use when downloading the file. Note that
#' for \code{embed_dir()}, only the base name (of the zip filename) will be
#' used.
#' @param text The text for the hyperlink.
#' @param ... For \code{embed_file()}, additional arguments to be passed to
#' \code{htmltools::a()} (e.g., \code{class = 'foo'}). For \code{embed_dir()}
#' and \code{embed_files()}, arguments passed to \code{embed_file()}.
#' @note Windows users may need to install Rtools to obtain the \command{zip}
#' command to use \code{embed_dir()} and \code{embed_files()}.
#'
#' These functions require R packages \pkg{mime} and \pkg{htmltools}. If you
#' have installed the \pkg{rmarkdown} package, these packages should be
#' available, otherwise you need to install them separately.
#'
#' Currently Internet Explorer does not support downloading embedded files
#' (\url{https://caniuse.com/#feat=download}). Chrome has a 2MB limit on the
#' file size.
#' @return An HTML tag \samp{} with the appropriate attributes.
#' @export
#' @examples
#' logo = xfun:::R_logo()
#' link = xfun::embed_file(logo, text = 'Download R logo')
#' link
#' if (interactive()) htmltools::browsable(link)
embed_file = function(path, name = basename(path), text = paste('Download', name), ...) {
h = paste0("data:", mime::guess_type(path), ";base64,", base64_encode(path))
htmltools::a(text, href = h, download = name, ...)
}
#' @rdname embed_file
#' @export
embed_dir = function(path, name = paste0(normalize_path(path), '.zip'), ...) {
name = gsub('/', '', basename(name))
in_dir(path, {
name = file.path(tempdir(), name); on.exit(file.remove(name), add = TRUE)
zip(name, '.'); embed_file(name, ...)
})
}
#' @rdname embed_file
#' @export
embed_files = function(path, name = with_ext(basename(path[1]), '.zip'), ...) {
name = file.path(tempdir(), basename(name))
on.exit(file.remove(name), add = TRUE)
zip(name, path)
embed_file(name, ...)
}
zip = function(name, ...) {
if (utils::zip(name, ...) != 0) stop('Failed to create the zip archive ', name)
invisible(0)
}
xfun/R/session.R 0000644 0001750 0001750 00000012202 14133423044 013366 0 ustar nilesh nilesh #' An alternative to sessionInfo() to print session information
#'
#' This function tweaks the output of \code{\link{sessionInfo}()}: (1) It adds
#' the RStudio version information if running in the RStudio IDE; (2) It removes
#' the information about matrix products, BLAS, and LAPACK; (3) It removes the
#' names of base R packages; (4) It prints out package versions in a single
#' group, and does not differentiate between loaded and attached packages.
#'
#' It also allows you to only print out the versions of specified packages (via
#' the \code{packages} argument) and optionally their recursive dependencies.
#' For these specified packages (if provided), if a function
#' \code{xfun_session_info()} exists in a package, it will be called and
#' expected to return a character vector to be appended to the output of
#' \code{session_info()}. This provides a mechanism for other packages to inject
#' more information into the \code{session_info} output. For example,
#' \pkg{rmarkdown} (>= 1.20.2) has a function \code{xfun_session_info()} that
#' returns the version of Pandoc, which can be very useful information for
#' diagnostics.
#' @param packages A character vector of package names, of which the versions
#' will be printed. If not specified, it means all loaded and attached
#' packages in the current R session.
#' @param dependencies Whether to print out the versions of the recursive
#' dependencies of packages.
#' @return A character vector of the session information marked as
#' \code{\link{raw_string}()}.
#' @export
#' @examplesIf interactive()
#' xfun::session_info()
#' if (xfun::loadable('MASS')) xfun::session_info('MASS')
session_info = function(packages = NULL, dependencies = TRUE) {
res = sessionInfo()
res$matprod = res$BLAS = res$LAPACK = NULL
if (loadable('rstudioapi') && rstudioapi::isAvailable()) {
res$running = paste0(res$running, ', RStudio ', rstudioapi::getVersion())
}
tweak_info = function(obj, extra = NULL) {
res = capture.output(print(obj))
i = grep('^(attached base packages|Matrix products):\\s*$', res, ignore.case = TRUE)
if (length(i)) res = res[-c(i, i + 1)]
res = gsubi('^\\s*locale:\\s*$', 'Locale:', res)
res = gsub('^\\s*\\[[0-9]+]\\s*', ' ', res) # remove vector indices like [1]
res = gsubi('^\\s*other attached packages:\\s*$', 'Package version:', res)
# print the locale info on a single line if possible
if (length(i <- which(res == 'Locale:')) == 1 && res[i + 2] == '') {
res[i] = paste(res[i], gsub('\\s*/\\s*', ' / ', gsub('^\\s+', '', res[i + 1])))
res = res[-(i + 1)]
}
raw_string(c(res, extra))
}
version_info = function(pkgs) {
res = lapply(pkgs, function(p) {
list(Version = as.character(packageVersion(p)), Package = p)
})
as.list(setNames(res, pkgs))
}
res$basePkgs = raw_string(list())
info = c(res$otherPkgs, res$loadedOnly)
if (length(packages) > 0) {
info = info[intersect(names(info), packages)]
info = c(info, version_info(setdiff(packages, names(info))))
}
res$loadedOnly = NULL
if (dependencies) {
deps = pkg_dep(names(info), installed.packages(), recursive = TRUE)
deps = sort(setdiff(deps, names(info)))
info = c(info, version_info(deps))
}
if (length(packages) > 0 || dependencies) info = info[sort(names(info))]
res$otherPkgs = info
extra = unlist(lapply(packages, function(p) tryCatch(
c('', getFromNamespace('xfun_session_info', p)()), error = function(e) NULL)
))
tweak_info(res, extra)
}
#' Perform a task once in an R session
#'
#' Perform a task once in an R session, e.g., emit a message or warning. Then
#' give users an optional hint on how not to perform this task at all.
#' @param task Any R code expression to be evaluated once to perform a task,
#' e.g., \code{warning('Danger!')} or \code{message('Today is ', Sys.Date())}.
#' @param option An R option name. This name should be as unique as possible in
#' \code{\link{options}()}. After the task has been successfully performed,
#' this option will be set to \code{FALSE} in the current R session, to
#' prevent the task from being performed again the next time when
#' \code{do_once()} is called.
#' @param hint A character vector to provide a hint to users on how not to
#' perform the task or see the message again in the current R session. Set
#' \code{hint = ""} if you do not want to provide the hint.
#' @return The value returned by the \code{task}, invisibly.
#' @export
#' @examples
#' do_once(message("Today's date is ", Sys.Date()), "xfun.date.reminder")
#' # if you run it again, it will not emit the message again
#' do_once(message("Today's date is ", Sys.Date()), "xfun.date.reminder")
#'
#' do_once({Sys.sleep(2); 1 + 1}, "xfun.task.1plus1")
#' do_once({Sys.sleep(2); 1 + 1}, "xfun.task.1plus1")
do_once = function(task, option, hint = c(
'You will not see this message again in this R session.',
'If you never want to see this message,',
sprintf('you may set options(%s = FALSE) in your .Rprofile.', option)
)) {
if (isFALSE(getOption(option))) return(invisible())
task
hint = paste(hint, collapse = ' ')
if (hint != '') message(hint)
options(setNames(list(FALSE), option))
invisible(task)
}
xfun/R/packages.R 0000644 0001750 0001750 00000033624 14133362673 013506 0 ustar nilesh nilesh #' Attach or load packages, and automatically install missing packages if
#' requested
#'
#' \code{pkg_attach()} is a vectorized version of \code{\link{library}()} over
#' the \code{package} argument to attach multiple packages in a single function
#' call. \code{pkg_load()} is a vectorized version of
#' \code{\link{requireNamespace}()} to load packages (without attaching them).
#' The functions \code{pkg_attach2()} and \code{pkg_load2()} are wrappers of
#' \code{pkg_attach(install = TRUE)} and \code{pkg_load(install = TRUE)},
#' respectively. \code{loadable()} is an abbreviation of
#' \code{requireNamespace(quietly = TRUE)}. \code{pkg_available()} tests if a
#' package with a minimal version is available.
#'
#' These are convenience functions that aim to solve these common problems: (1)
#' We often need to attach or load multiple packages, and it is tedious to type
#' several \code{library()} calls; (2) We are likely to want to install the
#' packages when attaching/loading them but they have not been installed.
#' @param ... Package names (character vectors, and must always be quoted).
#' @param install Whether to automatically install packages that are not
#' available using \code{\link{install.packages}()}. Besides \code{TRUE} and
#' \code{FALSE}, the value of this argument can also be a function to install
#' packages (\code{install = TRUE} is equivalent to \code{install =
#' install.packages}), or a character string \code{"pak"} (equivalent to
#' \code{install = pak::pkg_install}, which requires the \pkg{pak} package).
#' You are recommended to set a CRAN mirror in the global option \code{repos}
#' via \code{\link{options}()} if you want to automatically install packages.
#' @param message Whether to show the package startup messages (if any startup
#' messages are provided in a package).
#' @return \code{pkg_attach()} returns \code{NULL} invisibly. \code{pkg_load()}
#' returns a logical vector, indicating whether the packages can be loaded.
#' @seealso \code{pkg_attach2()} is similar to \code{pacman::p_load()}, but does
#' not allow non-standard evaluation (NSE) of the \code{...} argument, i.e.,
#' you must pass a real character vector of package names to it, and all names
#' must be quoted. Allowing NSE adds too much complexity with too little gain
#' (the only gain is that it saves your effort in typing two quotes).
#' @import utils
#' @export
#' @examples library(xfun)
#' pkg_attach('stats', 'graphics')
#' # pkg_attach2('servr') # automatically install servr if it is not installed
#'
#' (pkg_load('stats', 'graphics'))
pkg_attach = function(
..., install = FALSE, message = getOption('xfun.pkg_attach.message', TRUE)
) {
if (!message) library = function(...) {
suppressPackageStartupMessages(base::library(...))
}
for (i in c(...)) {
if (!isFALSE(install) && !loadable(i)) pkg_install(i, install)
library(i, character.only = TRUE)
}
}
#' @param error Whether to signal an error when certain packages cannot be loaded.
#' @rdname pkg_attach
#' @export
pkg_load = function(..., error = TRUE, install = FALSE) {
n = length(pkg <- c(...)); res = logical(n)
if (n == 0) return(invisible(res))
for (i in seq_len(n)) {
res[i] = loadable(p <- pkg[i])
if (!isFALSE(install) && !res[i]) {
pkg_install(p, install); res[i] = loadable(p)
}
}
if (error && any(!res)) stop('Package(s) not loadable: ', paste(pkg[!res], collapse = ' '))
invisible(res)
}
#' @param pkg A single package name.
#' @param strict If \code{TRUE}, use \code{\link{requireNamespace}()} to test if
#' a package is loadable; otherwise only check if the package is in
#' \code{\link{.packages}(TRUE)} (this does not really load the package, so it
#' is less rigorous but on the other hand, it can keep the current R session
#' clean).
#' @param new_session Whether to test if a package is loadable in a new R
#' session. Note that \code{new_session = TRUE} implies \code{strict = TRUE}.
#' @rdname pkg_attach
#' @export
loadable = function(pkg, strict = TRUE, new_session = FALSE) {
if (length(pkg) != 1L) stop("'pkg' must be a character vector of length one")
if (new_session) {
Rscript(c('-e', shQuote(sprintf('library("%s")', pkg))), stdout = FALSE, stderr = FALSE) == 0
} else {
if (strict) {
suppressPackageStartupMessages(requireNamespace(pkg, quietly = TRUE))
} else pkg %in% .packages(TRUE)
}
}
#' @param version A minimal version number. If \code{NULL}, only test if a
#' package is available and do not check its version.
#' @rdname pkg_attach
#' @export
pkg_available = function(pkg, version = NULL) {
loadable(pkg) && (is.null(version) || packageVersion(pkg) >= version)
}
#' @rdname pkg_attach
#' @export
pkg_attach2 = function(...) pkg_attach(..., install = TRUE)
#' @rdname pkg_attach
#' @export
pkg_load2 = function(...) pkg_load(..., install = TRUE)
pkg_update = function(...) {
update.packages(ask = FALSE, checkBuilt = TRUE, ...)
}
# allow users to specify a custom install.packages() function via the global
# option xfun.install.packages
pkg_install = function(pkgs, install = TRUE, ...) {
if (length(pkgs) == 0) return()
# in case the CRAN repo is not set up
repos = getOption('repos')
if (length(repos) == 0 || identical(repos, c(CRAN = '@CRAN@'))) {
opts = options(repos = c(CRAN = 'https://cran.rstudio.com'))
on.exit(options(opts), add = TRUE)
}
if (length(pkgs) > 1)
message('Installing ', length(pkgs), ' packages: ', paste(pkgs, collapse = ' '))
if (isTRUE(install)) install = getOption(
'xfun.install.packages',
if (is.na(Sys.getenv('RENV_PROJECT', NA)) || !loadable('renv')) install.packages else {
function(pkgs, lib = NULL, ...) renv::install(pkgs, library = lib, ...)
}
)
if (identical(install, 'pak')) install = pak::pkg_install
retry(install, pkgs, ..., .pause = 0)
}
#' Find out broken packages and reinstall them
#'
#' If a package is broken (i.e., not \code{\link{loadable}()}), reinstall it.
#'
#' Installed R packages could be broken for several reasons. One common reason
#' is that you have upgraded R to a newer \code{x.y} version, e.g., from
#' \code{4.0.5} to \code{4.1.0}, in which case you need to reinstall previously
#' installed packages.
#' @param reinstall Whether to reinstall the broken packages, or only list their
#' names.
#' @return A character vector of names of broken package.
#' @export
broken_packages = function(reinstall = TRUE) {
libs = .libPaths()
pkgs = unlist(lapply(libs, function(lib) {
p = unlist(lapply(.packages(TRUE, lib), function(p) {
if (!loadable(p, new_session = TRUE)) p
}))
if (length(p) && reinstall) {
remove.packages(p, lib); pkg_install(p, lib = lib)
}
p
}))
if(reinstall) invisible(pkgs) else pkgs
}
# remove (binary) packages that were built with a previous major-minor version of R
check_built = function(dir = '.', dry_run = TRUE) {
ext = if (xfun::is_macos()) 'tgz' else if (xfun::is_windows()) 'zip' else 'tar.gz'
r = paste0('_[-.0-9]+[.]', ext, '$')
pkgs = list.files(dir, r, full.names = TRUE)
meta = file.path(dir, 'PACKAGES')
info = if (file_exists(meta)) read.dcf(meta)
extract = if (grepl('gz$', ext)) untar else unzip
for (f in pkgs) {
d = file.path(gsub(r, '', basename(f)), 'DESCRIPTION')
extract(f, d)
if (is.na(b <- read.dcf(d, 'Built')[1, 1])) next
unlink(dirname(d), recursive = TRUE)
v = as.numeric_version(gsub('^\\s*R ([^;]+);.*', '\\1', b))
if (major_minor_smaller(v, getRversion())) {
message('The package ', f, ' was built with R ', v)
if (!dry_run) file.remove(f)
}
}
if (!is.null(info) && !dry_run) tools::write_PACKAGES(dir)
}
# is one version smaller than the other in major.minor? e.g., 4.1.0 is smaller
# than 4.2.0, but not smaller than 4.1.1
major_minor_smaller = function(v1, v2) {
v1 = unclass(v1)[[1]]
v2 = unclass(v2)[[1]]
if (length(v1) < 3 || length(v2) < 3) return(TRUE) # should return NA
v1[1] < v2[1] || v1[2] < v2[2]
}
#' Install a source package from a directory
#'
#' Run \command{R CMD build} to build a tarball from a source directory, and run
#' \command{R CMD INSTALL} to install it.
#' @param pkg The package source directory.
#' @param build Whether to build a tarball from the source directory. If
#' \code{FALSE}, run \command{R CMD INSTALL} on the directory directly (note
#' that vignettes will not be automatically built).
#' @param build_opts The options for \command{R CMD build}.
#' @param install_opts The options for \command{R CMD INSTALL}.
#' @export
#' @return Invisible status from \command{R CMD INSTALL}.
install_dir = function(pkg, build = TRUE, build_opts = NULL, install_opts = NULL) {
if (build) {
pkg = pkg_build(pkg, build_opts)
on.exit(unlink(pkg), add = TRUE)
}
res = Rcmd(c('INSTALL', install_opts, pkg))
if (res != 0) stop('Failed to install the package ', pkg)
invisible(res)
}
pkg_build = function(dir = '.', opts = NULL) {
desc = file.path(dir, 'DESCRIPTION')
pv = read.dcf(desc, fields = c('Package', 'Version'))
# delete existing tarballs
unlink(sprintf('%s_*.tar.gz', pv[1, 1]))
Rcmd(c('build', opts, shQuote(dir)))
pkg = sprintf('%s_%s.tar.gz', pv[1, 1], pv[1, 2])
if (!file_exists(pkg)) stop('Failed to build the package ', pkg)
pkg
}
# query the Homebrew dependencies of an R package
brew_dep = function(pkg) {
u = sprintf('https://sysreqs.r-hub.io/pkg/%s/osx-x86_64-clang', pkg)
x = retry(readLines, u, warn = FALSE)
x = gsub('^\\s*\\[|\\]\\s*$', '', x)
x = unlist(strsplit(gsub('"', '', x), '[, ]+'))
x = setdiff(x, 'null')
if (length(x))
message('Package ', pkg, ' requires Homebrew packages: ', paste(x, collapse = ' '))
x
}
brew_deps = function(pkgs) {
if (length(pkgs) == 0) return()
deps = pkg_brew_deps()
unlist(lapply(pkgs, function(p) {
if (is.null(deps[[p]])) brew_dep(p) else deps[[p]]
}))
}
pkg_brew_deps = function() {
con = url('https://macos.rbind.io/bin/macosx/sysreqsdb.rds')
on.exit(close(con), add = TRUE)
readRDS(con)
}
install_brew_deps = function(pkg = .packages(TRUE)) {
inst = installed.packages()
pkg = intersect(pkg, pkg_needs_compilation(inst))
deps = pkg_brew_deps()
deps = deps[c(pkg, pkg_dep(pkg, inst, recursive = TRUE))]
deps = paste(na.omit(unique(unlist(deps))), collapse = ' ')
if (deps != '') system(paste('brew install', deps))
}
pkg_needs_compilation = function(db = installed.packages()) {
pkgs = unname(db[tolower(db[, 'NeedsCompilation']) == 'yes', 'Package'])
pkgs[!is.na(pkgs)]
}
#' An alias of \code{remotes::install_github()}
#'
#' This alias is to make autocomplete faster via \code{xfun::install_github},
#' because most \code{remotes::install_*} functions are never what I want. I
#' only use \code{install_github} and it is inconvenient to autocomplete it,
#' e.g. \code{install_git} always comes before \code{install_github}, but I
#' never use it. In RStudio, I only need to type \code{xfun::ig} to get
#' \code{xfun::install_github}.
#' @param ... Arguments to be passed to
#' \code{remotes::\link[remotes]{install_github}()}.
#' @export
install_github = function(...) remotes::install_github(...)
# Remove packages not installed from CRAN
reinstall_from_cran = function(dry_run = TRUE, skip_github = TRUE) {
r = paste(c('Repository', if (skip_github) 'GithubRepo'), collapse = '|')
r = paste0('^(', r, '): ')
for (lib in .libPaths()) {
pkgs = .packages(TRUE, lib)
pkgs = setdiff(pkgs, c('xfun', 'rstudio', base_pkgs()))
for (p in pkgs) {
desc = read_utf8(system.file('DESCRIPTION', package = p, lib.loc = lib))
if (!any(grepl(r, desc))) {
if (dry_run) message(p, ': ', lib) else install.packages(p, lib = lib)
}
}
}
}
#' Convert package news to the Markdown format
#'
#' Read the package news with \code{\link{news}()}, convert the result to
#' Markdown, and write to an output file (e.g., \file{NEWS.md}). Each package
#' version appears in a first-level header, each category (e.g., \samp{NEW
#' FEATURES} or \samp{BUG FIXES}) is in a second-level header, and the news
#' items are written into bullet lists.
#' @param package,... Arguments to be passed to \code{\link{news}()}.
#' @param output The output file path.
#' @param category Whether to keep the category names.
#' @return If \code{output = NA}, returns the Markdown content as a character
#' vector, otherwise the content is written to the output file.
#' @export
#' @examples
#' # news for the current version of R
#' xfun::news2md('R', Version == getRversion(), output = NA)
news2md = function(package, ..., output = 'NEWS.md', category = TRUE) {
db = news(package = package, ...)
k = db[, 'Category']
db[is.na(k), 'Category'] = '' # replace NA category with ''
res = unlist(lapply(unique(db[, 'Version']), function(v) {
d1 = db[db[, 'Version'] == v, ]
res = unlist(lapply(unique(d1[, 'Category']), function(k) {
txt = d1[d1[, 'Category'] == k, 'Text']
txt = txt[txt != '']
if (k == '' && length(txt) == 0) return()
txt = gsub('\n *', ' ', txt)
c(if (category && k != '') paste('##', k), if (length(txt)) paste('-', txt))
}))
if (is.na(dt <- d1[1, 'Date'])) dt = '' else dt = paste0(' (', dt, ')')
c(sprintf('# CHANGES IN %s VERSION %s%s', package, v, dt), res)
}))
res = c(rbind(res, '')) # add a blank line after each line
if (is.na(output)) raw_string(res) else write_utf8(res, output)
}
#' Get base R package names
#'
#' Return names of packages from \code{\link{installed.packages}()} of which the
#' priority is \code{"base"}.
#' @return A character vector of base R package names.
#' @export
#' @examplesIf interactive()
#' xfun::base_pkgs()
base_pkgs = function() rownames(installed.packages(priority = 'base'))
# update one package (from source by default)
pkg_update_one = function(pkg, type = 'source') {
opts = options(repos = c(CRAN = 'https://cran.r-project.org'))
on.exit(options(opts), add = TRUE)
if (is.null(pkgs <- old.packages(type = type)) || !pkg %in% rownames(pkgs)) return()
install.packages(pkg, pkgs[pkg, 'LibPath'], type = type, INSTALL_opts = '--no-staged-install')
NULL
}
xfun/R/revcheck.R 0000644 0001750 0001750 00000071253 14156156426 013524 0 ustar nilesh nilesh #' Run \command{R CMD check} on the reverse dependencies of a package
#'
#' Install the source package, figure out the reverse dependencies on CRAN,
#' download all of their source packages, and run \command{R CMD check} on them
#' in parallel.
#'
#' Everything occurs under the current working directory, and you are
#' recommended to call this function under a designated directory, especially
#' when the number of reverse dependencies is large, because all source packages
#' will be downloaded to this directory, and all \file{*.Rcheck} directories
#' will be generated under this directory, too.
#'
#' If a source tarball of the expected version has been downloaded before (under
#' the \file{tarball} directory), it will not be downloaded again (to save time
#' and bandwidth).
#'
#' After a package has been checked, the associated \file{*.Rcheck} directory
#' will be deleted if the check was successful (no warnings or errors or notes),
#' which means if you see a \file{*.Rcheck} directory, it means the check
#' failed, and you need to take a look at the log files under that directory.
#'
#' The time to finish the check is recorded for each package. As the check goes
#' on, the total remaining time will be roughly estimated via \code{n *
#' mean(times)}, where \code{n} is the number of packages remaining to be
#' checked, and \code{times} is a vector of elapsed time of packages that have
#' been checked.
#'
#' If a check on a reverse dependency failed, its \file{*.Rcheck} directory will
#' be renamed to \file{*.Rcheck2}, and another check will be run against the
#' CRAN version of the package unless \code{options(xfun.rev_check.compare =
#' FALSE)} is set. If the logs of the two checks are the same, it means no new
#' problems were introduced in the package, and you can probably ignore this
#' particular reverse dependency. The function \code{compare_Rcheck()} can be
#' used to create a summary of all the differences in the check logs under
#' \file{*.Rcheck} and \file{*.Rcheck2}. This will be done automatically if
#' \code{options(xfun.rev_check.summary = TRUE)} has been set.
#'
#' A recommended workflow is to use a special directory to run
#' \code{rev_check()}, set the global \code{\link{options}}
#' \code{xfun.rev_check.src_dir} and \code{repos} in the R startup (see
#' \code{?\link{Startup}}) profile file \code{.Rprofile} under this directory,
#' and (optionally) set \code{R_LIBS_USER} in \file{.Renviron} to use a special
#' library path (so that your usual library will not be cluttered). Then run
#' \code{xfun::rev_check(pkg)} once, investigate and fix the problems or (if you
#' believe it was not your fault) ignore broken packages in the file
#' \file{00ignore}, and run \code{xfun::rev_check(pkg)} again to recheck the
#' failed packages. Repeat this process until all \file{*.Rcheck} directories
#' are gone.
#'
#' As an example, I set \code{options(repos = c(CRAN =
#' 'https://cran.rstudio.com'), xfun.rev_check.src_dir = '~/Dropbox/repo')} in
#' \file{.Rprofile}, and \code{R_LIBS_USER=~/R-tmp} in \file{.Renviron}. Then I
#' can run, for example, \code{xfun::rev_check('knitr')} repeatedly under a
#' special directory \file{~/Downloads/revcheck}. Reverse dependencies and their
#' dependencies will be installed to \file{~/R-tmp}, and \pkg{knitr} will be
#' installed from \file{~/Dropbox/repo/kintr}.
#' @param pkg The package name.
#' @param which Which types of reverse dependencies to check. See
#' \code{tools::\link[tools]{package_dependencies}()} for possible values. The
#' special value \code{'hard'} means the hard dependencies, i.e.,
#' \code{c('Depends', 'Imports', 'LinkingTo')}.
#' @param recheck A vector of package names to be (re)checked. If not provided
#' and there are any \file{*.Rcheck} directories left by certain packages
#' (this often means these packages failed the last time), \code{recheck} will
#' be these packages; if there are no \file{*.Rcheck} directories but a text
#' file \file{recheck} exists, \code{recheck} will be the character vector
#' read from this file. This provides a way for you to manually specify the
#' packages to be checked. If there are no packages to be rechecked, all
#' reverse dependencies will be checked.
#' @param ignore A vector of package names to be ignored in \command{R CMD
#' check}. If this argument is missing and a file \file{00ignore} exists, the
#' file will be read as a character vector and passed to this argument.
#' @param update Whether to update all packages before the check.
#' @param src The path of the source package directory.
#' @param src_dir The parent directory of the source package directory. This can
#' be set in a global option if all your source packages are under a common
#' parent directory.
#' @param timeout Timeout in seconds for \command{R CMD check} to check each
#' package. The (approximate) total time can be limited by the global option
#' \code{xfun.rev_check.timeout_total}.
#' @return A named numeric vector with the names being package names of reverse
#' dependencies; \code{0} indicates check success, \code{1} indicates failure,
#' and \code{2} indicates that a package was not checked due to global
#' timeout.
#' @seealso \code{devtools::revdep_check()} is more sophisticated, but currently
#' has a few major issues that affect me: (1) It always deletes the
#' \file{*.Rcheck} directories
#' (\url{https://github.com/r-lib/devtools/issues/1395}), which makes it
#' difficult to know more information about the failures; (2) It does not
#' fully install the source package before checking its reverse dependencies
#' (\url{https://github.com/r-lib/devtools/pull/1397}); (3) I feel it is
#' fairly difficult to iterate the check (ignore the successful packages and
#' only check the failed packages); by comparison, \code{xfun::rev_check()}
#' only requires you to run a short command repeatedly (failed packages are
#' indicated by the existing \file{*.Rcheck} directories, and automatically
#' checked again the next time).
#'
#' \code{xfun::rev_check()} borrowed a very nice feature from
#' \code{devtools::revdep_check()}: estimating and displaying the remaining
#' time. This is particularly useful for packages with huge numbers of reverse
#' dependencies.
#' @export
rev_check = function(
pkg, which = 'all', recheck = NULL, ignore = NULL, update = TRUE,
timeout = getOption('xfun.rev_check.timeout', 15 * 60),
src = file.path(src_dir, pkg), src_dir = getOption('xfun.rev_check.src_dir')
) {
if (length(src) != 1 || !dir_exists(src)) stop(
'The package source dir (the "src" argument) must be an existing directory'
)
message('Installing the source package ', src)
install_dir(path.expand(src))
db = available.packages(type = 'source')
# install packages that are not loadable (testing in parallel)
p_install = function(pkgs) {
pkgs_up = NULL
if (update) {
message('Updating all R packages...')
pkgs_up = intersect(old.packages(checkBuilt = TRUE)[, 'Package'], pkgs)
pkg_install(pkgs_up)
}
pkgs = setdiff(pkgs, pkgs_up) # don't install pkgs that were just updated
print(system.time(
pkg_install(unlist(plapply(pkgs, function(p) if (!loadable(p, new_session = TRUE)) p)))
))
}
unlink('*.Rcheck2', recursive = TRUE)
if (missing(recheck)) {
dirs = list.files('.', '.+[.]Rcheck$')
pkgs = gsub('.Rcheck$', '', dirs)
recheck = if (length(pkgs) == 0 && file_exists('recheck')) {
scan('recheck', 'character')
} else pkgs
}
pkgs = if (length(recheck)) {
p_install(pkg_dep(recheck, db, which = 'all'))
recheck
} else {
res = check_deps(pkg, db, which)
message('Installing dependencies of reverse dependencies')
res$install = setdiff(res$install, ignore_deps())
print(system.time(p_install(res$install)))
res$check
}
pkgs = intersect(pkgs, rownames(db)) # make sure the pkgs are on CRAN
lib_cran = './library-cran'
on.exit(unlink(lib_cran, recursive = TRUE), add = TRUE)
dir.create(lib_cran, showWarnings = FALSE)
pkg_install(pkg, lib = lib_cran) # the CRAN version of the package
f = tempfile('check-done', fileext = '.rds')
l = tempfile('check-lock'); on.exit(unlink(c(f, l)), add = TRUE)
n = length(pkgs)
if (n == 0) {
message('No reverse dependencies to be checked for the package ', pkg); return()
}
if (missing(ignore) && file_exists('00ignore')) ignore = scan('00ignore', 'character')
if (length(ignore)) {
message('Ignoring packages: ', paste(ignore, collapse = ' '))
unlink(sprintf('%s.Rcheck', ignore), recursive = TRUE)
pkgs = setdiff(pkgs, ignore)
if ((n <- length(pkgs)) == 0) {
message('No packages left to be checked'); return()
}
}
message('Downloading tarballs')
tars = download_tarball(pkgs, db, dir = 'tarball')
tars = setNames(tars, pkgs)
t0 = Sys.time()
tt = getOption('xfun.rev_check.timeout_total', Inf)
message('Checking ', n, ' packages: ', paste(pkgs, collapse = ' '))
res = plapply(pkgs, function(p) {
d = sprintf('%s.Rcheck', p)
if (!p %in% rownames(db)) {
message('Checking ', p, ' (aborted since it is no longer on CRAN')
unlink(d, recursive = TRUE)
return()
}
timing = function() {
# in case two packages finish at exactly the same time
while (file_exists(l)) Sys.sleep(.1)
file.create(l); on.exit(unlink(l), add = TRUE)
done = c(if (file_exists(f)) readRDS(f), p)
saveRDS(done, f)
n2 = length(setdiff(pkgs, done)) # remaining packages
t1 = Sys.time(); t2 = Sys.time() + n2 * (t1 - t0) / (n - n2)
message(
'Packages remaining: ', n2, '/', n, '; Expect to finish at ', t2,
' (', format(round(difftime(t2, t1))), ')'
)
# 0 (FALSE): success; 1: failure
setNames(as.integer(dir_exists(d)), p)
}
if (!file_exists(z <- tars[p])) {
dir.create(d, showWarnings = FALSE)
return(timing())
}
# timeout; package not checked
if (difftime(Sys.time(), t0, units = 'secs') > tt) {
return(setNames(2L, p))
}
check_it = function(args = NULL, ...) {
system2(
file.path(R.home('bin'), 'R'),
c(args, 'CMD', 'check', '--no-manual', shQuote(z)),
stdout = FALSE, stderr = FALSE, timeout = timeout, ...
)
}
check_it()
if (!clean_Rcheck(d)) {
if (!dir_exists(d)) {dir.create(d); return(timing())}
# try to install missing LaTeX packages for vignettes if possible, then recheck
vigs = list.files(
file.path(d, 'vign_test', p, 'vignettes'), '[.](Rnw|Rmd)$',
ignore.case = TRUE, full.names = TRUE
)
pkg_load2('tinytex')
if (length(vigs) && any(file_exists(with_ext(vigs, 'log')))) {
if (tinytex::is_tinytex()) for (vig in vigs) in_dir(dirname(vig), {
Rscript(shQuote(c('-e', 'if (grepl("[.]Rnw$", f <- commandArgs(T), ignore.case = T)) knitr::knit2pdf(f) else rmarkdown::render(f)', basename(vig))))
})
check_it()
if (clean_Rcheck(d)) return(timing())
}
# if there are still missing LaTeX packages, install them and recheck
l0 = tinytex::tl_pkgs()
lapply(
list.files(d, '[.]log$', full.names = TRUE, recursive = TRUE),
tinytex::parse_install, quiet = TRUE
)
if (!identical(l0, tinytex::tl_pkgs())) {
check_it()
if (clean_Rcheck(d)) return(timing())
}
# clean up the check log, and recheck with the current CRAN version of pkg
cleanup = function() in_dir(d, {
clean_log()
# so that I can easily preview it in the Finder on macOS
file_exists('00install.out') && file.rename('00install.out', '00install.log')
})
# ignore vignettes that failed to build for unknown reasons
cleanup()
if (clean_Rcheck(d)) return(timing())
# whether to check the package against the CRAN version?
if (!getOption('xfun.rev_check.compare', TRUE)) return(timing())
file.rename(d, d2 <- paste0(d, '2'))
check_it('--no-environ', env = tweak_r_libs(lib_cran))
if (!dir_exists(d)) file.rename(d2, d) else {
cleanup()
if (identical_logs(c(d, d2))) unlink(c(d, d2), recursive = TRUE)
}
}
timing()
})
if (getOption('xfun.rev_check.summary', FALSE)) {
html = compare_Rcheck(); if (isTRUE(grepl('[.]html$', html))) browseURL(html)
}
unlist(res)
}
# remove the OK lines in the check log
clean_log = function() {
if (!file_exists(l <- '00check.log')) return()
x = grep('^[*].+OK$', read_utf8(l), invert = TRUE, value = TRUE)
# don't want diffs in random tempdir/tempfile paths when comparing check logs
x[grep(dirname(tempdir()), x, fixed = TRUE)] = 'RANDOM TEMPDIR/TEMPFILE PATH DELETED'
# delete the download progress
x = grep('^\\s*\\[\\d+%] Downloaded \\d+ bytes...\\s*$', x, invert = TRUE, value = TRUE)
# delete lines of the form "address 0x1067143eb, cause 'illegal opcode'"
x = grep("address 0x[[:xdigit:]]+, cause '[^']+'", x, invert = TRUE, value = TRUE)
x = recheck_vig(x)
x = tail(x, -2)
writeLines(x, l) # remove the first 2 lines (log dir name and R version)
x
}
# sometimes R CMD check fails to build vignettes for unknown reasons; try to
# recheck the package in this case
recheck_vig = function(x) {
if (!any(i1 <- (x == '* checking re-building of vignette outputs ... WARNING')))
return(x)
i1 = which(i1)[1]
i2 = which(x == 'Execution halted')
i2 = i2[i2 > i1]
if (length(i2) == 0) return(x)
i3 = grep('^[*] checking ', x) # next checking item
i3 = i3[i3 > i1]
if (length(i3)) {
i2 = i2[i2 < i3[1]] # 'Execution halted' needs to appear before next '* checking'
if (length(i2) == 0) return(x)
}
# if no explicit errors were found in processing vignettes, remove the relevant log
i2 = tail(i2, 1)
if (length(grep('Error: processing vignette .+ failed with diagnostics:', x[i1:i2])) == 0)
x = x[-(i1:i2)]
x
}
# are the check logs identical under a series of *.Rcheck directories?
identical_logs = function(dirs) {
if (length(dirs) < 2) return(FALSE)
if (!all(file_exists(logs <- file.path(dirs, '00check.log')))) return(FALSE)
x = read_utf8(logs[1])
for (i in 2:length(dirs)) if (!identical(x, read_utf8(logs[i]))) return(FALSE)
TRUE
}
# delete files/dirs that are usually not helpful
clean_Rcheck2 = function(dir = '.') {
owd = setwd(dir); on.exit(setwd(owd), add = TRUE)
ds = list.files('.', '.+[.]Rcheck$')
for (d in c(ds, paste0(ds, '2'))) {
f1 = list.files(d, full.names = TRUE)
f2 = file.path(d, c('00_pkg_src', '00check.log', '00install.log'), fsep = '/')
unlink(setdiff(f1, f2), recursive = TRUE)
}
}
# add a new library path to R_LIBS_USER
tweak_r_libs = function(new) {
x = read_all(existing_files(c('~/.Renviron', '.Renviron')))
x = grep('^\\s*#', x, invert = TRUE, value = TRUE)
x = gsub('^\\s+|\\s+$', '', x)
x = x[x != '']
i = grep('^R_LIBS_USER=.+', x)
if (length(i)) {
x[i[1]] = sub('(="?)', path_sep('\\1', new), x[i[1]])
x
} else {
v = Sys.getenv('R_LIBS_USER')
v = if (v == '') new else path_sep(new, v)
c(paste0('R_LIBS_USER=', v), x)
}
}
# separate paths by the path separator on a specific platform
path_sep = function(...) paste(..., sep = .Platform$path.sep)
# a shorthand of tools::package_dependencies()
pkg_dep = function(x, ...) {
if (length(x)) unique(unlist(tools::package_dependencies(x, ...)))
}
# calculate the packages required to check a package
check_deps = function(x, db = available.packages(), which = 'all') {
if (identical(which, 'hard')) which = c('Depends', 'Imports', 'LinkingTo')
x0 = db[, 'Package'] # all available packages
# packages that reverse depend on me
x1 = pkg_dep(x, db, which, reverse = TRUE)
x1 = intersect(x1, x0)
# only check a sample of soft reverse dependencies (useful if there are too many)
if (identical(which, 'all') && (n <- getOption('xfun.rev_check.sample', 100)) >= 0) {
x2 = pkg_dep(x, db, c('Suggests', 'Enhances'), reverse = TRUE)
x2 = intersect(x2, x0)
if (n < length(x2)) x1 = c(setdiff(x1, x2), sample(x2, n))
}
# to R CMD check x1, I have to install all their dependencies
x2 = pkg_dep(x1, db, 'all')
# and for those dependencies, I have to install the default dependencies
x3 = pkg_dep(x2, db, recursive = TRUE)
list(check = x1, install = intersect(c(x1, x2, x3), x0))
}
#' Submit check jobs to crandalf
#'
#' Check the reverse dependencies of a package using the crandalf service:
#' \url{https://github.com/yihui/crandalf}. If the number of reverse
#' dependencies is large, they will be split into batches and pushed to crandalf
#' one by one.
#'
#' Due to the time limit of a single job on Github Actions (6 hours), you will
#' have to split the large number of reverse dependencies into batches and check
#' them sequentially on Github (at most 5 jobs in parallel). The function
#' \code{crandalf_check()} does this automatically when necessary. It requires
#' the \command{git} command to be available.
#'
#' The function \code{crandalf_results()} fetches check results from Github
#' after all checks are completed, merge the results, and show a full summary of
#' check results. It requires \code{gh} (Github CLI:
#' \url{https://cli.github.com/manual/}) to be installed and you also need to
#' authenticate with your Github account beforehand.
#' @param pkg The package name of which the reverse dependencies are to be
#' checked.
#' @param size The number of reverse dependencies to be checked in each job.
#' @param jobs The number of jobs to run in Github Actions (by default, all jobs
#' are submitted, but you can choose to submit the first few jobs).
#' @param which The type of dependencies (see \code{\link{rev_check}()}).
#' @export
crandalf_check = function(pkg, size = 400, jobs = Inf, which = 'all') {
git_test_branch()
git_co('main')
on.exit(git_co('main'), add = TRUE)
git_test_branch()
# do everything inside the check-pkg branch
b = paste0('check-', pkg)
if (git_co(b, stderr = FALSE) != 0) {
git_co(c('-b', b))
writeLines('# placeholder', 'recheck')
git(c('add', 'recheck'))
git(c('commit', '-m', shQuote(paste('Revcheck', pkg))))
git('push')
message(
'Please create a pull request from the branch ', b,
' on Github and re-run xfun::crandalf_check("', pkg, '").'
)
return(invisible())
}
git(c('merge', 'main'))
x = check_deps(pkg, which = which)$check
n = length(x)
if (n <= size) {
message('No need to split ', n, ' reverse dependencies into batches of size ', size, '.')
if (any(grepl('Your branch is ahead of ', git('status', stdout = TRUE)))) {
git('push')
} else if (Sys.which('gh') != '') {
gh(c('workflow', 'run', 'rev-check.yaml', '--ref', b))
message('Triggering rev-check.yaml job against ', b, ' branch in crandalf repo on Github.')
} else {
message('Remember to re-run the last job for the package ', pkg, ' on Github.')
}
return(invisible())
}
b = ceiling(n/size)
i = rep(seq_len(b), each = size)[seq_len(n)]
k = 1
# use an id in the commit so that I know which jobs are for the same pkg
id = format(Sys.time(), '%Y%m%d%H%M')
for (p in head(split(x, i), jobs)) {
message('Batch ', k)
writeLines(p, 'recheck')
git(c('add', 'recheck'))
git(c('commit', '-m', shQuote(paste(
c(id, 'checking:', head(p, 3), '...'), collapse = ' '
))))
git('push')
Sys.sleep(10)
k = k + 1
}
}
#' @param repo The crandalf repo on Github (of the form \code{user/repo} such as
#' \code{"yihui/crandalf"}). Usually you do not need to specify it, unless you
#' are not calling this function inside the crandalf project, because
#' \command{gh} should be able to figure out the repo automatically.
#' @param limit The maximum of records for \command{gh run list} to retrieve.
#' You only need a larger number if the check results are very early in the
#' Github Action history.
#' @param wait Number of seconds to wait if not all jobs have been completed on
#' Github. By default, this function checks the status every 5 minutes until
#' all jobs are completed. Set \code{wait} to 0 to disable waiting (and throw
#' an error immediately when any jobs are not completed).
#' @rdname crandalf_check
#' @export
crandalf_results = function(pkg, repo = NA, limit = 200, wait = 5 * 60) {
res = crandalf_jobs(pkg, repo, limit)
if (NROW(res) == 0) {
stop('Did not find check results for ', pkg, ' from Github Actions.')
}
if (any(res[, 1] != 'completed')) {
if (wait <= 0) stop('Please wait till all jobs have been completed on Github Actions.')
status = NULL
repeat {
res = crandalf_jobs(pkg, repo, limit)
if (all(res[, 1] == 'completed')) break
if (is.null(status) || !identical(status, table(res[, 1]))) {
status = table(res[, 1])
timestamp()
print(status)
}
Sys.sleep(wait)
}
}
ids = grep_sub('^(\\d+) checking: .+', '\\1', res[, 3])
i = if (length(ids) > 0) grep(sprintf('^%s checking: ', ids[1]), res[, 3]) else 1
res = res[i, , drop = FALSE]
res = res[res[, 2] == 'failure', , drop = FALSE]
if (NROW(res) == 0) {
stop('Did not find any failed results on Github Actions.')
}
for (i in seq_len(nrow(res))) {
message('Downloading check results (', i, '/', nrow(res), ')')
gh_run('download', res[i, 7], '-D', tempfile('crandalf-', '.'), repo = repo)
}
if (interactive()) browseURL(crandalf_merge(pkg))
}
# retrieve the first N jobs info
crandalf_jobs = function(pkg, repo = NA, limit = 200) {
res = gh_run('list', '-L', limit, '-w', 'rev-check', repo = repo)
res = res[grep(paste0('rev-check\tcheck-', pkg), res)]
do.call(rbind, strsplit(res, '\t'))
}
crandalf_merge = function(pkg) {
unlink(list.files('.', '[.]Rcheck2?$'), recursive = TRUE)
x1 = x2 = x3 = NULL
f1 = '00check_diffs.html'; f3 = 'latex.txt'
for (d in list.files('.', '^crandalf-.+')) {
if (!dir_exists(d)) next
p = file.path(d, 'macOS-rev-check-results')
if (file_exists(f <- file.path(p, f1))) {
x = read_utf8(f)
x1 = if (length(x1) == 0) x else {
i1 = grep('', x)[1]
i2 = tail(grep('', x), 1)
i3 = tail(grep('
After writing about 20 R packages, I found I had accumulated several utility functions that I used across different packages, so I decided to extract them into a separate package. Previously I had been using the evil triple-colon :::
to access these internal utility functions. Now with xfun, these functions have been exported, and more importantly, documented. It should be better to use them under the sun instead of in the dark.
This page shows examples of a subset of functions in this package. For a full list of functions, see the help page help(package = 'xfun')
. The source package is available on Github: https://github.com/yihui/xfun.
I have been bitten many times by partial matching in lists, e.g., when I want x$a
but the element a
does not exist in the list x
, it returns the value x$abc
if abc
exists in x
. A strict list is a list for which the partial matching of the $
operator is disabled. The functions xfun::strict_list()
and xfun::as_strict_list()
are the equivalents to base::list()
and base::as.list()
respectively which always return as strict list, e.g.,
library(xfun)
z = strict_list(aaa = "I am aaa", b = 1:5)) (
## $aaa
## [1] "I am aaa"
##
## $b
## [1] 1 2 3 4 5
$a # NULL (strict matching) z
## NULL
$aaa # I am aaa z
## [1] "I am aaa"
$b z
## [1] 1 2 3 4 5
$c = "you can create a new element"
z
= unclass(z) # a normal list
z2 $a # partial matching z2
## [1] "I am aaa"
= as_strict_list(z2) # a strict list again
z3 $a # NULL (strict matching) again! z3
## NULL
Similarly, the default partial matching in attr()
can be annoying, too. The function xfun::attr()
is simply a shorthand of attr(..., exact = TRUE)
.
I want it, or I do not want. There is no “I probably want”.
When R prints a character vector, your eyes may be distracted by the indices like [1]
, double quotes, and escape sequences. To see a character vector in its “raw” form, you can use cat(..., sep = '\n')
. The function raw_string()
marks a character vector as “raw”, and the corresponding printing function will call cat(sep = '\n')
to print the character vector to the console.
library(xfun)
raw_string(head(LETTERS))
A
B
C
D
E
F
x = c("a \"b\"", "hello\tworld!")) (
[1] "a \"b\"" "hello\tworld!"
raw_string(x) # this is more likely to be what you want to see
a "b"
hello world!
I have used paste(readLines('foo'), collapse = '\n')
many times before I decided to write a simple wrapper function xfun::file_string()
. This function also makes use of raw_string()
, so you can see the content of a file in the console as a side-effect, e.g.,
= system.file("LICENSE", package = "xfun")
f ::file_string(f) xfun
YEAR: 2018-2021
COPYRIGHT HOLDER: Yihui Xie
as.character(xfun::file_string(f)) # essentially a character string
[1] "YEAR: 2018-2021\nCOPYRIGHT HOLDER: Yihui Xie"
Files can be encoded into base64 strings via base64_uri()
. This is a common technique to embed arbitrary files in HTML documents (which is what xfun::embed_file()
does and it is based on base64_uri()
).
= system.file("LICENSE", package = "xfun")
f ::base64_uri(f) xfun
## [1] "data:text/plain;base64,WUVBUjogMjAxOC0yMDIxCkNPUFlSSUdIVCBIT0xERVI6IFlpaHVpIFhpZQo="
After typing the code x = grep(pattern, x, value = TRUE); gsub(pattern, '\\1', x)
many times, I combined them into a single function xfun::grep_sub()
.
::grep_sub('a([b]+)c', 'a\\U\\1c', c('abc', 'abbbc', 'addc', '123'), perl = TRUE) xfun
## [1] "aBc" "aBBBc"
I can never remember how to properly use grep
or sed
to search and replace strings in multiple files. My favorite IDE, RStudio, has not provided this feature yet (you can only search and replace in the currently opened file). Therefore I did a quick and dirty implementation in R, including functions gsub_files()
, gsub_dir()
, and gsub_ext()
, to search and replace strings in multiple files under a directory. Note that the files are assumed to be encoded in UTF-8. If you do not use UTF-8, we cannot be friends. Seriously.
All functions are based on gsub_file()
, which performs searching and replacing in a single file, e.g.,
library(xfun)
= tempfile()
f writeLines(c("hello", "world"), f)
gsub_file(f, "world", "woRld", fixed = TRUE)
file_string(f)
hello
woRld
The function gsub_dir()
is very flexible: you can limit the list of files by MIME types, or extensions. For example, if you want to do substitution in text files, you may use gsub_dir(..., mimetype = '^text/')
.
The function process_file()
is a more general way to process files. Basically it reads a file, process the content with a function that you pass to it, and writes back the text, e.g.,
process_file(f, function(x) {
rep(x, 3) # repeat the content 3 times
})file_string(f)
hello
woRld
hello
woRld
hello
woRld
WARNING: Before using these functions, make sure that you have backed up your files, or version control your files. The files will be modified in-place. If you do not back up or use version control, there is no chance to regret.
Functions file_ext()
and sans_ext()
are based on functions in tools. The function with_ext()
adds or replaces extensions of filenames, and it is vectorized.
library(xfun)
= c("abc.doc", "def123.tex", "path/to/foo.Rmd")
p file_ext(p)
## [1] "doc" "tex" "Rmd"
sans_ext(p)
## [1] "abc" "def123" "path/to/foo"
with_ext(p, ".txt")
## [1] "abc.txt" "def123.txt" "path/to/foo.txt"
with_ext(p, c(".ppt", ".sty", ".Rnw"))
## [1] "abc.ppt" "def123.sty" "path/to/foo.Rnw"
with_ext(p, "html")
## [1] "abc.html" "def123.html" "path/to/foo.html"
The function proj_root()
was inspired by the rprojroot package, and tries to find the root directory of a project. Currently it only supports R package projects and RStudio projects by default. It is much less sophisticated than rprojroot.
The function from_root()
was inspired by here::here()
, but returns a relative path (relative to the project’s root directory found by proj_root()
) instead of an absolute path. For example, xfun::from_root('data', 'cars.csv')
in a code chunk of docs/foo.Rmd
will return ../data/cars.csv
when docs/
and data/
directories are under the root directory of a project.
root/
|-- data/
| |-- cars.csv
|
|-- docs/
|-- foo.Rmd
If file paths are too much pain for you to think about, you can just pass an incomplete path to the function magic_path()
, and it will try to find the actual path recursively under subdirectories of a root directory. For example, you may only provide a base filename, and magic_path()
will look for this file under subdirectories and return the actual path if it is found. By default, it returns a relative path, which is relative to the current working directory. With the above example, xfun::magic_path('cars.csv')
in a code chunk of docs/foo.Rmd
will return ../data/cars.csv
, if cars.csv
is a unique filename in the project. You can freely move it to any folders of this project, and magic_path()
will still find it. If you are not using a project to manage files, magic_path()
will look for the file under subdirectories of the current working directory.
The series of functions is_linux()
, is_macos()
, is_unix()
, and is_windows()
test the types of the OS, using the information from .Platform
and Sys.info()
, e.g.,
::is_macos() xfun
## [1] TRUE
::is_unix() xfun
## [1] TRUE
::is_linux() xfun
## [1] FALSE
::is_windows() xfun
## [1] FALSE
Oftentimes I see users attach a series of packages in the beginning of their scripts by repeating library()
multiple times. This could be easily vectorized, and the function xfun::pkg_attach()
does this job. For example,
library(testit)
library(parallel)
library(tinytex)
library(mime)
is equivalent to
::pkg_attach(c('testit', 'parallel', 'tinytex', 'mime')) xfun
I also see scripts that contain code to install a package if it is not available, e.g.,
if (!requireNamespace('tinytex')) install.packages('tinytex')
library(tinytex)
This could be done via
::pkg_attach2('tinytex') xfun
The function pkg_attach2()
is a shorthand of pkg_attach(..., install = TRUE)
, which means if a package is not available, install it. This function can also deal with multiple packages.
The function loadable()
tests if a package is loadable.
Functions read_utf8()
and write_utf8()
can be used to read/write files in UTF-8. They are simple wrappers of readLines()
and writeLines()
.
The function numbers_to_words()
(or n2w()
for short) converts numbers to English words.
n2w(0, cap = TRUE)
## [1] "Zero"
n2w(seq(0, 121, 11), and = TRUE)
## [1] "zero" "eleven"
## [3] "twenty-two" "thirty-three"
## [5] "forty-four" "fifty-five"
## [7] "sixty-six" "seventy-seven"
## [9] "eighty-eight" "ninety-nine"
## [11] "one hundred and ten" "one hundred and twenty-one"
n2w(1e+06)
## [1] "one million"
n2w(1e+11 + 12345678)
## [1] "one hundred billion, twelve million, three hundred forty-five thousand, six hundred seventy-eight"
n2w(-987654321)
## [1] "minus nine hundred eighty-seven million, six hundred fifty-four thousand, three hundred twenty-one"
n2w(1e+15 - 1)
## [1] "nine hundred ninety-nine trillion, nine hundred ninety-nine billion, nine hundred ninety-nine million, nine hundred ninety-nine thousand, nine hundred ninety-nine"
The function cache_rds()
provides a simple caching mechanism: the first time an expression is passed to it, it saves the result to an RDS file; the next time it will read the RDS file and return the value instead of evaluating the expression again. If you want to invalidate the cache, you can use the argument rerun = TRUE
.
= xfun::cache_rds({
res # pretend the computing here is a time-consuming
Sys.sleep(2)
1:10
})
When the function is used in a code chunk in a knitr document, the RDS cache file is saved to a path determined by the chunk label (the base filename) and the chunk option cache.path
(the cache directory), so you do not have to provide the file
and dir
arguments of cache_rds()
.
This caching mechanism is much simpler than knitr’s caching. Cache invalidation is often tricky (see this post), so this function may be helpful if you want more transparency and control over when to invalidate the cache (for cache_rds()
, the cache is invalidated when the cache file is deleted, which can be achieved via the argument rerun = TRUE
).
As documented on the help page of cache_rds()
, there are two common cases in which you may want to invalidate the cache:
The code in the expression has changed, e.g., if you changed the code from cache_rds({x + 1})
to cache_rds({x + 2})
, the cache will be automatically invalidated and the expression will be re-evaluated. However, please note that changes in white spaces or comments do not matter. Or generally speaking, as long as the change does not affect the parsed expression, the cache will not be invalidated, e.g., the two expressions below are essentially identical (hence if you have executed cache_rds()
on the first expression, the second expression will be able to take advantage of the cache):
= xfun::cache_rds({
res Sys.sleep(3 );
=1:10; # semi-colons won't matter
x+1;
x
})
= xfun::cache_rds({
res Sys.sleep(3)
= 1:10 # a comment
x +
x 1 # feel free to make any changes in white spaces
})
The value of a global variable in the expression has changed, e.g., if y
has changed, you are most likely to want to invalidate the cache and rerun the expression below:
= xfun::cache_rds({
res = 1:10
x + y
x })
This is because x
is a local variable in the expression, and y
is an external global variable (not created locally like x
). To invalidate the cache when y
has changed, you may let cache_rds()
know through the hash
argument that y
needs to be considered when deciding if the cache should be invalidated:
= xfun::cache_rds({
res = 1:10
x + y
x hash = list(y)) },
If you do not want to provide this list of value(s) to the hash
argument, you may try hash = "auto"
instead, which asks cache_rds()
to try to figure out all global variables automatically and use a list of their values as the value for the hash
argument.
= xfun::cache_rds({
res = 1:10
x + y
x hash = "auto") },
Running R CMD check
on the reverse dependencies of knitr and rmarkdown is my least favorite thing in developing R packages, because the numbers of their reverse dependencies are huge. The function rev_check()
reflects some of my past experience in this process. I think I have automated it as much as possible, and made it as easy as possible to discover possible new problems introduced by the current version of the package (compared to the CRAN version). Finally I can just sit back and let it run.
The function rstudio_type()
inputs characters in the RStudio source editor as if they were typed by a human. I came up with the idea when preparing my talk for rstudio::conf 2018 (see this post for more details).
Since I have never been fully satisfied by the output of sessionInfo()
, I tweaked it to make it more useful in my use cases. For example, it is rarely useful to print out the names of base R packages, or information about the matrix products / BLAS / LAPACK. Oftentimes I want additional information in the session information, such as the Pandoc version when rmarkdown is used. The function session_info()
tweaks the output of sessionInfo()
, and makes it possible for other packages to append information in the output of session_info()
.
You can choose to print out the versions of only the packages you specify, e.g.,
::session_info(c('xfun', 'rmarkdown', 'knitr', 'tinytex'), dependencies = FALSE) xfun
## R version 4.1.1 (2021-08-10)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS Big Sur 10.16
##
## Locale: C / en_US.UTF-8 / en_US.UTF-8 / C / en_US.UTF-8 / en_US.UTF-8
##
## Package version:
## knitr_1.36.8 rmarkdown_2.11 tinytex_0.35.4 xfun_0.29
##
## Pandoc version: 2.14.2
##
## LaTeX version used:
## TeX Live 2021 (TinyTeX) with tlmgr 2021-10-04
', x1), 1) append(x1, x[(i1 + 1):(i2 - 1)], i3 - 1) } file.remove(f) } if (file_exists(f <- file.path(p, 'recheck2'))) { x2 = c(x2, read_utf8(f)) file.remove(f) } cs = list.files(p, '[.]Rcheck[2]?$', full.names = TRUE) file.rename(cs, basename(cs)) if (file_exists(f <- file.path(p, f3))) { x3 = c(x3, read_utf8(f)) file.remove(f) } unlink(d, recursive = TRUE) } write_utf8(x1, f1) # the full summary # store newly detected missing latex packages in latex.txt and commit/push git_co('main') append_unique(x3, f3) find_missing_latex() git(c('commit', '-m', shQuote('add more latex packages'), f3)) git('push') git_co(paste0('check-', pkg)) r = '[.]Rcheck2$' write_utf8(sort(unique(c(x2, gsub(r, '', list.files('.', r))))), 'recheck') f1 } # mclapply() with a different default for mc.cores and disable prescheduling plapply = function(X, FUN, ...) { parallel::mclapply( X, FUN, ..., mc.cores = getOption('mc.cores', parallel::detectCores()), mc.preschedule = FALSE ) } # download the source package from CRAN download_tarball = function(p, db = available.packages(type = 'source'), dir = '.', retry = 3) { if (!dir_exists(dir)) dir.create(dir, recursive = TRUE) z = file.path(dir, sprintf('%s_%s.tar.gz', p, db[p, 'Version'])) mapply(function(p, z) { # remove other versions of the package tarball unlink(setdiff(list.files(dir, sprintf('^%s_.+.tar.gz', p), full.names = TRUE), z)) for (i in seq_len(retry)) { if (file_exists(z)) break try(download.file(paste(db[p, 'Repository'], basename(z), sep = '/'), z, mode = 'wb')) } }, p, z, SIMPLIFY = FALSE) z } # clean up *.Rcheck if there are no warnings, errors, or notes in the log clean_Rcheck = function(dir, log = read_utf8(file.path(dir, '00check.log'))) { # do not check the status line if (length(grep('^Status: ', tail(log, 1)))) log = head(log, -1) if (length(grep('(WARNING|ERROR|NOTE)$', log)) == 0) unlink(dir, recursive = TRUE) !dir_exists(dir) } #' @rdname rev_check #' @param status_only If \code{TRUE}, only compare the final statuses of the #' checks (the last line of \file{00check.log}), and delete \file{*.Rcheck} #' and \file{*.Rcheck2} if the statuses are identical, otherwise write out the #' full diffs of the logs. If \code{FALSE}, compare the full logs under #' \file{*.Rcheck} and \file{*.Rcheck2}. #' @param output The output Markdown file to which the diffs in check logs will #' be written. If the \pkg{markdown} package is available, the Markdown file #' will be converted to HTML, so you can see the diffs more clearly. #' @export compare_Rcheck = function(status_only = TRUE, output = '00check_diffs.md') { if (length(dirs <- list.files('.', '.+[.]Rcheck$')) == 0) { # clean up the `recheck` file if (file_exists('recheck')) writeLines(character(), 'recheck') return() } d2 = function(d) c(d, paste0(d, '2')) logs = function(d) file.path(d2(d), '00check.log') res = NULL if (!status_only && Sys.which('diff') == '') warning("The command 'diff' is not available; will not calculate exact diffs in logs.") for (d in dirs) { f = existing_files(logs(d)) if (status_only && length(f) == 2) { status_line = function(file) { x = tail(read_utf8(file), 1) if (grepl('^Status: ', x)) x else { warning('The last line of ', file, ' is not the status.') NULL } } # if the check with current CRAN version of package also failed, or the # two statues are the same, chances are we are good to go s1 = status_line(f[1]) if (length(grep('Status: .*\\d+ ERROR', s1)) || identical(s1, status_line(f[2]))) { unlink(d2(d), recursive = TRUE); next } } res = c( res, paste('##', p <- sans_ext(d)), '', sprintf('[CRAN version](https://cran.rstudio.com/package=%s) (-) vs current version (+):\n', p), '```diff', file_diff(f), '```', '' ) if (length(res2 <- cran_check_page(p, NULL))) res = c( res, 'CRAN check logs:\n\n```', head_tail(unique(unlist(strsplit(res2, '\n')))), '```\n' ) } if (length(res) == 0) return() xfun::write_utf8(res, output) if (!loadable('markdown')) return(output) markdown::markdownToHTML( text = gsub('>', '+', gsub('^<', '-', res)), output = html_file <- with_ext(output, 'html'), header = c( "", "", "" ), encoding = 'UTF-8' ) if (!getOption('xfun.rev_check.keep_md', FALSE)) unlink(output) html_file } # keep the first and last n elements in x, and omit the middle head_tail = function(x, n = 10) { if (length(x) <= 2 * n) return(x) c(head(x, n), '....', tail(x, n)) } # compute the diffs of two files; if diffs too large, dedup them file_diff = function(files, len = 200, use_diff = Sys.which('diff') != '') { n = length(files) if (n == 0) return() if (n == 1) { f = tempfile(); on.exit(unlink(f), add = TRUE); file.create(f) files = c(f, files) } d = if (use_diff) { suppressWarnings(system2('diff', shQuote(files), stdout = TRUE)) } else { c(paste('<', read_utf8(files[1])), '---', paste('>', read_utf8(files[2]))) } if (length(d) >= len) unique(d) else d } # specify a list of package names to be ignored when installing all dependencies ignore_deps = function() { if (file_exists('00ignore_deps')) scan('00ignore_deps', 'character') } # download a check summary of a package from CRAN cran_check_page = function(pkg, con = '00check-cran.log') { u = sprintf('https://cran.rstudio.com/web/checks/check_results_%s.html', pkg) x = read_utf8(u) if (length(i <- grep('Check Details', x, ignore.case = TRUE)) == 0) return() x = x[i[1]:length(x)] x = gsub('<[^>]+>', '', x) x = gsub(' ', ' ', x) x = gsub('>', '>', x) x = gsub('<', '<', x) x = gsub('\\s+', ' ', x) x = paste(trimws(x), collapse = '\n') x = gsub('\n\n+', '\n\n', x) if (length(con) == 1) writeLines(x, con) else x } # download CRAN check summaries of all failed packages cran_check_pages = function() { dirs = list.files('.', '[.]Rcheck$') for (d in dirs) { if (dir_exists(d)) in_dir(d, cran_check_page(gsub('[.]Rcheck$', '', d))) } } # parse the check log for missing LaTeX packages and install them find_missing_latex = function() { dirs = list.files('.', '[.]Rcheck2?$') pkgs = NULL for (d in dirs) { if (dir_exists(d)) pkgs = c(pkgs, in_dir( d, tinytex::parse_packages('00check.log', quiet = c(TRUE, FALSE, FALSE)) )) } pkgs = unique(pkgs) if (file_exists(f <- 'latex.txt')) append_unique(pkgs, f) pkgs } xfun/R/utils.R 0000644 0001750 0001750 00000022313 14134060133 013044 0 ustar nilesh nilesh stop2 = function(...) stop(..., call. = FALSE) warning2 = function(...) warning(..., call. = FALSE) #' Obtain an attribute of an object without partial matching #' #' An abbreviation of \code{base::\link[base]{attr}(exact = TRUE)}. #' @param ... Passed to \code{base::\link[base]{attr}()} (without the #' \code{exact} argument). #' @export #' @examples #' z = structure(list(a = 1), foo = 2) #' base::attr(z, 'f') # 2 #' xfun::attr(z, 'f') # NULL #' xfun::attr(z, 'foo') # 2 attr = function(...) base::attr(..., exact = TRUE) #' Set environment variables #' #' Set environment variables from a named character vector, and return the old #' values of the variables, so they could be restored later. #' #' The motivation of this function is that \code{\link{Sys.setenv}()} does not #' return the old values of the environment variables, so it is not #' straightforward to restore the variables later. #' @param vars A named character vector of the form \code{c(VARIABLE = VALUE)}. #' If any value is \code{NA}, this function will try to unset the variable. #' @return Old values of the variables (if not set, \code{NA}). #' @export #' @examples #' vars = xfun::set_envvar(c(FOO = '1234')) #' Sys.getenv('FOO') #' xfun::set_envvar(vars) #' Sys.getenv('FOO') set_envvar = function(vars) { if (is.null(nms <- names(vars)) || any(nms == '')) stop( "The 'vars' argument must take a named character vector." ) vals = Sys.getenv(nms, NA, names = TRUE) i = is.na(vars) suppressWarnings(Sys.unsetenv(nms[i])) if (length(vars <- vars[!i])) do.call(Sys.setenv, as.list(vars)) invisible(vals) } #' Call \code{on.exit()} in a parent function #' #' The function \code{\link{on.exit}()} is often used to perform tasks when the #' current function exits. This \code{exit_call()} function allows calling a #' function when a parent function exits (thinking of it as inserting an #' \code{on.exit()} call into the parent function). #' @param fun A function to be called when the parent function exits. #' @param n The parent frame number. For \code{n = 1}, \code{exit_call(fun)} is #' the same as \code{on.exit(fun())}; \code{n = 2} means adding #' \code{on.exit(fun())} in the parent function; \code{n = 3} means the #' grandparent, etc. #' @param ... Other arguments to be passed to \code{on.exit()}. #' @references This function was inspired by Kevin Ushey: #' \url{https://yihui.org/en/2017/12/on-exit-parent/} #' @export #' @examples #' f = function(x) { #' print(x) #' xfun::exit_call(function() print('The parent function is exiting!')) #' } #' g = function(y) { #' f(y) #' print('f() has been called!') #' } #' g('An argument of g()!') exit_call = function(fun, n = 2, ...) { do.call( on.exit, list(substitute(fun(), list(fun = fun)), add = TRUE, ...), envir = parent.frame(n) ) } #' Set the global option \code{\link{options}(stringsAsFactors = FALSE)} inside #' a parent function and restore the option after the parent function exits #' #' This is a shorthand of \code{opts = options(stringsAsFactors = FALSE); #' on.exit(options(opts), add = TRUE)}; \code{strings_please()} is an alias of #' \code{stringsAsStrings()}. #' @export #' @examples #' f = function() { #' xfun::strings_please() #' data.frame(x = letters[1:4], y = factor(letters[1:4])) #' } #' str(f()) # the first column should be character stringsAsStrings = function() { # TODO: remove this function in the future since stringsAsFactors starts to # default to FALSE since R 4.0.0 if (isFALSE(getOption('stringsAsFactors'))) return(invisible()) opts = options(stringsAsFactors = FALSE) exit_call(function() options(opts)) } #' @rdname stringsAsStrings #' @export strings_please = stringsAsStrings #' Evaluate an expression under a specified working directory #' #' Change the working directory, evaluate the expression, and restore the #' working directory. #' @param dir Path to a directory. #' @param expr An R expression. #' @export #' @examples #' library(xfun) #' in_dir(tempdir(), {print(getwd()); list.files()}) in_dir = function(dir, expr) { owd = setwd(dir); on.exit(setwd(owd)) expr } #' Test if an object is identical to \code{FALSE} #' #' A simple abbreviation of \code{identical(x, FALSE)}. #' @param x An R object. #' @export #' @examples #' library(xfun) #' isFALSE(TRUE) # false #' isFALSE(FALSE) # true #' isFALSE(c(FALSE, FALSE)) # false isFALSE = function(x) identical(x, FALSE) #' Parse R code and do not keep the source #' #' An abbreviation of \code{parse(keep.source = FALSE)}. #' @param code A character vector of the R source code. #' @export #' @return R \code{\link{expression}}s. #' @examples library(xfun) #' parse_only('1+1'); parse_only(c('y~x', '1:5 # a comment')) #' parse_only(character(0)) parse_only = function(code) { if (length(code) == 0) return(expression()) parse(text = code, keep.source = FALSE) } #' Try to evaluate an expression silently #' #' An abbreviation of \code{try(silent = TRUE)}. #' @param expr An R expression. #' @export #' @examples library(xfun) #' z = try_silent(stop('Wrong!')) #' inherits(z, 'try-error') try_silent = function(expr) try(expr, silent = TRUE) #' Try an expression and see if it throws an error #' #' Use \code{\link{tryCatch}()} to check if an expression throws an error. #' @inheritParams try_silent #' @return \code{TRUE} (error) or \code{FALSE} (success). #' @export #' @examples #' xfun::try_error(stop('foo')) # TRUE #' xfun::try_error(1:10) # FALSE try_error = function(expr) { err = FALSE tryCatch(expr, error = function(e) err <<- TRUE) err } #' Retry calling a function for a number of times #' #' If the function returns an error, retry it for the specified number of #' times, with a pause between attempts. #' #' One application of this function is to download a web resource. Since the #' download might fail sometimes, you may want to retry it for a few more times. #' @param fun A function. #' @param ... Arguments to be passed to the function. #' @param .times The number of times. #' @param .pause The number of seconds to wait before the next attempt. #' @export #' @examplesIf interactive() #' # read the Github releases info of the repo yihui/xfun #' xfun::retry(xfun::github_releases, 'yihui/xfun') retry = function(fun, ..., .times = 3, .pause = 5) { for (i in seq_len(.times)) { if (!inherits(res <- tryCatch(fun(...), error = identity), 'error')) return(res) Sys.sleep(.pause) } stop(res$message, call. = FALSE) } gsubi = function(...) gsub(..., ignore.case = TRUE) #' Turn the output of \code{\link{str}()} into a tree diagram #' #' The super useful function \code{str()} uses \verb{..} to indicate the level #' of sub-elements of an object, which may be difficult to read. This function #' uses vertical pipes to connect all sub-elements on the same level, so it is #' clearer which elements belong to the same parent element in an object with a #' nested structure (such as a nested list). #' @param ... Arguments to be passed to \code{\link{str}()} (note that the #' \code{comp.str} is hardcoded inside this function, and it is the only #' argument that you cannot customize). #' @return A character string as a \code{\link{raw_string}()}. #' @export #' @examples fit = lsfit(1:9, 1:9) #' str(fit) #' xfun::tree(fit) #' #' fit = lm(dist ~ speed, data = cars) #' str(fit) #' xfun::tree(fit) #' #' # some trivial examples #' xfun::tree(1:10) #' xfun::tree(iris) tree = function(...) { x = capture.output(str(..., comp.str = '$ ')) r = '^([^$-]+[$-] )(.*)$' x1 = gsub(r, '\\1', x) x2 = gsub(r, '\\2', x) x1 = gsub('[.][.]', ' ', x1) x1 = gsub('[$] $', '|-', x1) x1 = connect_pipes(x1) x3 = paste(x1, x2, sep = '') i = !grepl(r, x) x3[i] = x[i] raw_string(x3) } # for a tree diagram, connect the pipes on the same level, e.g., change # |- .. # |- .. # # |- .. # to # |- .. # |- .. # | # |- .. # this task is not complicated, but just boring nested for-loops connect_pipes = function(x) { ns = nchar(x); n = max(ns); m = length(x) if (n < 2 || m < 3) return(x) A = matrix('', nrow = m, ncol = n) x = strsplit(x, '') for (i in seq_len(m)) { A[i, seq_len(ns[i])] = x[[i]] } k = NULL for (j in seq_len(n - 1)) { for (i in seq_len(m - 2)) { if (!all(A[i, j + 0:1] == c('|', '-'))) next for (l in (i + 1):m) { cells = A[l, j + 0:1] if (all(cells == ' ')) { if (l == m) { k = NULL; break } else k = c(k, l) } else if (all(cells == c('|', '-'))) { break } else { k = NULL; break } } if (length(k) > 0) A[k, j] = '|' k = NULL } } apply(A, 1, paste, collapse = '') } pkg_file = function(...) system.file(..., package = 'xfun', mustWork = TRUE) #' Format numbers of bytes using a specified unit #' #' Call the S3 method \code{format.object_size()} to format numbers of bytes. #' @param x A numeric vector (each element represents a number of bytes). #' @param units,... Passed to \code{\link[=format.object_size]{format}()}. #' @return A character vector. #' @export #' @examples #' xfun::format_bytes(c(1, 1024, 2000, 1e6, 2e8)) #' xfun::format_bytes(c(1, 1024, 2000, 1e6, 2e8), units = 'KB') format_bytes = function(x, units = 'auto', ...) { vapply(x, function(b) { format(structure(b, class = 'object_size'), units = units, ...) }, character(1)) } xfun/R/rstudio.R 0000644 0001750 0001750 00000004257 13701776020 013414 0 ustar nilesh nilesh #' Type a character vector into the RStudio source editor #' #' Use the \pkg{rstudioapi} package to insert characters one by one into the #' RStudio source editor, as if they were typed by a human. #' @param x A character vector. #' @param pause A function to return a number in seconds to pause after typing #' each character. #' @param mistake The probability of making random mistakes when typing the next #' character. A random mistake is a random string typed into the editor and #' deleted immediately. #' @param save The probability of saving the document after typing each #' character. Note that If a document is not opened from a file, it will never #' be saved. #' @export #' @import stats #' @examples library(xfun) #' if (loadable('rstudioapi') && rstudioapi::isAvailable()) { #' rstudio_type('Hello, RStudio! xfun::rstudio_type() looks pretty cool!', #' pause = function() runif(1, 0, .5), mistake = .1) #' } rstudio_type = function(x, pause = function() .1, mistake = 0, save = 0) { get_ctx = function() rstudioapi::getSourceEditorContext() ctx = get_ctx() if (is.null(id <- ctx$id)) { message('Please make sure an RStudio editor tab is open') return() } save_it = function(prob = 1) { if (ctx$path == '' || (rbinom(1, 1, prob) == 0)) return() ctx = get_ctx() # in case a new line is automatically added at the end when saving the doc on.exit(rstudioapi::setSelectionRanges(ctx$selection[[1]]$range, id), add = TRUE) rstudioapi::documentSave(id) } type_one = function(x) { rstudioapi::insertText(text = x, id = id) Sys.sleep(pause()) } type_mistake = function() { n = sample(1:10, 1) x = sample(ascii_chars, n, replace = TRUE) for (i in x) type_one(i) Sys.sleep(.5) ctx = rstudioapi::getSourceEditorContext() r = ctx$selection[[1]]$range r$start[2] = r$start[2] - n rstudioapi::modifyRange(r, '', id) Sys.sleep(.5) } x = paste(x, collapse = '\n') for (i in unlist(strsplit(x, ''))) { type_one(i); save_it(save) if (runif(1) < mistake) type_mistake() } save_it(as.integer(save > 0)) # if prob is non-zero, save it finally invisible() } ascii_chars = intToUtf8(32:126, TRUE) xfun/LICENSE 0000644 0001750 0001750 00000000054 14020527026 012366 0 ustar nilesh nilesh YEAR: 2018-2021 COPYRIGHT HOLDER: Yihui Xie xfun/inst/ 0000755 0001750 0001750 00000000000 14156200274 012342 5 ustar nilesh nilesh xfun/inst/scripts/ 0000755 0001750 0001750 00000000000 14145515221 014030 5 ustar nilesh nilesh xfun/inst/scripts/child-pids.sh 0000644 0001750 0001750 00000000300 13741412323 016375 0 ustar nilesh nilesh # given a PID, output all its child PIDs recursively list_children() { for j in $(pgrep -P $1); do echo $j echo $(list_children $j) done } for i in $@; do list_children $i done xfun/inst/scripts/call-fun.R 0000644 0001750 0001750 00000001115 13736233377 015670 0 ustar nilesh nilesh # This script is executed via the command line `Rscript call-fun.R arg1 arg2`, # where arg1 is a path to an .rds file, which contains the function and its # arguments saved as a list, and arg2 is a path to an .rds file to which the # returned value of the function call is saved. local({ if (length(a <- commandArgs(TRUE)) != 2) stop('The number of arguments passed to Rscript should be 2.') x = readRDS(a[1]) # list(fun, args) f = x[[1]] if (is.character(f)) f = eval(parse(text = f), envir = globalenv()) r = do.call(f, x[[2]], envir = globalenv()) saveRDS(r, a[2]) }) xfun/inst/doc/ 0000755 0001750 0001750 00000000000 14156200274 013107 5 ustar nilesh nilesh xfun/inst/doc/xfun.html 0000644 0001750 0001750 00000143467 14156200274 014774 0 ustar nilesh nilesh