support adding a directory of prompts

NAMESPACE

@@ -2,6 +2,7 @@
 
 S3method(print,pal_response)
 export(.pal_add)
+export(.pal_add_dir)
 export(.pal_addin)
 export(.pal_init)
 import(rlang)

R/pal-add-remove.R

@@ -14,6 +14,40 @@
 #' how the pal will interact with the selection. For example, the
 #' [cli pal][pal_cli] `"replace"`s the selection, while the
 #' [roxygen pal][pal_roxygen] `"prefixes"` the selected code with documentation.
+#' @param dir A directory of markdown files. See "Adding multiple, persistent
+#' pals" section below.
+#'
+#' @section Adding multiple, persistent pals:
+
+#' Pals can also be added in batch with `.pal_add_dir()`, which takes a directory
+#' of markdown files. Prompts are markdown files with the
+#' name `role-interface.md`, where interface is one of
+#' `r glue::glue_collapse(glue::double_quote(supported_interfaces), ", ", last = " or ")`.
+#' An example directory might look like:
+#'
+#' ```
+#' /
+#' ├── .config/
+#' │   └── pal/
+#' │       ├── proofread-replace.md
+#' │       └── summarize-prefix.md
+#' ```
+#'
+#' In that case, pal will register two custom pals when you call `library(pal)`.
+#' One of them has the role "proofread" and will replace the selected text with
+#' a proofread version (according to the instructions contained in the markdown
+#' file itself). The other has the role "summarize" and will prefix the selected
+#' text with a summarized version (again, according to the markdown file's
+#' instructions). Note:
+#'
+#' * Files without a `.md` extension are ignored.
+#' * Files with a `.md` extension must contain only one hyphen in their filename,
+#'   and the text following the hyphen must be one of `replace`, `prefix`, or
+#'   `suffix`.
+#'
+#' To load custom prompts every time the package is loaded, place your
+#' prompts in `~/.config/pal` (or, to use some other folder, set
+#' `options(.pal_dir = some_dir)` before loading the package).
 #'
 #' @returns
 #' `NULL`, invisibly. Called for its side effect: a pal with role `role`
@@ -90,3 +124,67 @@ parse_interface <- function(interface, role, call = caller_env()) {
 
   paste0(".pal_rs_", role)
 }
+
+# mapping over multiple calls to `.pal_add()` ----------------------------------
+#' @rdname pal_add_remove
+#' @export
+.pal_add_dir <- function(dir) {
+  prompt_paths <- list.files(dir, full.names = TRUE)
+  roles_and_interfaces <- roles_and_interfaces(prompt_paths)
+
+  for (idx in seq_along(prompt_paths)) {
+    role <- roles_and_interfaces[[idx]][1]
+    prompt <- paste0(readLines(prompt_paths[idx]), collapse = "\n")
+    interface <- roles_and_interfaces[[idx]][2]
+
+    .pal_add(role = role, prompt = prompt, interface = interface)
+  }
+}
+
+roles_and_interfaces <- function(prompt_paths) {
+  prompt_basenames <- basename(prompt_paths)
+  prompt_basenames <- grep("\\.md$", prompt_basenames, value = TRUE)
+  prompt_basenames <- filter_single_hyphenated(prompt_basenames)
+
+  roles_and_interfaces <- gsub("\\.md$", "", prompt_basenames)
+  roles_and_interfaces <- strsplit(roles_and_interfaces, "-")
+  roles_and_interfaces <- filter_interfaces(roles_and_interfaces)
+
+  roles_and_interfaces
+}
+
+filter_single_hyphenated <- function(x) {
+  has_one_hyphen <- grepl("^[^-]*-[^-]*$", x)
+  if (any(!has_one_hyphen)) {
+    cli::cli_inform(
+      "Prompt{?s} {.val {paste0(x[!has_one_hyphen], '.md')}} must contain
+       a single hyphen in {?its/their} filename{?s} and will not
+       be registered with pal.",
+      call = NULL
+    )
+  }
+
+  x[has_one_hyphen]
+}
+
+filter_interfaces <- function(x) {
+  interfaces <- lapply(x, `[[`, 2)
+  recognized <- interfaces %in% supported_interfaces
+  if (any(!recognized)) {
+    prompts <- vapply(x, paste0, character(1), collapse = "-")
+    cli::cli_inform(
+      c(
+        "Prompt{?s} {.val {paste0(prompts[!recognized], '.md')}} {?has/have} an
+       unrecognized {.arg interface} noted in {?its/their} filename{?s}
+       and will not be registered with pal.",
+       "{.arg interface} (following the hyphen) must be one of
+        {.or {.code {supported_interfaces}}}."
+      ),
+      call = NULL
+    )
+  }
+
+  x[recognized]
+}
+
+

