Refactor code

DESCRIPTION

@@ -14,24 +14,26 @@ BugReports: https://github.com/cgoo4/usedthese/issues
 Depends: 
     R (>= 4.1)
 Imports: 
+    cli,
     conflicted (>= 1.2.0),
     dplyr (>= 1.1.0),
     highr,
+    httr,
     kableExtra,
     knitr,
+    lifecycle,
     purrr,
     readr,
     rlang,
+    rvest,
     stringr,
     tibble,
     tidyr (>= 1.3.0),
     tidyselect,
     withr
 Suggests: 
     covr,
-    httr,
     rmarkdown,
-    rvest,
     spelling,
     testthat (>= 3.0.0),
     tsibble,

NAMESPACE

@@ -1 +1,46 @@
-exportPattern("^[[:alpha:]]+")
+# Generated by roxygen2: do not edit by hand
+
+export(used_here)
+export(used_there)
+import(dplyr)
+import(rlang)
+importFrom(cli,cli_abort)
+importFrom(conflicted,conflict_scout)
+importFrom(highr,hi_latex)
+importFrom(httr,parse_url)
+importFrom(kableExtra,kable_styling)
+importFrom(knitr,current_input)
+importFrom(knitr,kable)
+importFrom(knitr,purl)
+importFrom(lifecycle,deprecated)
+importFrom(purrr,list_c)
+importFrom(purrr,list_flatten)
+importFrom(purrr,list_rbind)
+importFrom(purrr,map)
+importFrom(purrr,walk)
+importFrom(readr,read_lines)
+importFrom(rvest,html_attr)
+importFrom(rvest,html_element)
+importFrom(rvest,html_elements)
+importFrom(rvest,html_table)
+importFrom(rvest,read_html)
+importFrom(stringr,str_c)
+importFrom(stringr,str_ends)
+importFrom(stringr,str_extract_all)
+importFrom(stringr,str_flatten_comma)
+importFrom(stringr,str_remove)
+importFrom(stringr,str_replace)
+importFrom(tibble,as_tibble)
+importFrom(tibble,enframe)
+importFrom(tibble,tibble)
+importFrom(tidyr,drop_na)
+importFrom(tidyr,extract)
+importFrom(tidyr,fill)
+importFrom(tidyr,pivot_longer)
+importFrom(tidyr,separate_longer_delim)
+importFrom(tidyr,separate_wider_delim)
+importFrom(tidyr,separate_wider_regex)
+importFrom(tidyr,unnest)
+importFrom(tidyselect,everything)
+importFrom(utils,tail)
+importFrom(withr,defer)

NEWS.md

@@ -1,35 +1,42 @@
 # usedthese (development version)
 
+* Refactored code.
+* Improved error messages using `cli_abort`.
+* Centralised roxygen `@importFrom` tags.
+* Used mocking to test without the need for an internet connection.
+* Added test for non-scalar `num_links`.
+* Updated citation.
+
 # usedthese 0.4.0
 
-* Spring clean
-* Default branch master to main
+* Spring clean.
+* Default branch master to main.
 
 # usedthese 0.3.3
 
-* Fixed occasional `used_here()` warning
-* Documentation updates
+* Fixed occasional `used_here()` warning.
+* Documentation updates.
 
 # usedthese 0.3.2
 
-* `used_there()` fails gracefully if Internet resource unavailable
+* `used_there()` fails gracefully if Internet resource unavailable.
 
 # usedthese 0.3.1
 
-* Patch update to fix test error
-* Default `used_there()` `num_links` to 30
+* Patch update to fix test error.
+* Default `used_there()` `num_links` to 30.
 
 # usedthese 0.3.0
 
-* Respects `include.only` and `exclude` arguments specified in `library()`
-* Small performance improvement with dplyr 1.1 and tidyr 1.3
-* Remove suggests for meta-packages tidyverse and fpp3
+* Respects `include.only` and `exclude` arguments specified in `library()`.
+* Small performance improvement with dplyr 1.1 and tidyr 1.3.
+* Remove suggests for meta-packages tidyverse and fpp3.
 
 # usedthese 0.2.0
 
-* Support use of the conflicted package
-* Include functions using the double-colon operator
-* Resolve cases of a function counted against two packages
+* Support use of the conflicted package.
+* Include functions using the double-colon operator.
+* Resolve cases of a function counted against two packages.
 
 # usedthese 0.1.0
 

R/globals.R

@@ -3,17 +3,18 @@ utils::globalVariables(
     "value",
     "name",
     "base",
-    "pckg_origin",
+    "pkg_origin",
     "n",
-    "pckg",
+    "pkg",
     "func",
     "total",
     "count",
     "desc",
     "Function",
     "Package",
     "packfun",
-    "pckg_preferred",
-    "pckgx"
+    "pkg_loaded",
+    "pkg_preferred",
+    "pkgx"
   )
 )

