path: root/tests/test-pearl-adhoc.el

;;; test-pearl-adhoc.el --- Tests for the ad-hoc filtered command -*- lexical-binding: t; -*-

;; Copyright (C) 2026 Craig Jennings

;; Author: Craig Jennings <c@cjennings.net>

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Tests for the ad-hoc filter command: the pure `--assemble-filter' that
;; turns chosen dimension values into a filter plist, `--save-query', and
;; `pearl-list-issues-filtered' running and optionally saving.

;;; Code:

(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
(require 'cl-lib)

;;; sentinel helpers

(ert-deftest test-pearl-filter-sentinel-value-p-recognizes-any-and-cancel ()
  "Both opt-out sentinels read as sentinel values."
  (should (pearl--filter-sentinel-value-p pearl--filter-any))
  (should (pearl--filter-sentinel-value-p pearl--filter-cancel)))

(ert-deftest test-pearl-filter-sentinel-value-p-recognizes-empty-and-nil ()
  "Empty input and nil also read as opt-out (back-compat for the legacy
empty-input idiom and for callers that pass nil)."
  (should (pearl--filter-sentinel-value-p ""))
  (should (pearl--filter-sentinel-value-p nil)))

(ert-deftest test-pearl-filter-sentinel-value-p-rejects-real-values ()
  "An actual picked value does not read as opt-out."
  (should-not (pearl--filter-sentinel-value-p "In Progress"))
  (should-not (pearl--filter-sentinel-value-p "Platform"))
  (should-not (pearl--filter-sentinel-value-p "bug")))

(ert-deftest test-pearl-filter-any-and-cancel-are-distinct-strings ()
  "The two sentinels carry different labels so the prompt reads accurately
for its case: \"any\" for filter dimensions, \"cancel\" for pick-an-existing."
  (should-not (string= pearl--filter-any pearl--filter-cancel)))

(ert-deftest test-pearl-with-sentinel-prepends-the-given-sentinel ()
  "`pearl--with-sentinel' puts SENTINEL first so it sits at the top of the
