;;; test-pearl-states.el --- Tests for pearl state management -*- lexical-binding: t; -*- ;; Copyright (C) 2026 Craig Jennings ;; Author: Craig Jennings ;; 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 . ;;; Commentary: ;; Tests for workflow-state fetching, state name -> id resolution, and the ;; two state-update entry points. Covers the guard that skips the mutation ;; when the state name doesn't resolve, so no request fires with a null id. ;;; Code: (require 'test-bootstrap (expand-file-name "test-bootstrap.el")) (require 'testutil-request (expand-file-name "testutil-request.el")) (require 'cl-lib) ;;; pearl-get-states-async (ert-deftest test-pearl-get-states-async-parses-nodes () "Workflow states are unwrapped and passed to the callback." (let ((got nil)) (testutil-linear-with-response '((data (team (states (nodes . (((id . "s1") (name . "Todo")) ((id . "s2") (name . "Done")))))))) (pearl-get-states-async "team-1" (lambda (states) (setq got states)))) (should (= 2 (length got))) (should (string-equal "s1" (cdr (assoc 'id (car got))))))) ;;; pearl--get-state-id-by-name (ert-deftest test-pearl-get-state-id-by-name-found () "A state whose name matches (case-insensitively) resolves to its id." (let ((pearl--cache-states nil)) (testutil-linear-with-response '((data (team (states (nodes . (((id . "s1") (name . "Todo")) ((id . "s2") (name . "Done")))))))) (should (string-equal "s2" (pearl--get-state-id-by-name "done" "team-1")))))) (ert-deftest test-pearl-get-state-id-by-name-not-found () "A state name absent from the team resolves to nil." (let ((pearl--cache-states nil)) (testutil-linear-with-response '((data (team (states (nodes . (((id . "s1") (name . "Todo")))))))) (should (null (pearl--get-state-id-by-name "Archived" "team-1")))))) (ert-deftest test-pearl-state-lookup-caches-per-team () "A second lookup for the same team is served from cache, no new request." (let ((pearl-api-key "test-key") (pearl--cache-states nil) (calls 0)) (cl-letf (((symbol-function 'request) (lambda (_url &rest args) (setq calls (1+ calls)) (funcall (plist-get args :success) :data '((data (team (states (nodes . (((id . "s1") (name . "Todo")) ((id . "s2") (name . "Done")))))))))))) (should (string-equal "s2" (pearl--get-state-id-by-name "Done" "team-1"))) (should (string-equal "s1" (pearl--get-state-id-by-name "Todo" "team-1"))) (should (= 1 calls))))) ;;; pearl-update-issue-state (sync) -- nil-state-id guard (ert-deftest test-pearl-update-issue-state-nil-state-id-skips-request () "When the state name doesn't resolve, no mutation request is fired." (let ((requested nil) (pearl-api-key "test-key")) (cl-letf (((symbol-function 'pearl--get-state-id-by-name) (lambda (_s _t) nil)) ((symbol-function 'request) (lambda (&rest _) (setq requested t)))) (pearl-update-issue-state "i-1" "Nonexistent" "team-1") (should-not requested)))) (ert-deftest test-pearl-update-issue-state-resolved-fires-request () "When the state resolves, the mutation request is fired." (let ((requested nil) (pearl-api-key "test-key")) (cl-letf (((symbol-function 'pearl--get-state-id-by-name) (lambda (_s _t) "s2")) ((symbol-function 'request) (lambda (_url &rest args) (setq requested t) (let ((cb (plist-get args :success))) (when cb (funcall cb :data '((data (issueUpdate (success . t)))))))))) (pearl-update-issue-state "i-1" "Done" "team-1") (should requested)))) ;;; pearl--update-issue-state-async -- nil-state-id guard (ert-deftest test-pearl-update-issue-state-async-nil-state-id-skips-request () "The async update also short-circuits when the state name doesn't resolve." (let ((requested nil) (pearl-api-key "test-key")) (cl-letf (((symbol-function 'pearl--get-state-id-by-name) (lambda (_s _t) nil)) ((symbol-function 'request) (lambda (&rest _) (setq requested t)))) (pearl--update-issue-state-async "i-1" "Nonexistent" "team-1") (should-not requested)))) (ert-deftest test-pearl-update-issue-state-async-success-runs () "The async success handler runs on a successful update." (let ((pearl-api-key "test-key")) (cl-letf (((symbol-function 'pearl--get-state-id-by-name) (lambda (_s _t) "s2")) ((symbol-function 'request) (lambda (_url &rest args) (funcall (plist-get args :success) :data '((data (issueUpdate (success . t)))))))) (should (progn (pearl--update-issue-state-async "i-1" "Done" "team-1") t))))) (ert-deftest test-pearl-update-issue-state-async-error-runs () "The async error handler runs on a transport error." (let ((pearl-api-key "test-key")) (cl-letf (((symbol-function 'pearl--get-state-id-by-name) (lambda (_s _t) "s2")) ((symbol-function 'request) (lambda (_url &rest args) (funcall (plist-get args :error) :error-thrown "boom" :response (make-request-response :status-code 500) :data nil)))) (should (progn (pearl--update-issue-state-async "i-1" "Done" "team-1") t))))) (provide 'test-pearl-states) ;;; test-pearl-states.el ends here