diff options
| -rw-r--r-- | tests/test-wttrin-error-types.el | 128 | ||||
| -rw-r--r-- | tests/test-wttrin-geolocation--internals.el | 6 | ||||
| -rw-r--r-- | wttrin-geolocation.el | 8 | ||||
| -rw-r--r-- | wttrin.el | 60 |
4 files changed, 191 insertions, 11 deletions
diff --git a/tests/test-wttrin-error-types.el b/tests/test-wttrin-error-types.el new file mode 100644 index 0000000..dd3df2d --- /dev/null +++ b/tests/test-wttrin-error-types.el @@ -0,0 +1,128 @@ +;;; test-wttrin-error-types.el --- Tests for wttrin's typed error hierarchy -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the define-error hierarchy (wttrin-error and children), +;; the wttrin--error-message constructor, the wttrin-error-type accessor, +;; and the error-class tagging of the async fetch callback's error-msg. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) +(require 'testutil-wttrin) + +;;; Setup and Teardown + +(defun test-wttrin-error-types-setup () + "Setup for error-type tests." + (testutil-wttrin-setup)) + +(defun test-wttrin-error-types-teardown () + "Teardown for error-type tests." + (testutil-wttrin-teardown)) + +;;; Hierarchy + +(ert-deftest test-wttrin-error-types-normal-parent-inherits-error () + "wttrin-error is a child of the built-in error condition." + (should (memq 'error (get 'wttrin-error 'error-conditions))) + (should (memq 'wttrin-error (get 'wttrin-error 'error-conditions)))) + +(ert-deftest test-wttrin-error-types-normal-children-inherit-parent-and-error () + "Each child condition inherits both wttrin-error and error." + (dolist (child '(wttrin-invalid-input + wttrin-network-error + wttrin-not-found-error + wttrin-service-error + wttrin-parse-error)) + (let ((conds (get child 'error-conditions))) + (should (memq child conds)) + (should (memq 'wttrin-error conds)) + (should (memq 'error conds))))) + +;;; wttrin--error-message constructor + +(ert-deftest test-wttrin-error-types-normal-error-message-carries-type-property () + "wttrin--error-message returns the formatted string tagged with its type." + (let ((msg (wttrin--error-message 'wttrin-network-error "Network error"))) + (should (string= "Network error" msg)) + (should (eq 'wttrin-network-error (get-text-property 0 'wttrin-error-type msg))))) + +(ert-deftest test-wttrin-error-types-normal-error-message-formats-arguments () + "wttrin--error-message applies format arguments like `format'." + (let ((msg (wttrin--error-message 'wttrin-not-found-error + "Location not found (HTTP %d)" 404))) + (should (string= "Location not found (HTTP 404)" msg)) + (should (eq 'wttrin-not-found-error (wttrin-error-message-type msg))))) + +;;; wttrin-error-type accessor + +(ert-deftest test-wttrin-error-types-normal-error-type-reads-tag () + "wttrin-error-type returns the class symbol from a tagged message." + (let ((msg (wttrin--error-message 'wttrin-service-error "boom"))) + (should (eq 'wttrin-service-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-boundary-error-type-plain-string-is-nil () + "An untagged string has no error type." + (should (null (wttrin-error-message-type "just a string")))) + +(ert-deftest test-wttrin-error-types-boundary-error-type-nil-is-nil () + "nil has no error type." + (should (null (wttrin-error-message-type nil)))) + +(ert-deftest test-wttrin-error-types-boundary-error-type-empty-string-is-nil () + "An empty string has no error type." + (should (null (wttrin-error-message-type "")))) + +;;; Synchronous signal site + +(ert-deftest test-wttrin-error-types-error-build-url-nil-signals-invalid-input () + "A nil query signals the specific wttrin-invalid-input condition." + (should-error (wttrin--build-url nil) :type 'wttrin-invalid-input) + (should-error (wttrin--build-url nil) :type 'wttrin-error)) + +;;; Async classification — error-msg handed to the callback carries the class + +(defun test-wttrin-error-types--capture-error-msg (status &optional status-code) + "Run the fetch callback with STATUS, return the error-msg it receives. +STATUS-CODE, when non-nil, is the HTTP status the buffer reports." + (let ((captured 'unset)) + (cl-letf (((symbol-function 'wttrin--extract-response-body) (lambda () nil)) + ((symbol-function 'wttrin--extract-http-status) (lambda () status-code)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin--handle-fetch-callback + status + (lambda (_data &optional error-msg) (setq captured error-msg)))) + captured)) + +(ert-deftest test-wttrin-error-types-error-network-failure-tagged-network () + "A network-level failure tags the error-msg as wttrin-network-error." + (let ((msg (test-wttrin-error-types--capture-error-msg + '(:error (error "Network unreachable"))))) + (should (eq 'wttrin-network-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-http-404-tagged-not-found () + "An HTTP 4xx tags the error-msg as wttrin-not-found-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil 404))) + (should (eq 'wttrin-not-found-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-http-500-tagged-service () + "An HTTP 5xx tags the error-msg as wttrin-service-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil 500))) + (should (eq 'wttrin-service-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-2xx-empty-body-tagged-parse () + "A 2xx response with no usable body tags the error-msg as wttrin-parse-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil 200))) + (should (eq 'wttrin-parse-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-missing-status-tagged-parse () + "An unreadable response (no status, no body) tags the error-msg as wttrin-parse-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil nil))) + (should (eq 'wttrin-parse-error (wttrin-error-message-type msg))))) + +(provide 'test-wttrin-error-types) +;;; test-wttrin-error-types.el ends here diff --git a/tests/test-wttrin-geolocation--internals.el b/tests/test-wttrin-geolocation--internals.el index 6ad8384..dfc483d 100644 --- a/tests/test-wttrin-geolocation--internals.el +++ b/tests/test-wttrin-geolocation--internals.el @@ -128,9 +128,11 @@ ;;; Error Cases (ert-deftest test-wttrin-geolocation--lookup-provider-error-unknown-symbol () - "Unknown provider symbol signals error." + "Unknown provider symbol signals the typed wttrin-invalid-input condition." (should-error (wttrin-geolocation--lookup-provider 'definitely-not-registered) - :type 'error)) + :type 'wttrin-invalid-input) + (should-error (wttrin-geolocation--lookup-provider 'definitely-not-registered) + :type 'wttrin-error)) ;;; -------------------------------------------------------------------------- ;;; wttrin-geolocation--extract-body diff --git a/wttrin-geolocation.el b/wttrin-geolocation.el index 03b573a..a2c31aa 100644 --- a/wttrin-geolocation.el +++ b/wttrin-geolocation.el @@ -46,6 +46,11 @@ (require 'json) (require 'url) +;; For the shared error hierarchy (`wttrin-invalid-input' et al.). This is a +;; sub-module of wttrin and is only ever loaded through it, so the require is a +;; no-op in practice; it makes the dependency explicit and keeps the condition +;; symbols defined even if this file is loaded on its own. +(require 'wttrin) (defgroup wttrin-geolocation nil "IP geolocation settings for wttrin." @@ -142,7 +147,8 @@ by pushing onto this list; the keys become valid values for "Return the provider plist for SYMBOL. Signal an error if SYMBOL is not registered." (or (cdr (assq symbol wttrin-geolocation--providers)) - (error "Unknown wttrin-geolocation provider: %S" symbol))) + (signal 'wttrin-invalid-input + (list (format "Unknown wttrin-geolocation provider: %S" symbol))))) ;;; Fetch and Detect @@ -349,10 +349,43 @@ Returns \"just now\" for <60s, \"X minutes ago\", \"X hours ago\", or \"X days a (concat "?" wttrin-unit-system) "?")) +;;; Error Types + +;; A small condition hierarchy so callers can branch on the *class* of a +;; failure instead of matching message text. `wttrin-error' is the parent. +;; Synchronous code paths signal these directly; the async fetch path tags its +;; human-readable error string with the class via the `wttrin-error-type' text +;; property (see `wttrin--error-message'), so two-arg callbacks keep working +;; while callers that care can read the class. + +(define-error 'wttrin-error "wttrin error") +(define-error 'wttrin-invalid-input "Invalid input" 'wttrin-error) +(define-error 'wttrin-network-error "Network error" 'wttrin-error) +(define-error 'wttrin-not-found-error "Location not found" 'wttrin-error) +(define-error 'wttrin-service-error "Weather service error" 'wttrin-error) +(define-error 'wttrin-parse-error "Could not parse weather response" 'wttrin-error) + +(defun wttrin--error-message (type format-string &rest args) + "Format an error message of class TYPE. +Return the string built from FORMAT-STRING and ARGS with TYPE stored in its +`wttrin-error-type' text property. This lets the async fetch path hand a +plain string to callbacks while still carrying the error class; read it back +with `wttrin-error-message-type'." + (propertize (apply #'format format-string args) 'wttrin-error-type type)) + +(defun wttrin-error-message-type (error-msg) + "Return the error-class symbol carried by ERROR-MSG, or nil. +ERROR-MSG is a string produced by wttrin's async fetch path; its class is +stored in the `wttrin-error-type' text property. A plain, empty, or nil +ERROR-MSG has no class." + (and (stringp error-msg) + (> (length error-msg) 0) + (get-text-property 0 'wttrin-error-type error-msg))) + (defun wttrin--build-url (query) "Build wttr.in URL for QUERY with configured parameters." (when (null query) - (error "Query cannot be nil")) + (signal 'wttrin-invalid-input '("Query cannot be nil"))) (concat "https://wttr.in/" (url-hexify-string query) (wttrin-additional-url-params) @@ -407,22 +440,33 @@ description of what went wrong, or nil on success." ((plist-get status :error) (wttrin--debug-log "wttrin--handle-fetch-callback: Network error - %s" (cdr (plist-get status :error))) - (setq error-msg "Network error — check your connection") + (setq error-msg (wttrin--error-message + 'wttrin-network-error + "Network error — check your connection")) (message "wttrin: %s" error-msg)) ;; HTTP response received — extract body (returns nil for non-2xx) (t (let ((http-status (wttrin--extract-http-status))) (setq data (wttrin--extract-response-body)) - (when (and (not data) http-status) + (when (not data) (setq error-msg (cond + ((null http-status) + (wttrin--error-message + 'wttrin-parse-error "Could not read weather response")) ((and (>= http-status 400) (< http-status 500)) - (format "Location not found (HTTP %d)" http-status)) + (wttrin--error-message + 'wttrin-not-found-error "Location not found (HTTP %d)" http-status)) ((>= http-status 500) - (format "Weather service error (HTTP %d)" http-status)) - (t (format "Unexpected HTTP status %d" http-status)))) - (when error-msg - (message "wttrin: %s" error-msg)))))) + (wttrin--error-message + 'wttrin-service-error "Weather service error (HTTP %d)" http-status)) + ((< http-status 300) + (wttrin--error-message + 'wttrin-parse-error "Could not parse weather response (HTTP %d)" http-status)) + (t + (wttrin--error-message + 'wttrin-error "Unexpected HTTP status %d" http-status)))) + (message "wttrin: %s" error-msg))))) (condition-case err (progn (wttrin--debug-log "wttrin--handle-fetch-callback: Calling user callback with %s" |