R/used_here.R

@@ -25,96 +25,149 @@
 #' # an html table with a CSS class "usedthese"
 #' usedthese::used_here("mean(c(1, 2, 3))\nsum(c(1, 2, 3))")
 #'
-used_here <- \(fil = knitr::current_input()) {
+used_here <- \(fil = current_input()) {
   if (is.null(fil)) {
-    rlang::abort(
-      "If you are knitting the current document, i.e. you clicked the Render button, then leave fil unspecified. If you are running the code chunks, then ensure you library the packages first in a fresh R session and specify the saved filename quoted.",
-      fil = fil
-    )
+    cli_abort(c(
+      "`fil` must be either `current_input()` or a saved filename",
+      "i" = "When knitting a qmd/Rmd, `fil` defaults to `current_input()`.",
+      "i" = "When running a code chunk, quote a saved filename.",
+      "x" = "You specified fil = {fil}."
+    ))
   }
 
   old <- options(knitr.duplicate.label = "allow")
-  withr::defer(options(old))
+  defer(options(old))
 
-  if (stringr::str_ends(fil, "Rmd|qmd|rmarkdown")) {
-    purrr::walk(fil, knitr::purl, quiet = TRUE, documentation = 0)
+  if (str_ends(fil, "Rmd|qmd|rmarkdown")) {
+    walk(fil, purl, quiet = TRUE, documentation = 0)
+    fil <- str_replace(fil, "Rmd|qmd|rmarkdown", "R")
+  }
+
+  pkg_loaded <- .packages() |> set_names()
+  funs_origin <- get_loaded_pkg_imports(pkg_loaded[pkg_loaded != "usedthese"])
+  funs_scouted <- conflict_scout() |> unlist() |> bind_rows()
 
-    fil <- stringr::str_replace(fil, "Rmd|qmd|rmarkdown", "R")
+  if (nrow(funs_scouted) > 0) {
+    funs_scouted <- summarise_funs_scouted(funs_scouted)
+  } else {
+    funs_scouted <- tibble(pkg_preferred = "zzz", func = "zzz")
   }
 
-  pckg_loaded <- .packages() |>
-    rlang::set_names()
+  funs_augmented <- pkg_loaded |>
+    get_funs_loaded() |>
+    augment_funs_loaded(funs_origin, funs_scouted)
 
-  funs_loaded <- pckg_loaded |>
-    purrr::map(\(x) base::ls(stringr::str_c("package:", x))) |>
-    tibble::enframe("pckg_loaded", "func") |>
-    tidyr::unnest(func)
+  fil |>
+    extract_highlighted_funs() |>
+    summarise_funs_used(funs_augmented) |>
+    print_with_class()
+}
 
-  get_mode <- \(x) {
-    ux <- unique(x)
-    ux[which.max(tabulate(match(x, ux)))]
-  }
 
-  funs_origin <- pckg_loaded |>
-    purrr::map(getNamespaceImports) |>
-    purrr::list_flatten() |>
-    tibble::enframe() |>
-    dplyr::filter(value != "TRUE") |>
-    tidyr::unnest(value) |>
-    tidyr::separate_wider_delim(name, "_", names = c("pckg_loaded", "pckg_origin")) |>
-    dplyr::rename(func = value) |>
-    dplyr::mutate(pckg_origin = get_mode(pckg_origin), .by = func) |>
-    dplyr::distinct()
-
-  funs_scouted <- conflicted::conflict_scout() |>
-    unlist() |>
-    dplyr::bind_rows()
 
-  if (nrow(funs_scouted) > 0) {
-    funs_scouted <- funs_scouted |>
-      tidyr::pivot_longer(tidyselect::everything(), names_to = "func") |>
-      dplyr::mutate(func = stringr::str_remove(func, "\\d$")) |>
-      dplyr::summarise(pckg_preferred = stringr::str_flatten_comma(value, na.rm = TRUE), .by = func)
-  } else {
-    funs_scouted <- tibble::tibble(pckg_preferred = "zzz", func = "zzz")
-  }
+#' Get loaded functions
+#'
+#' @rdname used_here
+#' @usage NULL
+get_funs_loaded <- \(x) {
+  map(x, \(x) ls(str_c("package:", x))) |>
+    enframe("pkg_loaded", "func") |>
+    unnest(func)
+}
 
-  funs_augmented <- funs_loaded |>
-    dplyr::left_join(funs_origin, dplyr::join_by(pckg_loaded, func)) |>
-    dplyr::left_join(funs_scouted, dplyr::join_by(func)) |>
-    dplyr::group_by(func) |>
-    tidyr::fill(pckg_origin, .direction = "updown") |>
-    dplyr::mutate(
-      pckg_loaded = dplyr::coalesce(pckg_origin, pckg_loaded),
-      pckg_loaded = dplyr::coalesce(pckg_preferred, pckg_loaded)
-    ) |>
-    dplyr::select(pckgx = pckg_loaded, func) |>
-    dplyr::arrange(func, pckgx) |>
-    dplyr::distinct(func, .keep_all = TRUE)
-
-  funs_coded <- fil |>
-    readr::read_lines() |>
-    highr::hi_latex(fallback = TRUE) |>
-    stringr::str_extract_all("([a-zA-Z_]+::)?\\\\hlkwd\\{([^\\{\\}]*(?=\\}))") |>
-    purrr::list_c() |>
-    tibble::as_tibble() |>
-    tidyr::separate_wider_regex(value, c(pckg = ".*?", "\\\\hlkwd\\{", func = ".*")) |>
-    dplyr::mutate(pckg = stringr::str_remove(pckg, "::") |> dplyr::na_if(""))
-
-  funs_used <-
-    funs_coded |>
-    dplyr::left_join(funs_augmented, dplyr::join_by(func)) |>
-    dplyr::mutate(pckg = dplyr::coalesce(pckg, pckgx)) |>
-    dplyr::count(pckg, func) |>
-    dplyr::mutate(func = stringr::str_c(func, "[", n, "]")) |>
-    dplyr::summarise(func = stringr::str_c(func, collapse = ", "), .by = pckg) |>
-    tidyr::drop_na()
-
-  funs_used |>
-    knitr::kable(
-      format = "html",
-      table.attr = "class = 'usedthese'",
-      col.names = c("Package", "Function")
+#' Get mode
+#'
+#' @rdname used_here
+#' @usage NULL
+get_mode <- \(x) {
+  ux <- unique(x)
+  ux[which.max(tabulate(match(x, ux)))]
+}
+
+#' Get the Imports of loaded packages
+#'
+#' @rdname used_here
+#' @usage NULL
+get_loaded_pkg_imports <- \(x){
+  map(x, getNamespaceImports) |>
+    list_flatten() |>
+    enframe() |>
+    filter(value != "TRUE") |>
+    unnest(value) |>
+    separate_wider_delim(name, "_", names = c("pkg_loaded", "pkg_origin")) |>
+    rename(func = value) |>
+    mutate(pkg_origin = get_mode(pkg_origin), .by = func) |>
+    distinct()
+}
+
+#' Summarise functions scouted
+#'
+#' @rdname used_here
+#' @usage NULL
+summarise_funs_scouted <- \(x){
+  pivot_longer(x, everything(), names_to = "func") |>
+    mutate(func = str_remove(func, "\\d$")) |>
+    summarise(
+      pkg_preferred = str_flatten_comma(value, na.rm = TRUE),
+      .by = func
+      )
+}
+
+#' Augment functions loaded
+#'
+#' @rdname used_here
+#' @usage NULL
+augment_funs_loaded <- \(x, y, z){
+  left_join(x, y, join_by(pkg_loaded, func)) |>
+    left_join(z, join_by(func)) |>
+    group_by(func) |>
+    fill(pkg_origin, .direction = "updown") |>
+    mutate(
+      pkg_loaded = coalesce(pkg_origin, pkg_loaded),
+      pkg_loaded = coalesce(pkg_preferred, pkg_loaded)
     ) |>
-    kableExtra::kable_styling("striped")
+    select(pkgx = pkg_loaded, func) |>
+    arrange(func, pkgx) |>
+    distinct(func, .keep_all = TRUE)
+}
+
+#' Extract code-highlighted functions
+#'
+#' @rdname used_here
+#' @usage NULL
+extract_highlighted_funs <- \(x){
+  read_lines(x) |>
+    hi_latex(fallback = TRUE) |>
+    str_extract_all("([a-zA-Z_]+::)?\\\\hlkwd\\{([^\\{\\}]*(?=\\}))") |>
+    list_c() |>
+    as_tibble() |>
+    separate_wider_regex(value, c(pkg = ".*?", "\\\\hlkwd\\{", func = ".*")) |>
+    mutate(pkg = str_remove(pkg, "::") |> na_if(""))
+}
+
+#' Summarise functions used
+#'
+#' @rdname used_here
+#' @usage NULL
+summarise_funs_used <- \(x, y){
+  left_join(x, y, join_by(func)) |>
+    mutate(pkg = coalesce(pkg, pkgx)) |>
+    count(pkg, func) |>
+    mutate(func = str_c(func, "[", n, "]")) |>
+    summarise(func = str_c(func, collapse = ", "), .by = pkg) |>
+    drop_na()
+}
+
+#' Print summary table with class
+#'
+#' @rdname used_here
+#' @usage NULL
+print_with_class <- \(x){
+  kable(
+    x,
+    format = "html",
+    table.attr = "class = 'usedthese'", # essential for used_here()
+    col.names = c("Package", "Function")
+  ) |>
+    kable_styling("striped")
 }