path: root/tests/test-wttrin-saved-locations.el

;;; test-wttrin-saved-locations.el --- Tests for the named-locations directory -*- lexical-binding: t; -*-

;; Copyright (C) 2024-2026 Craig Jennings

;;; Commentary:
;; Unit tests for the named-locations directory (Phase 1): the normalizer
;; `wttrin--saved-locations', the resolver `wttrin--resolve-location-query',
;; candidate de-duplication/precedence, favorite-as-name resolution, alias cache
;; identity, history suppression of saved names, and savehist registration.

;;; Code:

(require 'ert)
(require 'cl-lib)
(require 'wttrin)
(require 'testutil-wttrin)

;;; wttrin--saved-locations (normalizer)

(ert-deftest test-wttrin-saved-locations-normal-pairs-returned ()
  "Normal: well-formed pairs are returned as (NAME . QUERY)."
  (let ((wttrin-saved-locations '(("Home" . "1500 Sugar Bowl Dr, New Orleans"))))
    (should (equal '(("Home" . "1500 Sugar Bowl Dr, New Orleans"))
                   (wttrin--saved-locations)))))

(ert-deftest test-wttrin-saved-locations-boundary-bare-string-shorthand ()
  "Boundary: a bare string S becomes (S . S)."
  (let ((wttrin-saved-locations '("Berkeley, CA")))
    (should (equal '(("Berkeley, CA" . "Berkeley, CA"))
                   (wttrin--saved-locations)))))

(ert-deftest test-wttrin-saved-locations-boundary-whitespace-trimmed ()
  "Boundary: surrounding whitespace on name and query is trimmed."
  (let ((wttrin-saved-locations '(("  Home  " . "  Paris, FR  "))))
    (should (equal '(("Home" . "Paris, FR")) (wttrin--saved-locations)))))

(ert-deftest test-wttrin-saved-locations-error-malformed-skipped ()
  "Error: non-cons, non-string, and empty entries are skipped, not fatal."
  (let ((wttrin-saved-locations
         (list '("Good" . "Tokyo") 42 '("" . "x") '("y" . "") "  " '(a . b))))
    (should (equal '(("Good" . "Tokyo")) (wttrin--saved-locations)))))

;;; wttrin--resolve-location-query

(ert-deftest test-wttrin-saved-locations-normal-resolve-name-to-query ()
  "Normal: a saved name resolves to its query."
  (let ((wttrin-saved-locations '(("Craig's House" . "1500 Sugar Bowl Dr, New Orleans"))))
    (should (equal "1500 Sugar Bowl Dr, New Orleans"
                   (wttrin--resolve-location-query "Craig's House")))))

(ert-deftest test-wttrin-saved-locations-boundary-resolve-passthrough ()
  "Boundary: a non-saved selection passes through unchanged."
  (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))))
    (should (equal "Tokyo, JP" (wttrin--resolve-location-query "Tokyo, JP")))))

;;; Candidate de-duplication and precedence

(ert-deftest test-wttrin-saved-locations-normal-candidates-precedence ()
  "Normal: candidates are saved, favorite, defaults, then history, deduped."
  (testutil-wttrin-setup)
  (unwind-protect
      (let ((wttrin-geolocation-enabled nil)
            (wttrin-saved-locations '(("Home" . "Paris, FR")))
            (wttrin-favorite-location "Reykjavik")
            (wttrin-default-locations '("Honolulu, HI"))
            (wttrin--location-history '("Tokyo")))
        (should (equal '("Home" "Reykjavik" "Honolulu, HI" "Tokyo")
                       (wttrin--completion-candidates))))
    (testutil-wttrin-teardown)))

(ert-deftest test-wttrin-saved-locations-boundary-candidates-dedup-saved-wins ()
  "Boundary: a name present in saved and defaults appears once (saved first)."
  (testutil-wttrin-setup)
  (unwind-protect
      (let ((wttrin-geolocation-enabled nil)
            (wttrin-saved-locations '(("Honolulu, HI" . "Honolulu, HI")))
            (wttrin-favorite-location nil)
            (wttrin-default-locations '("Honolulu, HI" "Berkeley, CA"))
            (wttrin--location-history nil))
        (should (equal '("Honolulu, HI" "Berkeley, CA")
                       (wttrin--completion-candidates))))
    (testutil-wttrin-teardown)))

;;; Favorite-as-name resolution

(ert-deftest test-wttrin-saved-locations-normal-favorite-name-resolves-to-query ()
  "Normal: a favorite that is a saved name resolves to its query for fetching."
  (let ((wttrin-saved-locations '(("Home" . "1500 Sugar Bowl Dr, New Orleans")))
        (wttrin-favorite-location "Home"))
    (should (equal "1500 Sugar Bowl Dr, New Orleans"
                   (wttrin--resolve-favorite-location)))))

(ert-deftest test-wttrin-saved-locations-normal-favorite-display-shows-name ()
  "Normal: the favorite display name is the saved name, not its query."
  (let ((wttrin-saved-locations '(("Home" . "1500 Sugar Bowl Dr, New Orleans")))
        (wttrin-favorite-location "Home"))
    (should (equal "Home" (wttrin--favorite-location-display-name)))))

;;; Alias cache identity

(ert-deftest test-wttrin-saved-locations-normal-cache-keyed-on-query ()
  "Normal: cache identity follows the query, not the display name.
Two names with the same query share a key; the name never leaks into the key."
  (let ((wttrin-saved-locations '(("A" . "Paris, FR") ("B" . "Paris, FR"))))
    (should (equal (wttrin--make-cache-key (wttrin--resolve-location-query "A"))
                   (wttrin--make-cache-key (wttrin--resolve-location-query "B"))))))

;;; History suppression of saved names

(ert-deftest test-wttrin-saved-locations-boundary-saved-name-not-logged ()
  "Boundary: a saved-directory name is not added to history."
  (testutil-wttrin-setup)
  (unwind-protect
      (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))
            (wttrin-default-locations '())
            (wttrin--location-history nil))
        (wttrin--add-to-location-history "Home")
        (should (null wttrin--location-history)))
    (testutil-wttrin-teardown)))

;;; savehist

(ert-deftest test-wttrin-saved-locations-integration-savehist-registers ()
  "Integration: wttrin-saved-locations is registered for savehist persistence."
  (require 'savehist)
  (let ((savehist-additional-variables '(kill-ring)))
    (wttrin--savehist-register)
    (should (memq 'wttrin-saved-locations savehist-additional-variables))))

;;; wttrin--coordinates-p

(ert-deftest test-wttrin-saved-locations-normal-coordinates-p ()
  "Normal/Boundary: coordinate strings match; place names do not."
  (should (wttrin--coordinates-p "41.37,-71.83"))
  (should (wttrin--coordinates-p "1.5,2.5"))
  (should-not (wttrin--coordinates-p "New York, NY"))
  (should-not (wttrin--coordinates-p "Berkeley, CA"))
  (should-not (wttrin--coordinates-p "")))

;;; wttrin--put-saved-location

(ert-deftest test-wttrin-saved-locations-normal-put-adds-and-updates ()
  "Normal: put adds a new entry and updates an existing name without duplicating."
  (let ((wttrin-saved-locations nil))
    (wttrin--put-saved-location "Home" "Paris, FR")
    (should (equal "Paris, FR" (wttrin--resolve-location-query "Home")))
    (wttrin--put-saved-location "Home" "Tokyo, JP")
    (should (equal "Tokyo, JP" (wttrin--resolve-location-query "Home")))
    (should (= 1 (length (wttrin--saved-locations))))))

(ert-deftest test-wttrin-saved-locations-error-put-rejects-empty-and-sentinel ()
  "Error: put refuses an empty name, empty query, or the sentinel name."
  (let ((wttrin-saved-locations nil))
    (should-error (wttrin--put-saved-location "" "Paris") :type 'user-error)
    (should-error (wttrin--put-saved-location "Home" "") :type 'user-error)
    (should-error (wttrin--put-saved-location wttrin--geolocation-sentinel "x")
                  :type 'user-error)))

;;; wttrin-rename-location

(ert-deftest test-wttrin-saved-locations-normal-rename ()
  "Normal: rename moves the entry and updates the favorite reference."
  (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))
        (wttrin-favorite-location "Home"))
    (cl-letf (((symbol-function 'message) (lambda (&rest _) nil)))
      (wttrin-rename-location "Home" "Casa"))
    (should (equal "Paris, FR" (wttrin--resolve-location-query "Casa")))
    (should-not (assoc "Home" (wttrin--saved-locations)))
    (should (equal "Casa" wttrin-favorite-location))))

(ert-deftest test-wttrin-saved-locations-error-rename-collision-refused ()
  "Error: renaming onto an existing name is refused and changes nothing."
  (let ((wttrin-saved-locations '(("Home" . "Paris, FR") ("Work" . "Tokyo, JP"))))
    (should-error (wttrin-rename-location "Home" "Work") :type 'user-error)
    (should (equal "Paris, FR" (wttrin--resolve-location-query "Home")))))

(ert-deftest test-wttrin-saved-locations-normal-rename-favorite-refreshes-mode-line ()
  "Normal: renaming the favorite refreshes the mode-line so the icon and tooltip
follow the new name immediately instead of at the next scheduled fetch."
  (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))
        (wttrin-favorite-location "Home")
        (wttrin--location-history nil)
        (wttrin-mode-line-mode t)
        (fetched nil))
    (cl-letf (((symbol-function 'wttrin--mode-line-fetch-weather)
               (lambda () (setq fetched t)))
              ((symbol-function 'wttrin--mode-line-set-placeholder)
               (lambda () nil))
              ((symbol-function 'message) (lambda (&rest _) nil)))
      (wttrin-rename-location "Home" "Casa"))
    (should (equal "Casa" wttrin-favorite-location))
    (should fetched)))

(ert-deftest test-wttrin-saved-locations-boundary-rename-non-favorite-no-refresh ()
  "Boundary: renaming a location that is not the favorite does not refresh."
  (let ((wttrin-saved-locations '(("Home" . "Paris, FR") ("Work" . "Tokyo, JP")))
        (wttrin-favorite-location "Work")
        (wttrin--location-history nil)
        (wttrin-mode-line-mode t)
        (fetched nil))
    (cl-letf (((symbol-function 'wttrin--mode-line-fetch-weather)
               (lambda () (setq fetched t)))
              ((symbol-function 'wttrin--mode-line-set-placeholder)
               (lambda () nil))
              ((symbol-function 'message) (lambda (&rest _) nil)))
      (wttrin-rename-location "Home" "Casa"))
    (should-not fetched)))

;;; wttrin-remove-location

(ert-deftest test-wttrin-saved-locations-normal-remove-confirmed ()
  "Normal: confirming removes the entry."
  (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))))
    (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
              ((symbol-function 'message) (lambda (&rest _) nil)))
      (wttrin-remove-location "Home"))
    (should (null (wttrin--saved-locations)))))

(ert-deftest test-wttrin-saved-locations-boundary-remove-declined-keeps ()
  "Boundary: declining the confirmation keeps the entry."
  (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))))
    (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil))
              ((symbol-function 'message) (lambda (&rest _) nil)))
      (wttrin-remove-location "Home"))
    (should (assoc "Home" (wttrin--saved-locations)))))

(ert-deftest test-wttrin-saved-locations-normal-remove-favorite-refreshes-mode-line ()
  "Normal: removing the favorite refreshes the mode-line so it stops showing the
now-deleted alias's resolved weather and re-fetches against the bare query."
  (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))
        (wttrin-favorite-location "Home")
        (wttrin-mode-line-mode t)
        (fetched nil))
    (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
              ((symbol-function 'wttrin--mode-line-fetch-weather)
               (lambda () (setq fetched t)))
              ((symbol-function 'wttrin--mode-line-set-placeholder)
               (lambda () nil))
              ((symbol-function 'message) (lambda (&rest _) nil)))
      (wttrin-remove-location "Home"))
    (should fetched)))

(ert-deftest test-wttrin-saved-locations-boundary-remove-non-favorite-no-refresh ()
  "Boundary: removing a location that is not the favorite does not refresh."
  (let ((wttrin-saved-locations '(("Home" . "Paris, FR") ("Work" . "Tokyo, JP")))
        (wttrin-favorite-location "Work")
        (wttrin-mode-line-mode t)
        (fetched nil))
    (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
              ((symbol-function 'wttrin--mode-line-fetch-weather)
               (lambda () (setq fetched t)))
              ((symbol-function 'wttrin--mode-line-set-placeholder)
               (lambda () nil))
              ((symbol-function 'message) (lambda (&rest _) nil)))
      (wttrin-remove-location "Home"))
    (should-not fetched)))

;;; wttrin-make-default — geolocation naming

(ert-deftest test-wttrin-saved-locations-normal-d-names-and-promotes ()
  "Normal: d on a coordinate buffer names it, saves it, and promotes the name."
  (let ((wttrin-saved-locations nil)
        (wttrin-favorite-location nil)
        (wttrin-mode-line-mode nil))
    (with-temp-buffer
      (setq-local wttrin--current-location "41.37,-71.83")
      (setq-local wttrin--current-display "41.37,-71.83")
      (setq-local wttrin--current-address "Westerly, RI")
      (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "Home"))
                ((symbol-function 'message) (lambda (&rest _) nil)))
        (wttrin-make-default)))
    (should (equal "41.37,-71.83" (wttrin--resolve-location-query "Home")))
    (should (equal "Home" wttrin-favorite-location))))

(ert-deftest test-wttrin-saved-locations-boundary-d-empty-keeps-coordinates ()
  "Boundary: an empty name at the d prompt keeps the coordinates, saves no entry."
  (let ((wttrin-saved-locations nil)
        (wttrin-favorite-location nil)
        (wttrin-mode-line-mode nil))
    (with-temp-buffer
      (setq-local wttrin--current-location "41.37,-71.83")
      (setq-local wttrin--current-address "Westerly, RI")
      (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))
                ((symbol-function 'message) (lambda (&rest _) nil)))
        (wttrin-make-default)))
    (should (null (wttrin--saved-locations)))
    (should (equal "41.37,-71.83" wttrin-favorite-location))))

(ert-deftest test-wttrin-saved-locations-boundary-d-named-buffer-no-prompt ()
  "Boundary: d on a named buffer promotes the display name without prompting."
  (let ((wttrin-saved-locations nil)
        (wttrin-favorite-location nil)
        (wttrin-mode-line-mode nil)
        (prompted nil))
    (with-temp-buffer
      (setq-local wttrin--current-location "1500 Sugar Bowl Dr")
      (setq-local wttrin--current-display "Craig's House")
      (cl-letf (((symbol-function 'read-string)
                 (lambda (&rest _) (setq prompted t) "x"))
                ((symbol-function 'message) (lambda (&rest _) nil)))
        (wttrin-make-default)))
    (should-not prompted)
    (should (equal "Craig's House" wttrin-favorite-location))
    (should (equal "1500 Sugar Bowl Dr"
                   (wttrin--resolve-location-query "Craig's House")))))

(ert-deftest test-wttrin-saved-locations-normal-d-typed-saves-to-directory ()
  "Normal: making a typed location the default also saves it to the directory,
so it persists as a named entry rather than only as the favorite string."
  (let ((wttrin-saved-locations nil)
        (wttrin-favorite-location nil)
        (wttrin-mode-line-mode nil))
    (with-temp-buffer
      (setq-local wttrin--current-location "Reykjavik")
      (setq-local wttrin--current-display "Reykjavik")
      (cl-letf (((symbol-function 'message) (lambda (&rest _) nil)))
        (wttrin-make-default)))
    (should (equal "Reykjavik" wttrin-favorite-location))
    (should (assoc "Reykjavik" (wttrin--saved-locations)))
    (should (equal "Reykjavik" (wttrin--resolve-location-query "Reykjavik")))))

;;; interactive entry smoke tests (cover the prompt forms)

(ert-deftest test-wttrin-saved-locations-normal-save-location-interactive ()
  "Normal: the interactive save command reads the buffer query and a name."
  (let ((wttrin-saved-locations nil))
    (with-temp-buffer
      (setq-local wttrin--current-location "Paris, FR")
      (setq-local wttrin--current-display "Paris, FR")
      (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "Home"))
                ((symbol-function 'message) (lambda (&rest _) nil)))
        (call-interactively 'wttrin-save-location)))
    (should (equal "Paris, FR" (wttrin--resolve-location-query "Home")))))

(ert-deftest test-wttrin-saved-locations-normal-rename-interactive ()
  "Normal: the interactive rename command prompts for the entry and new name."
  (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))))
    (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "Home"))
              ((symbol-function 'read-string) (lambda (&rest _) "Casa"))
              ((symbol-function 'message) (lambda (&rest _) nil)))
      (call-interactively 'wttrin-rename-location))
    (should (equal "Paris, FR" (wttrin--resolve-location-query "Casa")))))

(ert-deftest test-wttrin-saved-locations-normal-remove-interactive ()
  "Normal: the interactive remove command prompts and confirms."
  (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))))
    (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "Home"))
              ((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
              ((symbol-function 'message) (lambda (&rest _) nil)))
      (call-interactively 'wttrin-remove-location))
    (should (null (wttrin--saved-locations)))))

(ert-deftest test-wttrin-saved-locations-boundary-save-empty-name-cancels ()
  "Boundary: an empty name at the save prompt cancels without saving."
  (let ((wttrin-saved-locations nil))
    (with-temp-buffer
      (setq-local wttrin--current-location "Paris, FR")
      (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "  "))
                ((symbol-function 'message) (lambda (&rest _) nil)))
        (call-interactively 'wttrin-save-location)))
    (should (null (wttrin--saved-locations)))))

;;; coordinate suppression in history

(ert-deftest test-wttrin-saved-locations-boundary-coordinates-not-logged ()
  "Boundary: a raw coordinate string is never added to history."
  (testutil-wttrin-setup)
  (unwind-protect
      (let ((wttrin-default-locations '())
            (wttrin-saved-locations nil)
            (wttrin--location-history nil))
        (wttrin--add-to-location-history "41.37,-71.83")
        (should (null wttrin--location-history)))
    (testutil-wttrin-teardown)))

;;; history stays in sync with the directory

(ert-deftest test-wttrin-saved-locations-normal-save-drops-query-from-history ()
  "Normal: saving a location drops its query from history, so the place lives in
the directory only and does not also appear as a separate history candidate."
  (let ((wttrin-saved-locations nil)
        (wttrin--location-history '("New Orleans" "Paris")))
    (cl-letf (((symbol-function 'message) (lambda (&rest _) nil)))
      (wttrin-save-location "Home" "New Orleans"))
    (should-not (member "New Orleans" wttrin--location-history))
    (should (member "Paris" wttrin--location-history))))

(ert-deftest test-wttrin-saved-locations-normal-d-alias-drops-query-from-history ()
  "Normal: making an aliased location the default drops its underlying query from
history, so the place does not also linger as a separate history candidate."
  (let ((wttrin-saved-locations nil)
        (wttrin-favorite-location nil)
        (wttrin-mode-line-mode nil)
        (wttrin--location-history '("New Orleans" "Paris")))
    (with-temp-buffer
      (setq-local wttrin--current-location "New Orleans")
      (setq-local wttrin--current-display "Home")
      (cl-letf (((symbol-function 'message) (lambda (&rest _) nil)))
        (wttrin-make-default)))
    (should (equal "Home" wttrin-favorite-location))
    (should (assoc "Home" (wttrin--saved-locations)))
    (should-not (member "New Orleans" wttrin--location-history))
    (should (member "Paris" wttrin--location-history))))

(ert-deftest test-wttrin-saved-locations-normal-remove-forgets-history ()
  "Normal: removing a saved location drops both its name and its query from
history, so a removed place does not resurface as a history candidate."
  (let ((wttrin-saved-locations '(("Home" . "New Orleans")))
        (wttrin--location-history '("Home" "New Orleans" "Paris")))
    (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
              ((symbol-function 'message) (lambda (&rest _) nil)))
      (wttrin-remove-location "Home"))
    (should-not (member "Home" wttrin--location-history))
    (should-not (member "New Orleans" wttrin--location-history))
    (should (member "Paris" wttrin--location-history))))

(provide 'test-wttrin-saved-locations)
;;; test-wttrin-saved-locations.el ends here