R/zzz.R

@@ -3,15 +3,11 @@
 .onLoad <- function(libname, pkgname) {
   pal_env <- pal_env()
 
-  prompts <- list.files(system.file("prompts", package = "pal"), full.names = TRUE)
-  roles_and_interfaces <- gsub(".md", "", basename(prompts))
-  roles_and_interfaces <- strsplit(roles_and_interfaces, "-")
-  for (idx in seq_along(prompts)) {
-    role <- roles_and_interfaces[[idx]][1]
-    prompt <- paste0(readLines(prompts[idx]), collapse = "\n")
-    interface <- roles_and_interfaces[[idx]][2]
+  .pal_add_dir(system.file("prompts", package = "pal"))
 
-    .pal_add(role = role, prompt = prompt, interface = interface)
+  pal_dir <- getOption(".pal_dir", default = file.path("~", ".config", "pal"))
+  if (dir.exists(pal_dir)) {
+    .pal_add_dir(pal_dir)
   }
 }
 

tests/testthat/_snaps/pal-add-remove.md

@@ -54,3 +54,33 @@
       Error in `.pal_remove()`:
       ! No active pal with the given `role`.
 
+# filter_single_hyphenated messages informatively
+
+    Code
+      res <- filter_single_hyphenated(x)
+    Message
+      Prompts "basename.md" and "base_name.md" must contain a single hyphen in their filenames and will not be registered with pal.
+
+---
+
+    Code
+      res <- filter_single_hyphenated(x[1:2])
+    Message
+      Prompt "basename.md" must contain a single hyphen in its filename and will not be registered with pal.
+
+# filter_interfaces messages informatively
+
+    Code
+      res <- filter_interfaces(x)
+    Message
+      Prompts "bop-bad.md" and "boop-silly.md" have an unrecognized `interface` noted in their filenames and will not be registered with pal.
+      `interface` (following the hyphen) must be one of `replace`, `prefix`, or `suffix`.
+
+---
+
+    Code
+      res <- filter_interfaces(x[1:2])
+    Message
+      Prompt "bop-bad.md" has an unrecognized `interface` noted in its filename and will not be registered with pal.
+      `interface` (following the hyphen) must be one of `replace`, `prefix`, or `suffix`.
+

tests/testthat/test-pal-add-remove.R

@@ -56,3 +56,51 @@ test_that("pal remove with bad inputs", {
     .pal_remove(role = "notAnActivePal")
   )
 })
+
+test_that(".pal_add_dir works", {
+  tmp_dir <- withr::local_tempdir()
+
+  writeLines(
+    text = "Respond with 'beep bop boop' regardless of input.",
+    con = file.path(tmp_dir, "beep-replace.md")
+  )
+  writeLines(
+    text = "Respond with 'wee wee wop' regardless of input.",
+    con = file.path(tmp_dir, "wop-prefix.md")
+  )
+
+  withr::defer(
+    try_fetch(
+      {
+        .pal_remove("boop")
+        .pal_remove("wop")
+      },
+      error = function(e) {invisible()}
+    )
+
+  )
+
+  .pal_add_dir(tmp_dir)
+
+  expect_true(all(c("beep", "wop") %in% list_pals()))
+})
+
+test_that("filter_single_hyphenated messages informatively", {
+  x <- c("base-name", "basename", "base_name")
+
+  expect_snapshot(res <- filter_single_hyphenated(x))
+  expect_equal(res, x[1])
+  expect_snapshot(res <- filter_single_hyphenated(x[1:2]))
+  expect_equal(res, x[1])
+  expect_no_message(filter_single_hyphenated(x[1]))
+})
+
+test_that("filter_interfaces messages informatively", {
+  x <- list(c("beep", "replace"), c("bop", "bad"), c("boop", "silly"))
+
+  expect_snapshot(res <- filter_interfaces(x))
+  expect_equal(res, x[1])
+  expect_snapshot(res <- filter_interfaces(x[1:2]))
+  expect_equal(res, x[1])
+})
+