diff options
| -rw-r--r-- | pearl.el | 277 | ||||
| -rw-r--r-- | tests/test-pearl-keymap.el | 2 | ||||
| -rw-r--r-- | tests/test-pearl-naming.el | 7 | ||||
| -rw-r--r-- | tests/test-pearl-reverse-compile.el | 226 |
4 files changed, 510 insertions, 2 deletions
@@ -909,6 +909,198 @@ the ordering keys `:sort' / `:order'." filter))) (nreverse filter))) +;;; Reverse-compile: Linear filterData -> Pearl authoring plist (copy-down) +;; +;; Linear stores a Custom View's filter as `filterData', a JSON `and'/`or' tree, +;; NOT the flat IssueFilter Pearl's compiler emits. Copy-down reads it +;; (json-read shaped: symbol-keyed alists, vectors for arrays, t / :json-false / +;; nil for the JSON literals) and reverse-compiles it to a Pearl authoring plist +;; so the copied view is editable. Contract: normalize-then-match -- flatten the +;; top-level `and', unwrap single-branch `and'/`or', read a one-element `in' as a +;; scalar, then match each conjunct to one authoring key. Anything Pearl's +;; AND-only, singular-keyed model can't hold refuses with a structured reason. +;; Every helper returns `(ok . VALUE)' or `(refuse . REASON)'. + +(defun pearl--rc-refuse (fmt &rest args) + "Build a structured refusal result `(refuse . REASON)' from FMT and ARGS." + (cons 'refuse (apply #'format fmt args))) + +(defun pearl--rc-unwrap (node) + "Collapse a single-branch `and'/`or' wrapper in dimension-condition NODE. +When NODE is `((and . [X]))' or `((or . [X]))' with exactly one branch, return X +unwrapped. A multi-branch wrapper is a real conjunction/disjunction and is +returned as-is for the matcher to refuse. Other NODEs pass through." + (let ((wrap (and (consp node) (= 1 (length node)) + (or (assq 'and node) (assq 'or node))))) + (if wrap + (let ((branches (cdr wrap))) + (if (and (vectorp branches) (= 1 (length branches))) + (pearl--rc-unwrap (aref branches 0)) + node)) + node))) + +(defun pearl--rc-scalar (opnode dim) + "Extract a singular scalar from operator OPNODE for dimension DIM. +Accepts `eq' or a one-element `in'. A multi-value `in' or any other operator +refuses -- Pearl's singular keys hold one value, and silently narrowing a +multi-value filter would change which issues match." + (cond + ((not (consp opnode)) (pearl--rc-refuse "%s has an unexpected shape" dim)) + ((assq 'eq opnode) (cons 'ok (cdr (assq 'eq opnode)))) + ((assq 'in opnode) + (let ((v (cdr (assq 'in opnode)))) + (cond + ((and (vectorp v) (= 1 (length v))) (cons 'ok (aref v 0))) + ((and (vectorp v) (> (length v) 1)) + (pearl--rc-refuse + "%s filters on several values; Pearl has no plural key for it" dim)) + (t (pearl--rc-refuse "%s has an empty or malformed `in'" dim))))) + (t (pearl--rc-refuse + "%s uses an operator (%s) Pearl can't represent" + dim (mapconcat (lambda (p) (symbol-name (car p))) opnode "/"))))) + +(defun pearl--rc-match-assignee (cnode) + "Match an assignee condition CNODE to an authoring fragment." + (let ((node (pearl--rc-unwrap cnode))) + (cond + ((or (assq 'and node) (assq 'or node)) + (pearl--rc-refuse "assignee uses OR logic Pearl can't represent")) + ((assq 'isMe node) + (if (eq (cdr (assq 'eq (cdr (assq 'isMe node)))) t) + (cons 'ok (list :assignee :me)) + (pearl--rc-refuse "assignee.isMe is negated"))) + ((assq 'id node) + (let ((r (pearl--rc-scalar (cdr (assq 'id node)) "assignee.id"))) + (if (eq (car r) 'ok) (cons 'ok (list :assignee-id (cdr r))) r))) + ((assq 'email node) + (let ((r (pearl--rc-scalar (cdr (assq 'email node)) "assignee.email"))) + (if (eq (car r) 'ok) (cons 'ok (list :assignee (cdr r))) r))) + (t (pearl--rc-refuse "assignee uses a field Pearl can't represent"))))) + +(defun pearl--rc-match-state (cnode) + "Match a state condition CNODE to `:state', `:state-type', or `:open'." + (let ((node (pearl--rc-unwrap cnode))) + (cond + ((or (assq 'and node) (assq 'or node)) + (pearl--rc-refuse "state uses OR logic Pearl can't represent")) + ((assq 'name node) + (let ((r (pearl--rc-scalar (cdr (assq 'name node)) "state.name"))) + (if (eq (car r) 'ok) (cons 'ok (list :state (cdr r))) r))) + ((assq 'type node) + (let ((op (cdr (assq 'type node)))) + (cond + ((assq 'nin op) + (let ((vals (append (cdr (assq 'nin op)) nil))) + (if (and (= (length vals) (length pearl--open-state-types)) + (cl-subsetp vals pearl--open-state-types :test #'string=) + (cl-subsetp pearl--open-state-types vals :test #'string=)) + (cons 'ok (list :open t)) + (pearl--rc-refuse + "state.type uses a `nin' that isn't Pearl's open predicate")))) + ((assq 'in op) + (let ((vals (append (cdr (assq 'in op)) nil))) + (cons 'ok (list :state-type (if (= 1 (length vals)) (car vals) vals))))) + ((assq 'eq op) + (cons 'ok (list :state-type (cdr (assq 'eq op))))) + (t (pearl--rc-refuse "state.type uses an operator Pearl can't represent"))))) + (t (pearl--rc-refuse "state uses a field Pearl can't represent"))))) + +(defun pearl--rc-match-scalar-dim (cnode field dim authoring-key) + "Match a single-field scalar dimension (project.id, team.key, cycle.id)." + (let ((node (pearl--rc-unwrap cnode))) + (cond + ((or (assq 'and node) (assq 'or node)) + (pearl--rc-refuse "%s uses OR logic Pearl can't represent" dim)) + ((assq field node) + (let ((r (pearl--rc-scalar (cdr (assq field node)) dim))) + (if (eq (car r) 'ok) (cons 'ok (list authoring-key (cdr r))) r))) + (t (pearl--rc-refuse "%s uses a field Pearl can't represent" dim))))) + +(defun pearl--rc-match-labels (cnode) + "Match a labels condition CNODE to `:labels' (names) or `:label-id' (one id)." + (let ((node (pearl--rc-unwrap cnode))) + (cond + ((or (assq 'every node) (assq 'none node)) + (pearl--rc-refuse "labels uses `every'/`none'; Pearl only does `some'")) + ((or (assq 'and node) (assq 'or node)) + (pearl--rc-refuse + "labels uses nested and/or (e.g. a label parent) Pearl can't represent")) + ((assq 'some node) + (let ((some (pearl--rc-unwrap (cdr (assq 'some node))))) + (cond + ((or (assq 'and some) (assq 'or some)) + (pearl--rc-refuse + "labels.some uses nested and/or Pearl can't represent")) + ((assq 'name some) + (let ((op (cdr (assq 'name some)))) + (if (assq 'in op) + (cons 'ok (list :labels (append (cdr (assq 'in op)) nil))) + (let ((r (pearl--rc-scalar op "labels.some.name"))) + (if (eq (car r) 'ok) (cons 'ok (list :labels (list (cdr r)))) r))))) + ((assq 'id some) + (let ((r (pearl--rc-scalar (cdr (assq 'id some)) "labels.some.id"))) + (if (eq (car r) 'ok) (cons 'ok (list :label-id (cdr r))) r))) + (t (pearl--rc-refuse "labels.some uses a field Pearl can't represent"))))) + (t (pearl--rc-refuse "labels uses a shape Pearl can't represent"))))) + +(defun pearl--rc-match-priority (cnode) + "Match a priority condition CNODE to canonical numeric `:priority' (0..4)." + (let ((node (pearl--rc-unwrap cnode))) + (if (assq 'eq node) + (let ((n (cdr (assq 'eq node)))) + (if (and (integerp n) (<= 0 n 4)) + (cons 'ok (list :priority n)) + (pearl--rc-refuse "priority %S is outside 0..4" n))) + (pearl--rc-refuse "priority uses an operator Pearl can't represent")))) + +(defun pearl--rc-match-conjunct (conjunct) + "Match one CONJUNCT (a one-key alist) to an authoring plist fragment." + (if (or (not (consp conjunct)) (not (= 1 (length conjunct)))) + (pearl--rc-refuse "a filter clause has an unexpected shape") + (let ((dim (caar conjunct)) + (cnode (cdar conjunct))) + (pcase dim + ('assignee (pearl--rc-match-assignee cnode)) + ('state (pearl--rc-match-state cnode)) + ('project (pearl--rc-match-scalar-dim cnode 'id "project" :project)) + ('team (pearl--rc-match-scalar-dim cnode 'key "team" :team)) + ('cycle (pearl--rc-match-scalar-dim cnode 'id "cycle" :cycle)) + ('labels (pearl--rc-match-labels cnode)) + ('priority (pearl--rc-match-priority cnode)) + (_ (pearl--rc-refuse + "filters on `%s', a dimension Pearl can't represent" dim)))))) + +(defun pearl--rc-conjuncts (filter-data) + "Return `(ok . CONJUNCTS)' or `(refuse . REASON)' from FILTER-DATA. +Flattens a top-level `and' (the real Linear shape) and the flat sibling-keyed +object Pearl's own compiler emits; refuses a top-level `or' or an empty filter." + (cond + ((null filter-data) (pearl--rc-refuse "the Linear view has no filter")) + ((not (consp filter-data)) + (pearl--rc-refuse "the Linear view filter has an unexpected shape")) + ((and (assq 'and filter-data) (= 1 (length filter-data))) + (let ((branches (append (cdr (assq 'and filter-data)) nil))) + (if branches (cons 'ok branches) + (pearl--rc-refuse "the Linear view has no filter")))) + ((and (assq 'or filter-data) (= 1 (length filter-data))) + (pearl--rc-refuse "the Linear view uses top-level OR logic Pearl can't represent")) + (t (cons 'ok (mapcar (lambda (pair) (list pair)) filter-data))))) + +(defun pearl--reverse-compile-issue-filter (filter-data) + "Reverse-compile Linear FILTER-DATA (json-read shaped) to an authoring plist. +Returns `(ok . PLIST)' on success, or `(refuse . REASON)' when the view's filter +is outside Pearl's AND-only, singular-keyed authoring model. The REASON names +the offending construct so the command can tell the user what to do instead." + (let ((conj (pearl--rc-conjuncts filter-data))) + (if (eq (car conj) 'refuse) conj + (catch 'done + (let ((plist nil)) + (dolist (c (cdr conj)) + (let ((m (pearl--rc-match-conjunct c))) + (when (eq (car m) 'refuse) (throw 'done m)) + (setq plist (append plist (cdr m))))) + (cons 'ok plist)))))) + (defun pearl--validate-issue-filter (plist) "Validate issue-filter PLIST, signaling a `user-error' on any problem. Return t when PLIST is well-formed. Checks plist shape, unknown keys, the @@ -3838,6 +4030,89 @@ missing setup." (lambda (result) (pearl--render-query-result result source)) (pearl--sort->order-by (plist-get source :sort)))))))))))) +;;; Copy down: save a Linear view as a local view (see the reverse-compile above) + +(defun pearl--customview-filterdata-async (view-id callback) + "Fetch the `filterData' of Custom View VIEW-ID and call CALLBACK with it. +CALLBACK receives the json-read-shaped filter object, or nil on a transport / +GraphQL error or a view with no readable filter." + (pearl--graphql-request-async + "query ViewFilter($id: String!) { customView(id: $id) { filterData } }" + `(("id" . ,view-id)) + (lambda (response) + (let* ((cv (cdr (assq 'customView (cdr (assq 'data response))))) + (fd (and cv (cdr (assq 'filterData cv))))) + (funcall callback fd))) + (lambda (&rest _) (funcall callback nil)))) + +(defun pearl--linear-view-favorites (favorites) + "Return `((TITLE . VIEW-ID) ...)' for the view-kind entries in FAVORITES. +These are the copy-down candidates -- only a favorited Linear view carries a +Custom View id and a readable filter." + (delq nil + (mapcar (lambda (fav) + (when (eq (plist-get fav :kind) 'view) + (cons (plist-get fav :title) (plist-get fav :id)))) + favorites))) + +(defun pearl--save-linear-view-locally-finish (title view-id filter-data) + "Reverse-compile FILTER-DATA for Linear view TITLE/VIEW-ID and save a fork. +On a refusal, signal a `user-error' naming the construct and pointing at +`pearl-run-linear-view'. On success, save a forked local view (no tracking +link, `:copied-from-view-id' provenance only) and report the independence." + (when (null filter-data) + (user-error + "Couldn't read a filter for \"%s\" (it may have none, or the fetch failed); try again or run it with `pearl-run-linear-view'" + title)) + (let ((rc (pearl--reverse-compile-issue-filter filter-data))) + (if (eq (car rc) 'refuse) + (user-error + "Can't copy \"%s\" down: %s. Run it with `pearl-run-linear-view' instead" + title (cdr rc)) + (let* ((filter (cdr rc)) + (name (pearl--resolve-local-view-name + (read-string "Name for the local view: " title)))) + (unless name (user-error "Cancelled; no local view created")) + (pearl--save-local-view name filter) + ;; Record provenance for reference only -- this is a fork, not a sync + ;; link, so it carries no :linear-view-id. + (let ((entry (assoc name pearl-local-views))) + (when entry + (setcdr entry (plist-put (cdr entry) :copied-from-view-id view-id)) + (ignore-errors + (customize-save-variable 'pearl-local-views pearl-local-views)))) + (message + "Saved Linear view %s as independent local view %s; edits won't update the original until you publish it back" + title name))))) + +;;;###autoload +(defun pearl-save-linear-view-locally () + "Copy a favorited Linear view down into a new, editable local view. +Lists your favorited Linear views, fetches the chosen view's filter, reverse- +compiles it into a Pearl authoring filter, and saves a forked local view -- no +tracking link, so editing or renaming it never touches the Linear view. The new +view is stamped with the active account. When the view's filter is outside +Pearl's local model (OR logic, an unmodeled dimension, a multi-value filter), +refuses and names the construct; run such a view directly with +`pearl-run-linear-view'." + (interactive) + (pearl--require-account-context t) + (pearl--progress "Fetching favorited Linear views...") + (pearl--favorites-async + (lambda (favorites) + (let ((views (pearl--linear-view-favorites favorites))) + (unless views + (user-error + "No favorited Linear views; favorite a view in Linear first, then copy it down")) + (let* ((title (completing-read "Save Linear view locally: " + (mapcar #'car views) nil t)) + (view-id (cdr (assoc title views)))) + (pearl--progress "Fetching filter for %s..." title) + (pearl--customview-filterdata-async + view-id + (lambda (filter-data) + (pearl--save-linear-view-locally-finish title view-id filter-data)))))))) + (defun pearl--assemble-filter (team open state project labels assignee) "Assemble a filter authoring plist from the chosen dimensions. The non-nil of TEAM, OPEN, STATE, PROJECT, LABELS, and ASSIGNEE appear (an @@ -6308,6 +6583,7 @@ body stay." ("Q" "run local view" pearl-run-local-view) ("v" "run Linear view" pearl-run-linear-view) ("u" "publish local view" pearl-publish-local-view) + ("d" "save Linear view locally" pearl-save-linear-view-locally) ("U" "publish current view" pearl-publish-current-view) ("X" "delete local view" pearl-delete-local-view)] ["Buffer" @@ -6352,6 +6628,7 @@ body stay." (define-key map "v" (cons "run Linear view" #'pearl-run-linear-view)) (define-key map "l" (cons "run local view" #'pearl-run-local-view)) (define-key map "u" (cons "publish local view" #'pearl-publish-local-view)) + (define-key map "d" (cons "save Linear view locally" #'pearl-save-linear-view-locally)) (define-key map "P" (cons "publish current view" #'pearl-publish-current-view)) map) "Pearl fetch commands; a sub-keymap of `pearl-prefix-map'. diff --git a/tests/test-pearl-keymap.el b/tests/test-pearl-keymap.el index a02dd47..89fe349 100644 --- a/tests/test-pearl-keymap.el +++ b/tests/test-pearl-keymap.el @@ -75,6 +75,8 @@ The lowercase `c' is no longer a direct command -- it is the create prefix." (should (eq 'pearl-run-local-view (lookup-key pearl-prefix-map (kbd "f l")))) (should (eq 'pearl-publish-local-view (lookup-key pearl-prefix-map (kbd "f u")))) + (should (eq 'pearl-save-linear-view-locally + (lookup-key pearl-prefix-map (kbd "f d")))) (should (eq 'pearl-publish-current-view (lookup-key pearl-prefix-map (kbd "f P"))))) diff --git a/tests/test-pearl-naming.el b/tests/test-pearl-naming.el index 41077e9..383b913 100644 --- a/tests/test-pearl-naming.el +++ b/tests/test-pearl-naming.el @@ -33,8 +33,11 @@ pearl-delete-local-view pearl-publish-local-view pearl-publish-current-view - pearl-run-linear-view) - "Public commands the rename introduces.") + pearl-run-linear-view + pearl-create-local-view + pearl-edit-local-view + pearl-save-linear-view-locally) + "Public commands the rename and the new phases introduce.") (defconst test-pearl-naming--old-symbols '(pearl-saved-queries diff --git a/tests/test-pearl-reverse-compile.el b/tests/test-pearl-reverse-compile.el new file mode 100644 index 0000000..ec67391 --- /dev/null +++ b/tests/test-pearl-reverse-compile.el @@ -0,0 +1,226 @@ +;;; test-pearl-reverse-compile.el --- Tests for copy-down reverse-compile -*- 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: + +;; Phase 6: `pearl--reverse-compile-issue-filter' inverts Linear's filterData +;; (json-read shaped) back to a Pearl authoring plist. Round-trips use the +;; build->encode->read bridge so the input matches production shape, and assert +;; the reversed plist compiles to the SAME Linear filter (order- and +;; canonicalization-robust). Normalize tests feed hand-built and/or trees like +;; the real probe samples. Refusal tests cover everything outside the model. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'json) + +(defun test-pearl-rc--roundtrip (plist) + "Build PLIST, json round-trip it to production shape, and reverse-compile." + (pearl--reverse-compile-issue-filter + (json-read-from-string (json-encode (pearl--build-issue-filter plist))))) + +(defmacro test-pearl-rc--should-roundtrip (plist) + "Assert PLIST reverse-compiles to a plist that rebuilds the same Linear filter." + `(let ((result (test-pearl-rc--roundtrip ,plist))) + (should (eq 'ok (car result))) + (should (equal (pearl--build-issue-filter (cdr result)) + (pearl--build-issue-filter ,plist))))) + +;;; round-trips, per dimension + +(ert-deftest test-pearl-rc-roundtrip-assignee-me () + (test-pearl-rc--should-roundtrip '(:assignee :me))) + +(ert-deftest test-pearl-rc-roundtrip-assignee-id () + (test-pearl-rc--should-roundtrip '(:assignee-id "user-1"))) + +(ert-deftest test-pearl-rc-roundtrip-assignee-email-legacy () + (test-pearl-rc--should-roundtrip '(:assignee "a@b.com"))) + +(ert-deftest test-pearl-rc-roundtrip-state-name () + (test-pearl-rc--should-roundtrip '(:state "In Progress"))) + +(ert-deftest test-pearl-rc-roundtrip-state-type-single () + (let ((r (test-pearl-rc--roundtrip '(:state-type "started")))) + (should (eq 'ok (car r))) + (should (equal (cdr r) '(:state-type "started"))))) + +(ert-deftest test-pearl-rc-roundtrip-state-type-list () + (let ((r (test-pearl-rc--roundtrip '(:state-type ("started" "unstarted"))))) + (should (eq 'ok (car r))) + (should (equal (cdr r) '(:state-type ("started" "unstarted")))))) + +(ert-deftest test-pearl-rc-roundtrip-open () + (let ((r (test-pearl-rc--roundtrip '(:open t)))) + (should (eq 'ok (car r))) + (should (equal (cdr r) '(:open t))))) + +(ert-deftest test-pearl-rc-roundtrip-open-with-project () + (test-pearl-rc--should-roundtrip '(:project "proj-9" :open t))) + +(ert-deftest test-pearl-rc-roundtrip-project-team-cycle () + (test-pearl-rc--should-roundtrip '(:project "P" :team "ENG" :cycle "C"))) + +(ert-deftest test-pearl-rc-roundtrip-labels-names () + (test-pearl-rc--should-roundtrip '(:labels ("bug" "p1")))) + +(ert-deftest test-pearl-rc-roundtrip-label-id () + (test-pearl-rc--should-roundtrip '(:label-id "label-1"))) + +(ert-deftest test-pearl-rc-roundtrip-priority-int () + (let ((r (test-pearl-rc--roundtrip '(:priority 2)))) + (should (equal (cdr r) '(:priority 2))))) + +(ert-deftest test-pearl-rc-roundtrip-priority-symbol-canonicalizes () + "A symbol-authored priority reverse-compiles to its canonical integer." + (let ((r (test-pearl-rc--roundtrip '(:priority high)))) + (should (eq 'ok (car r))) + (should (equal (cdr r) '(:priority 2))))) + +(ert-deftest test-pearl-rc-roundtrip-favorite-derived-open-shapes () + "The favorite-derived (:project ID :open t) family round-trips." + (test-pearl-rc--should-roundtrip '(:project "P" :open t)) + (test-pearl-rc--should-roundtrip '(:label-id "L" :open t)) + (test-pearl-rc--should-roundtrip '(:assignee-id "U" :open t))) + +;;; normalize from real Linear view-filter trees (probe-shaped JSON) + +(defun test-pearl-rc--from-json (json) + "Reverse-compile filterData parsed from JSON string (the production path)." + (pearl--reverse-compile-issue-filter (json-read-from-string json))) + +(ert-deftest test-pearl-rc-normalize-and-tree-with-or-wrapped-isme () + "A top-level `and' with an `or'-wrapped isMe (the real shape) normalizes." + (should (equal (test-pearl-rc--from-json + "{\"and\":[{\"project\":{\"id\":{\"in\":[\"P9\"]}}},\ +{\"assignee\":{\"or\":[{\"isMe\":{\"eq\":true}}]}}]}") + '(ok :project "P9" :assignee :me)))) + +(ert-deftest test-pearl-rc-normalize-state-name-in-single () + "state.name.in with one element reads as a scalar :state." + (should (equal (test-pearl-rc--from-json + "{\"and\":[{\"state\":{\"name\":{\"in\":[\"Needs Review\"]}}},\ +{\"assignee\":{\"or\":[{\"id\":{\"in\":[\"u-1\"]}}]}}]}") + '(ok :state "Needs Review" :assignee-id "u-1")))) + +(ert-deftest test-pearl-rc-normalize-empty-filter-refuses () + "An empty grouping view ({} -> nil) refuses." + (should (eq 'refuse (car (test-pearl-rc--from-json "{}"))))) + +;;; refusals + +(ert-deftest test-pearl-rc-refuses-real-or () + "A genuine multi-branch assignee OR refuses." + (let ((r (test-pearl-rc--from-json + "{\"and\":[{\"assignee\":{\"or\":[{\"isMe\":{\"eq\":true}},\ +{\"id\":{\"eq\":\"u-2\"}}]}}]}"))) + (should (eq 'refuse (car r))) + (should (string-match-p "OR" (cdr r))))) + +(ert-deftest test-pearl-rc-refuses-label-parent-nested () + "The Chore-style labels.and[].or[name, parent.name] refuses." + (should (eq 'refuse + (car (test-pearl-rc--from-json + "{\"and\":[{\"labels\":{\"and\":[{\"or\":\ +[{\"name\":{\"eq\":\"Chore\"}},{\"parent\":{\"name\":{\"eq\":\"Chore\"}}}]}]}}]}"))))) + +(ert-deftest test-pearl-rc-refuses-multi-id-labels () + (let ((r (test-pearl-rc--from-json + "{\"labels\":{\"some\":{\"id\":{\"in\":[\"L1\",\"L2\"]}}}}"))) + (should (eq 'refuse (car r))) + (should (string-match-p "several values\\|plural" (cdr r))))) + +(ert-deftest test-pearl-rc-refuses-multi-value-project-in () + (should (eq 'refuse (car (test-pearl-rc--from-json + "{\"project\":{\"id\":{\"in\":[\"P1\",\"P2\"]}}}"))))) + +(ert-deftest test-pearl-rc-refuses-multi-value-assignee-id () + (should (eq 'refuse (car (test-pearl-rc--from-json + "{\"assignee\":{\"id\":{\"in\":[\"A\",\"B\"]}}}"))))) + +(ert-deftest test-pearl-rc-refuses-unmodeled-dimension () + "A due-date filter (a dimension Pearl doesn't model) refuses by name." + (let ((r (test-pearl-rc--from-json "{\"dueDate\":{\"lt\":\"2026-06-01\"}}"))) + (should (eq 'refuse (car r))) + (should (string-match-p "dueDate" (cdr r))))) + +(ert-deftest test-pearl-rc-refuses-generic-nin () + "A state.type.nin that is not Pearl's exact open predicate refuses." + (should (eq 'refuse (car (test-pearl-rc--from-json + "{\"state\":{\"type\":{\"nin\":[\"started\"]}}}"))))) + +(ert-deftest test-pearl-rc-refuses-priority-out-of-range () + (should (eq 'refuse (car (test-pearl-rc--from-json + "{\"priority\":{\"eq\":9}}"))))) + +(ert-deftest test-pearl-rc-refuses-top-level-or () + (should (eq 'refuse (car (test-pearl-rc--from-json + "{\"or\":[{\"project\":{\"id\":{\"eq\":\"P\"}}},\ +{\"team\":{\"key\":{\"eq\":\"ENG\"}}}]}"))))) + +;;; copy-down command-side: candidate builder + finish + +(ert-deftest test-pearl-linear-view-favorites-extracts-views () + "Only view-kind favorites become copy-down candidates, as (title . id)." + (let ((favs (list (list :kind 'view :title "V1" :id "vid-1") + (list :kind 'project :title "P" :id "pid") + (list :kind 'view :title "V2" :id "vid-2")))) + (should (equal (pearl--linear-view-favorites favs) + '(("V1" . "vid-1") ("V2" . "vid-2")))))) + +(ert-deftest test-pearl-save-linear-view-locally-finish-nil-filterdata-errors () + "A nil filterData (fetch failure / no filter) errors rather than saving." + (cl-letf (((symbol-function 'customize-save-variable) (lambda (&rest _) nil))) + (should-error (pearl--save-linear-view-locally-finish "V" "vid" nil) + :type 'user-error))) + +(ert-deftest test-pearl-save-linear-view-locally-finish-refuses-unrepresentable () + "An OR-filter view refuses with a user-error and saves nothing." + (let ((pearl-local-views nil)) + (cl-letf (((symbol-function 'customize-save-variable) (lambda (&rest _) nil))) + (should-error + (pearl--save-linear-view-locally-finish + "OrView" "vid" + (json-read-from-string + "{\"or\":[{\"project\":{\"id\":{\"eq\":\"P\"}}},\ +{\"team\":{\"key\":{\"eq\":\"E\"}}}]}")) + :type 'user-error) + (should-not pearl-local-views)))) + +(ert-deftest test-pearl-save-linear-view-locally-finish-saves-fork () + "A representable view saves a forked local view: filter reverse-compiled, no +tracking link, provenance recorded, and an independence message." + (let ((pearl-local-views nil) (pearl-accounts nil) (msg nil)) + (cl-letf (((symbol-function 'customize-save-variable) (lambda (&rest _) nil)) + ((symbol-function 'read-string) (lambda (&rest _) "My copy")) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (pearl--save-linear-view-locally-finish + "Src View" "src-vid" + (json-read-from-string "{\"and\":[{\"project\":{\"id\":{\"in\":[\"P9\"]}}}]}")) + (let ((spec (cdr (assoc "My copy" pearl-local-views)))) + (should spec) + (should (equal (plist-get spec :filter) '(:project "P9"))) + (should-not (plist-get spec :linear-view-id)) + (should (equal (plist-get spec :copied-from-view-id) "src-vid")) + (should (string-match-p "independent local view" msg)))))) + +(provide 'test-pearl-reverse-compile) +;;; test-pearl-reverse-compile.el ends here |