candidate list."
  (let ((wrapped-any (pearl--with-sentinel pearl--filter-any '("alpha" "beta"))))
    (should (string= pearl--filter-any (car wrapped-any)))
    (should (equal '("alpha" "beta") (cdr wrapped-any))))
  (let ((wrapped-cancel (pearl--with-sentinel pearl--filter-cancel '("a" "b"))))
    (should (string= pearl--filter-cancel (car wrapped-cancel)))))

(ert-deftest test-pearl-with-sentinel-empty-list-yields-just-the-sentinel ()
  "An empty candidate list still yields a one-element list with the sentinel."
  (let ((wrapped (pearl--with-sentinel pearl--filter-any '())))
    (should (equal (list pearl--filter-any) wrapped))))

(ert-deftest test-pearl-completion-table-keep-order-metadata-pins-identity ()
  "Action `metadata' returns an alist with `display-sort-function' bound to
`identity', the standard Emacs hook saying \"these are pre-sorted; don't re-sort.\""
  (let* ((tbl (pearl--completion-table-keep-order '("a" "b" "c")))
         (meta (funcall tbl "" nil 'metadata)))
    (should (eq 'metadata (car meta)))
    (should (eq #'identity (alist-get 'display-sort-function (cdr meta))))
    (should (eq #'identity (alist-get 'cycle-sort-function (cdr meta))))))

(ert-deftest test-pearl-read-yes-no-returns-t-for-yes ()
  "A `yes' choice returns t."
  (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "yes")))
    (should (eq t (pearl--read-yes-no "Anything? ")))))

(ert-deftest test-pearl-read-yes-no-returns-nil-for-no ()
  "A `no' choice returns nil."
  (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "no")))
    (should-not (pearl--read-yes-no "Anything? "))))

(ert-deftest test-pearl-read-yes-no-default-passed-as-default-arg ()
  "The DEFAULT argument is the value RET takes without typing; the helper
forwards it as completing-read's default so the framework highlights it."
  (let (forwarded-default)
    (cl-letf (((symbol-function 'completing-read)
               (lambda (&rest args) (setq forwarded-default (nth 6 args)) "no")))
      (pearl--read-yes-no "?" "no")
      (should (string= "no" forwarded-default)))))

(ert-deftest test-pearl-read-yes-no-default-yes-orders-yes-first ()
  "With the default `yes' (the omitted-arg case), the candidate list is
ordered yes-then-no so the most-common choice sits at the top."
  (let (captured-collection)
    (cl-letf (((symbol-function 'completing-read)
               (lambda (_p coll &rest _)
                 (setq captured-collection
                       (when (functionp coll) (all-completions "" coll)))
                 "yes")))
      (pearl--read-yes-no "?")
      (should (equal '("yes" "no") captured-collection)))))

(ert-deftest test-pearl-read-yes-no-default-no-orders-no-first ()
  "With DEFAULT \"no\", the candidate list is ordered no-then-yes so a
non-affirmative default is what the user lands on."
  (let (captured-collection)
    (cl-letf (((symbol-function 'completing-read)
               (lambda (_p coll &rest _)
                 (setq captured-collection
                       (when (functionp coll) (all-completions "" coll)))
                 "no")))
      (pearl--read-yes-no "?" "no")
      (should (equal '("no" "yes") captured-collection)))))

(ert-deftest test-pearl-completion-table-keep-order-delegates-all-completions ()
  "Non-metadata actions delegate to `complete-with-action' over the original
candidate list, so completion still works the way the framework expects."
  (let ((tbl (pearl--completion-table-keep-order '("alpha" "beta" "gamma"))))
    (should (equal '("alpha") (all-completions "a" tbl)))
    (should (equal '("beta") (all-completions "b" tbl)))))

;;; --assemble-filter

(ert-deftest test-pearl-assemble-filter-only-set-keys ()
  "Only the dimensions that were chosen appear in the filter plist."
  (let ((f (pearl--assemble-filter nil t nil nil nil nil)))
    (should (eq t (plist-get f :open)))
    (should-not (plist-member f :team))
    (should-not (plist-member f :labels))))

(ert-deftest test-pearl-assemble-filter-full ()
  "All chosen dimensions land in the plist."
  (let ((f (pearl--assemble-filter "ENG" t "In Progress" "Foo" '("bug" "p1") :me)))
    (should (string= "ENG" (plist-get f :team)))
    (should (eq t (plist-get f :open)))
    (should (string= "In Progress" (plist-get f :state)))
    (should (string= "Foo" (plist-get f :project)))
    (should (equal '("bug" "p1") (plist-get f :labels)))
    (should (eq :me (plist-get f :assignee)))))

(ert-deftest test-pearl-assemble-filter-empty-labels-omitted ()
  "An empty label list does not add a :labels key."
  (let ((f (pearl--assemble-filter nil nil nil nil '() nil)))
    (should-not (plist-member f :labels))))

(ert-deftest test-pearl-assemble-filter-string-assignee-is-assignee-id ()
  "A string assignee (resolved member id) lands as :assignee-id, not :assignee."
  (let ((f (pearl--assemble-filter nil t nil nil nil "user-1")))
    (should (string= "user-1" (plist-get f :assignee-id)))
    (should-not (plist-member f :assignee))))

;;; --save-local-view

(ert-deftest test-pearl-save-local-view-adds-entry ()
  "Saving a local view adds it to `pearl-local-views'."
  (let ((pearl-local-views nil))
    (cl-letf (((symbol-function 'customize-save-variable) (lambda (&rest _) nil)))
      (pearl--save-local-view "My filter" '(:open t :labels ("bug")))
      (let ((entry (assoc "My filter" pearl-local-views)))
        (should entry)
        (should (equal '(:open t :labels ("bug")) (plist-get (cdr entry) :filter)))))))

(ert-deftest test-pearl-save-local-view-replaces-same-name ()
  "Saving under an existing name updates that entry rather than duplicating."
  (let ((pearl-local-views '(("Dup" :filter (:open t)))))
    (cl-letf (((symbol-function 'customize-save-variable) (lambda (&rest _) nil)))
      (pearl--save-local-view "Dup" '(:priority 1))
      (should (= 1 (cl-count "Dup" pearl-local-views
                             :key #'car :test #'string=)))
      (should (equal '(:priority 1)
                     (plist-get (cdr (assoc "Dup" pearl-local-views)) :filter))))))

;;; pearl-delete-local-view

(ert-deftest test-pearl-delete-saved-query-removes-entry-on-yes ()
  "Confirming the prompt removes the named entry and persists."
  (let ((pearl-local-views '(("Keep" :filter (:open t))
                               ("Drop" :filter (:priority 1))))
        (persisted nil))
    (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
              ((symbol-function 'customize-save-variable)
               (lambda (&rest _) (setq persisted t))))
      (pearl-delete-local-view "Drop")
      (should-not (assoc "Drop" pearl-local-views))
      (should (assoc "Keep" pearl-local-views))
      (should persisted))))

(ert-deftest test-pearl-delete-saved-query-no-at-confirm-keeps-entry ()
  "Declining the confirm prompt leaves the entry in place and does not persist."
  (let ((pearl-local-views '(("Keep" :filter (:open t))))
        (persisted nil))
    (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil))
              ((symbol-function 'customize-save-variable)
               (lambda (&rest _) (setq persisted t))))
      (pearl-delete-local-view "Keep")
      (should (assoc "Keep" pearl-local-views))
      (should-not persisted))))

(ert-deftest test-pearl-delete-saved-query-sentinel-cancels ()
  "Picking the `pearl--filter-cancel' sentinel cancels without touching anything."
  (let ((pearl-local-views '(("Keep" :filter (:open t))))
        (confirmed nil))
    (cl-letf (((symbol-function 'yes-or-no-p)
               (lambda (&rest _) (setq confirmed t) t))
              ((symbol-function 'customize-save-variable)
               (lambda (&rest _) nil)))
      (pearl-delete-local-view pearl--filter-cancel)
      (should (assoc "Keep" pearl-local-views))
      (should-not confirmed))))

(ert-deftest test-pearl-delete-saved-query-unknown-name-errors ()
  "An unknown name (e.g. typed past completion) signals a user-error."
  (let ((pearl-local-views '(("Keep" :filter (:open t)))))
    (should-error (pearl-delete-local-view "Nope") :type 'user-error)))

(ert-deftest test-pearl-delete-saved-query-empty-list-errors-on-interactive ()
  "Called interactively with no local views, the command errors cleanly
rather than offering an empty picker."
  (let ((pearl-local-views nil))
    (should-error (call-interactively #'pearl-delete-local-view)
                  :type 'user-error)))

;;; pearl-run-local-view sentinel cancel

(ert-deftest test-pearl-run-saved-query-sentinel-cancels ()
  "Picking the `pearl--filter-cancel' sentinel cancels the run without fetching."
  (let ((fetched nil)
        (pearl-local-views '(("Open" :filter (:open t)))))
    (cl-letf (((symbol-function 'pearl--query-issues-async)
               (lambda (&rest _) (setq fetched t))))
      (should-error (pearl-run-local-view pearl--filter-cancel) :type 'user-error)
      (should-not fetched))))

;;; pearl-list-issues-filtered

(ert-deftest test-pearl-list-issues-filtered-runs-with-source ()
  "Running an ad-hoc filter compiles it and renders with a filter source."
  (let ((built nil) (rendered-source nil))
    (cl-letf (((symbol-function 'pearl--build-issue-filter)
               (lambda (plist) (setq built plist) '((compiled . t))))
              ((symbol-function 'pearl--query-issues-async)
               (lambda (_filter cb &optional _ord)
                 (funcall cb (pearl--make-query-result 'ok :issues nil))))
              ((symbol-function 'pearl--render-query-result)
               (lambda (_result source) (setq rendered-source source))))
      (pearl-list-issues-filtered '(:assignee :me :open t) nil)
      (should (equal '(:assignee :me :open t) built))
      (should (eq 'filter (plist-get rendered-source :type)))
      (should (equal '(:assignee :me :open t) (plist-get rendered-source :filter))))))

(ert-deftest test-pearl-list-issues-filtered-saves-when-named ()
  "Passing a save name persists the ad-hoc filter as a local view."
  (let ((pearl-local-views nil))
    (cl-letf (((symbol-function 'pearl--build-issue-filter) (lambda (_p) nil))
              ((symbol-function 'pearl--query-issues-async)
               (lambda (_f cb &optional _o)
                 (funcall cb (pearl--make-query-result 'empty :issues nil))))
              ((symbol-function 'pearl--render-query-result) (lambda (&rest _) nil))
              ((symbol-function 'customize-save-variable) (lambda (&rest _) nil)))
      (pearl-list-issues-filtered '(:open t) "Saved adhoc")
      (should (assoc "Saved adhoc" pearl-local-views)))))

;;; builder State prompt is multi-select (multi-state filter spec, phase 2)

(defun test-pearl-adhoc--build-with-states (state-picks)
  "Run `pearl--read-filter-interactively' stubbed so only State varies.
STATE-PICKS is the list the State `completing-read-multiple' returns; every
other dimension resolves to no constraint.  Returns the filter plist."
  (cl-letf (((symbol-function 'pearl--all-teams)
             (lambda () '(((id . "t1") (key . "ENG") (name . "Engineering")))))
            ((symbol-function 'pearl--get-team-id-by-name) (lambda (&rest _) "t1"))
            ((symbol-function 'pearl--read-yes-no) (lambda (&rest _) nil))
            ((symbol-function 'pearl--team-states)
             (lambda (&rest _)
               '(((name . "Todo")) ((name . "In Review")) ((name . "Done")))))
            ((symbol-function 'pearl--team-collection-names) (lambda (&rest _) nil))
            ((symbol-function 'pearl--resolve-team-id) (lambda (&rest _) nil))
            ((symbol-function 'completing-read)
             (lambda (prompt &rest _)
               (if (string-prefix-p "Team" prompt) "Engineering" pearl--filter-any)))
            ((symbol-function 'completing-read-multiple)
             (lambda (prompt &rest _)
               (if (string-prefix-p "States" prompt)
                   (copy-sequence state-picks)
                 (list pearl--filter-any)))))
    (pearl--read-filter-interactively)))

(ert-deftest test-pearl-adhoc-builder-state-multi-yields-list ()
  "Picking two states yields a list-valued :state."
  (should (equal (plist-get (test-pearl-adhoc--build-with-states '("Todo" "In Review"))
                            :state)
                 '("Todo" "In Review"))))

(ert-deftest test-pearl-adhoc-builder-state-one-yields-string ()
  "Picking one state yields a scalar :state."
  (should (equal (plist-get (test-pearl-adhoc--build-with-states '("Todo")) :state)
                 "Todo")))

(ert-deftest test-pearl-adhoc-builder-state-none-yields-no-key ()
  "Picking no state leaves :state out of the filter."
  (should-not (plist-member (test-pearl-adhoc--build-with-states '()) :state)))

(provide 'test-pearl-adhoc)
;;; test-pearl-adhoc.el ends here