From 835b819a130fa8dd8f0998e334e4c7d7774fa8a6 Mon Sep 17 00:00:00 2001
From: simonpcouch <simonpatrickcouch@gmail.com>
Date: Fri, 11 Oct 2024 12:53:48 -0500
Subject: [PATCH] support adding a directory of prompts

---
 NAMESPACE                               |  1 +
 R/pal-add-remove.R                      | 98 +++++++++++++++++++++++++
 R/zzz.R                                 | 12 +--
 man/pal_add_remove.Rd                   | 39 ++++++++++
 tests/testthat/_snaps/pal-add-remove.md | 30 ++++++++
 tests/testthat/test-pal-add-remove.R    | 48 ++++++++++++
 6 files changed, 220 insertions(+), 8 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 9cfc1e2..27b149b 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -2,6 +2,7 @@
 
 S3method(print,pal_response)
 export(.pal_add)
+export(.pal_add_dir)
 export(.pal_addin)
 export(.pal_init)
 import(rlang)
diff --git a/R/pal-add-remove.R b/R/pal-add-remove.R
index bfa88c5..f72c230 100644
--- a/R/pal-add-remove.R
+++ b/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]
+}
+
+
diff --git a/R/zzz.R b/R/zzz.R
index 83d182b..03355cc 100644
--- a/R/zzz.R
+++ b/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)
   }
 }
 
diff --git a/man/pal_add_remove.Rd b/man/pal_add_remove.Rd
index a396fcd..08de853 100644
--- a/man/pal_add_remove.Rd
+++ b/man/pal_add_remove.Rd
@@ -4,11 +4,14 @@
 \alias{pal_add_remove}
 \alias{.pal_add}
 \alias{.pal_remove}
+\alias{.pal_add_dir}
 \title{Creating custom pals}
 \usage{
 .pal_add(role, prompt = NULL, interface = c("replace", "prefix", "suffix"))
 
 .pal_remove(role)
+
+.pal_add_dir(dir)
 }
 \arguments{
 \item{role}{A single string giving the \code{\link[=.pal_init]{.pal_init()}} role.}
@@ -20,6 +23,9 @@ the output of \code{\link[elmer:interpolate]{elmer::interpolate()}}.}
 how the pal will interact with the selection. For example, the
 \link[=pal_cli]{cli pal} \code{"replace"}s the selection, while the
 \link[=pal_roxygen]{roxygen pal} \code{"prefixes"} the selected code with documentation.}
+
+\item{dir}{A directory of markdown files. See "Adding multiple, persistent
+pals" section below.}
 }
 \value{
 \code{NULL}, invisibly. Called for its side effect: a pal with role \code{role}
@@ -30,3 +36,36 @@ Users can create custom pals using the \code{.pal_add()} function; after passing
 the function a role and prompt, the pal will be available on the command
 palette.
 }
+\section{Adding multiple, persistent pals}{
+
+Pals can also be added in batch with \code{.pal_add_dir()}, which takes a directory
+of markdown files. Prompts are markdown files with the
+name \code{role-interface.md}, where interface is one of
+"replace", "prefix" or "suffix".
+An example directory might look like:
+
+\if{html}{\out{<div class="sourceCode">}}\preformatted{/
+├── .config/
+│   └── pal/
+│       ├── proofread-replace.md
+│       └── summarize-prefix.md
+}\if{html}{\out{</div>}}
+
+In that case, pal will register two custom pals when you call \code{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:
+\itemize{
+\item Files without a \code{.md} extension are ignored.
+\item Files with a \code{.md} extension must contain only one hyphen in their filename,
+and the text following the hyphen must be one of \code{replace}, \code{prefix}, or
+\code{suffix}.
+}
+
+To load custom prompts every time the package is loaded, place your
+prompts in \verb{~/.config/pal} (or, to use some other folder, set
+\code{options(.pal_dir = some_dir)} before loading the package).
+}
+
diff --git a/tests/testthat/_snaps/pal-add-remove.md b/tests/testthat/_snaps/pal-add-remove.md
index b361a8f..43e1f00 100644
--- a/tests/testthat/_snaps/pal-add-remove.md
+++ b/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`.
+
diff --git a/tests/testthat/test-pal-add-remove.R b/tests/testthat/test-pal-add-remove.R
index 201b3ed..626ddf0 100644
--- a/tests/testthat/test-pal-add-remove.R
+++ b/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])
+})
+