path: root/tests/test-pearl-reverse-compile.el

;;; 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-name-list ()
  "A multi-state :state round-trips (state.name.in with several names)."
  (let ((r (test-pearl-rc--roundtrip '(:state ("Todo" "In Review")))))
    (should (eq 'ok (car r)))
    (should (equal (cdr r) '(:state ("Todo" "In Review"))))))

(ert-deftest test-pearl-rc-state-name-in-many-to-list ()
  "state.name.in with several names reverse-compiles to a list :state."
  (should (equal (test-pearl-rc--from-json
                  "{\"state\":{\"name\":{\"in\":[\"Todo\",\"In Review\"]}}}")
                 '(ok :state ("Todo" "In Review")))))

(ert-deftest test-pearl-rc-state-name-in-one-to-scalar ()
  "state.name.in with one name normalizes to a scalar :state."
  (should (equal (test-pearl-rc--from-json
                  "{\"state\":{\"name\":{\"in\":[\"Todo\"]}}}")
                 '(ok :state "Todo"))))

(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-save-linear-view-locally-saves-current-view ()
  "When the buffer shows a Linear view, the command offers to save that view
directly -- without touching favorites or fetching the custom-view list -- and
hands its name + id to the finisher."
  (let (finished favorites-called custom-views-called)
    (cl-letf (((symbol-function 'pearl--require-account-context) (lambda (&rest _) nil))
              ((symbol-function 'pearl--read-active-source)
               (lambda () '(:type view :name "Pearl Open Issues" :id "view-1")))
              ((symbol-function 'pearl--read-yes-no) (lambda (&rest _) t))
              ((symbol-function 'pearl--progress) (lambda (&rest _) nil))
              ((symbol-function 'pearl--favorites-async)
               (lambda (&rest _) (setq favorites-called t)))
              ((symbol-function 'pearl--custom-views)
               (lambda (&rest _) (setq custom-views-called t) nil))
              ((symbol-function 'pearl--customview-filterdata-async)
               (lambda (view-id cb) (funcall cb (list view-id))))
              ((symbol-function 'pearl--save-linear-view-locally-finish)
               (lambda (title view-id _fd) (setq finished (cons title view-id)))))
      (pearl-save-linear-view-locally)
      (should (equal finished '("Pearl Open Issues" . "view-1")))
      (should-not favorites-called)
      (should-not custom-views-called))))

(ert-deftest test-pearl-save-linear-view-locally-picks-from-all-views ()
  "With no view in the buffer, the picker lists ALL custom views (not just
favorites) and hands the chosen view's name + id to the finisher."
  (let (finished favorites-called)
    (cl-letf (((symbol-function 'pearl--require-account-context) (lambda (&rest _) nil))
              ((symbol-function 'pearl--read-active-source) (lambda () nil))
              ((symbol-function 'pearl--progress) (lambda (&rest _) nil))
              ((symbol-function 'pearl--favorites-async)
               (lambda (&rest _) (setq favorites-called t)))
              ((symbol-function 'pearl--custom-views)
               (lambda (&rest _)
                 '(((id . "v1") (name . "Pearl Open Issues"))
                   ((id . "v2") (name . "My bugs")))))
              ((symbol-function 'completing-read) (lambda (&rest _) "My bugs"))
              ((symbol-function 'pearl--customview-filterdata-async)
               (lambda (view-id cb) (funcall cb (list view-id))))
              ((symbol-function 'pearl--save-linear-view-locally-finish)
               (lambda (title view-id _fd) (setq finished (cons title view-id)))))
      (pearl-save-linear-view-locally)
      (should (equal finished '("My bugs" . "v2")))
      (should-not favorites-called))))

(ert-deftest test-pearl-save-linear-view-locally-declined-current-falls-to-picker ()
  "Declining the current-view offer falls through to the all-views picker."
  (let (finished)
    (cl-letf (((symbol-function 'pearl--require-account-context) (lambda (&rest _) nil))
              ((symbol-function 'pearl--read-active-source)
               (lambda () '(:type view :name "Current" :id "cur")))
              ((symbol-function 'pearl--read-yes-no) (lambda (&rest _) nil))
              ((symbol-function 'pearl--progress) (lambda (&rest _) nil))
              ((symbol-function 'pearl--custom-views)
               (lambda (&rest _) '(((id . "v9") (name . "Picked")))))
              ((symbol-function 'completing-read) (lambda (&rest _) "Picked"))
              ((symbol-function 'pearl--customview-filterdata-async)
               (lambda (view-id cb) (funcall cb (list view-id))))
              ((symbol-function 'pearl--save-linear-view-locally-finish)
               (lambda (title view-id _fd) (setq finished (cons title view-id)))))
      (pearl-save-linear-view-locally)
      (should (equal finished '("Picked" . "v9"))))))

(ert-deftest test-pearl-save-linear-view-locally-no-views-errors ()
  "With no current view and no custom views, the command errors rather than
silently saving nothing."
  (cl-letf (((symbol-function 'pearl--require-account-context) (lambda (&rest _) nil))
            ((symbol-function 'pearl--read-active-source) (lambda () nil))
            ((symbol-function 'pearl--progress) (lambda (&rest _) nil))
            ((symbol-function 'pearl--custom-views) (lambda (&rest _) nil)))
    (should-error (pearl-save-linear-view-locally) :type 'user-error)))

(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