diff options
| author | Craig Jennings <c@cjennings.net> | 2026-07-31 09:39:11 -0500 |
|---|---|---|
| committer | Craig Jennings <c@cjennings.net> | 2026-07-31 09:39:11 -0500 |
| commit | 55e980fe28112e636a6d3165979f161d1a6038ab (patch) | |
| tree | dc0e656b9c2b15dcaf1b8ab540f82a9829fb5be0 /tests | |
| parent | 00f44f46f65a96bb84271faa7f4ed7965fc44d5e (diff) | |
| download | dotemacs-55e980fe28112e636a6d3165979f161d1a6038ab.tar.gz dotemacs-55e980fe28112e636a6d3165979f161d1a6038ab.zip | |
feat(agenda): query the agenda window as JSON for external renderers
I need the agenda drawable from outside Emacs, on a 24-hour axis that
refreshes every few minutes.
- cj/agenda-window-json returns every entry intersecting an epoch-second
window.
- Epoch seconds keep timezone out of the interface. The consumer converts
per city, so DST weeks stop being a special case.
- Repeating entries expand to one row per occurrence through org's own
arithmetic, so they land where my agenda shows them.
- Given an out-path it writes atomically. A reader on a timer never sees a
half-written file.
- It skips archived and commented subtrees, as the agenda does.
The trap: SCHEDULED and DEADLINE are properties on the planning element,
not children in the parse tree. Mapping over 'timestamp returns neither,
and does it silently. An agenda is mostly made of those two. The tests pin
it with a fixture carrying no body timestamp.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-agenda-query--bounds.el | 169 | ||||
| -rw-r--r-- | tests/test-agenda-query--occurrences.el | 242 | ||||
| -rw-r--r-- | tests/test-agenda-query.el | 381 |
3 files changed, 792 insertions, 0 deletions
diff --git a/tests/test-agenda-query--bounds.el b/tests/test-agenda-query--bounds.el new file mode 100644 index 00000000..9ee423e7 --- /dev/null +++ b/tests/test-agenda-query--bounds.el @@ -0,0 +1,169 @@ +;;; test-agenda-query--bounds.el --- Tests for timestamp bounds -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/--agenda-query-timestamp-bounds', which turns an org-element +;; timestamp into epoch bounds for the JSON query. +;; +;; The contract under test: +;; - :start is the epoch of the timestamp's start. +;; - :end is the epoch of an explicit range end, or nil when the source has no +;; range. A null end is information the consumer cannot re-derive, so it is +;; never filled in with a guess. +;; - :all-day is t when the timestamp carries no hour. +;; - :effective-end is what the window predicate uses: the explicit end, or for +;; an all-day entry the end of its last day, or for a timed point event the +;; start itself. This is the "treat the day as its extent" rule, kept out of +;; :end so the reported shape stays faithful to the source. +;; +;; Helpers carry a file-unique prefix on purpose: the editor hook loads every +;; agenda-query test file into ONE process, so a shared helper name here would +;; silently redefine its namesake in a sibling file. + +;;; Code: + +(require 'ert) +(require 'org) +(require 'org-element) +(require 'org-agenda) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'agenda-query) + +(defun test-aq-bounds--epoch (sec min hour day month year) + "Return the epoch second for the local time SEC MIN HOUR DAY MONTH YEAR." + (time-convert (encode-time (list sec min hour day month year nil -1 nil)) + 'integer)) + +(defun test-aq-bounds--of (raw) + "Parse timestamp string RAW and return its bounds plist." + (cj/--agenda-query-timestamp-bounds (org-timestamp-from-string raw))) + +;;; Normal Cases + +(ert-deftest test-agenda-query-bounds-normal-timed-range () + "Normal: a same-day timed range reports both ends and is not all-day." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 23:00-23:30>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 23 31 7 2026))) + (should (equal (plist-get b :end) + (test-aq-bounds--epoch 0 30 23 31 7 2026))) + (should-not (plist-get b :all-day)) + (should (equal (plist-get b :effective-end) (plist-get b :end))))) + +(ert-deftest test-agenda-query-bounds-normal-timed-point () + "Normal: a timed point event has no end, and its extent is the instant." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 14:00>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 14 31 7 2026))) + (should-not (plist-get b :end)) + (should-not (plist-get b :all-day)) + (should (equal (plist-get b :effective-end) (plist-get b :start))))) + +;;; Boundary Cases + +(ert-deftest test-agenda-query-bounds-boundary-all-day-extent () + "Boundary: an all-day entry reports no end but extends over its whole day." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 31 7 2026))) + (should-not (plist-get b :end)) + (should (plist-get b :all-day)) + ;; One second short of the next midnight -- the day is the extent. + (should (equal (plist-get b :effective-end) + (1- (test-aq-bounds--epoch 0 0 0 1 8 2026)))))) + +(ert-deftest test-agenda-query-bounds-boundary-multi-day-all-day () + "Boundary: a multi-day all-day range ends at the close of its last day." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri>--<2026-08-02 Sun>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 31 7 2026))) + (should (plist-get b :all-day)) + (should (equal (plist-get b :end) + (1- (test-aq-bounds--epoch 0 0 0 3 8 2026)))) + (should (equal (plist-get b :effective-end) (plist-get b :end))))) + +(ert-deftest test-agenda-query-bounds-boundary-midnight-start () + "Boundary: an explicit 00:00 is a timed event, not an all-day one." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 00:00>"))) + (should-not (plist-get b :all-day)) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 31 7 2026))))) + +(ert-deftest test-agenda-query-bounds-boundary-dst-spring-forward () + "Boundary: a timestamp on a DST changeover day still resolves to one epoch. +US DST began 2026-03-08. The interface is epoch seconds precisely so the +consumer never has to know the source timestamps are naive local time." + (let ((b (test-aq-bounds--of "<2026-03-08 Sun 13:00>"))) + (should (integerp (plist-get b :start))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 13 8 3 2026))))) + +(ert-deftest test-agenda-query-bounds-boundary-dst-day-is-23-hours () + "Boundary: the day-extent rule follows real clock time, not a fixed 86400. +2026-03-08 loses an hour, so its all-day extent is one second short of 23 +hours. Adding a constant day would overshoot into the next day." + (let ((b (test-aq-bounds--of "<2026-03-08 Sun>"))) + (should (equal (plist-get b :effective-end) + (1- (test-aq-bounds--epoch 0 0 0 9 3 2026)))) + (should (= (- (plist-get b :effective-end) (plist-get b :start)) + (1- (* 23 3600)))))) + +(ert-deftest test-agenda-query-bounds-boundary-same-day-range-crosses-midnight () + "Boundary: a range whose end precedes its start is read as crossing midnight. + +Org records <2026-07-31 Fri 23:00-01:00> with day-end EQUAL to day-start, so +reading it literally puts the end 22 hours before the start. A negative +duration is meaningless to a renderer, and the row would also vanish from the +very window it belongs to, since its effective end would sit before the +window opens." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 23:00-01:00>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 23 31 7 2026))) + (should (equal (plist-get b :end) + (test-aq-bounds--epoch 0 0 1 1 8 2026))) + (should (> (plist-get b :end) (plist-get b :start))) + (should (= (- (plist-get b :end) (plist-get b :start)) (* 2 3600))))) + +(ert-deftest test-agenda-query-bounds-boundary-reversed-multi-day-range () + "Boundary: a genuinely reversed multi-day range reports no end at all. + +The midnight roll is scoped to same-day ranges, which is the shape org uses +for <23:00-01:00>. Rolling a reversed multi-day range would shift a wrong +date by one day and leave it still wrong, so instead the entry is reported as +a point -- a consumer can draw that, where a negative-duration bar is +meaningless." + (let ((b (test-aq-bounds--of "<2026-08-02 Sun 09:00>--<2026-07-31 Fri 08:00>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 9 2 8 2026))) + (should-not (plist-get b :end)) + (should (equal (plist-get b :effective-end) (plist-get b :start))))) + +(ert-deftest test-agenda-query-bounds-boundary-reversed-all-day-range () + "Boundary: a reversed ALL-DAY range also reports no end. + +The same malformed shape as the timed case, and the same consequence if it +slips through: the negative extent would sit before the start, so the entry +would vanish from the very day it opens on. A typo or a bad ICS import +produces this." + (let ((b (test-aq-bounds--of "<2026-08-05 Wed>--<2026-08-01 Sat>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 5 8 2026))) + (should-not (plist-get b :end)) + ;; Falls back to its own day, so it still appears on 5 August. + (should (> (plist-get b :effective-end) (plist-get b :start))))) + +;;; Error Cases + +(ert-deftest test-agenda-query-bounds-error-inactive-still-computes () + "Error: bounds are purely arithmetic -- filtering inactive stamps is a +separate concern, so an inactive timestamp still yields usable bounds." + (let ((b (test-aq-bounds--of "[2026-07-31 Fri 09:00]"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 9 31 7 2026))))) + +(ert-deftest test-agenda-query-bounds-error-nil-timestamp () + "Error: a nil timestamp yields nil rather than signaling." + (should-not (cj/--agenda-query-timestamp-bounds nil))) + +(provide 'test-agenda-query--bounds) +;;; test-agenda-query--bounds.el ends here diff --git a/tests/test-agenda-query--occurrences.el b/tests/test-agenda-query--occurrences.el new file mode 100644 index 00000000..4fa73a0c --- /dev/null +++ b/tests/test-agenda-query--occurrences.el @@ -0,0 +1,242 @@ +;;; test-agenda-query--occurrences.el --- Tests for window + repeats -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/--agenda-query-occurrences' and the repeater cookie helper. +;; +;; Two behaviors under test: +;; +;; 1. The window predicate is intersection, not containment. An event running +;; across the window's start edge is in the window -- on a live surface it is +;; the thing currently happening. +;; +;; 2. A repeating entry contributes one row per occurrence inside the window, +;; expanded through org's own arithmetic. The base timestamp of a long-lived +;; repeater sits far in the past, so returning it raw would put a task that is +;; genuinely due today outside the window entirely. + +;;; Code: + +(require 'ert) +(require 'org) +(require 'org-element) +(require 'org-agenda) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'agenda-query) + +(defun test-agenda-query-occ--epoch (min hour day month year) + "Return the epoch for local MIN HOUR DAY MONTH YEAR." + (time-convert (encode-time (list 0 min hour day month year nil -1 nil)) + 'integer)) + +(defun test-agenda-query-occ--of (raw start end) + "Return occurrences of timestamp string RAW within START..END." + (cj/--agenda-query-occurrences (org-timestamp-from-string raw) start end)) + +(defun test-agenda-query-occ--starts (raw start end) + "Return just the start epochs of RAW's occurrences within START..END." + (mapcar #'car (test-agenda-query-occ--of raw start end))) + +;;; ---------- repeater cookie ---------- + +(ert-deftest test-agenda-query-cookie-normal-all-three-styles () + "Normal: each repeater style round-trips to its raw cookie." + (should (equal "+1d" (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed +1d>")))) + (should (equal "++2w" (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed ++2w>")))) + (should (equal ".+3m" (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed .+3m>"))))) + +(ert-deftest test-agenda-query-cookie-boundary-none () + "Boundary: a plain timestamp has no cookie, and nil is not a cookie." + (should-not (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed>"))) + (should-not (cj/--agenda-query-repeater-cookie nil))) + +;;; ---------- window predicate ---------- + +(ert-deftest test-agenda-query-occ-normal-inside-window () + "Normal: an event wholly inside the window is returned once, with its end." + (let* ((win-start (test-agenda-query-occ--epoch 0 8 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 18 31 7 2026)) + (occ (test-agenda-query-occ--of "<2026-07-31 Fri 09:00-10:00>" + win-start win-end))) + (should (= 1 (length occ))) + (should (equal (caar occ) (test-agenda-query-occ--epoch 0 9 31 7 2026))) + (should (equal (cdar occ) (test-agenda-query-occ--epoch 0 10 31 7 2026))))) + +(ert-deftest test-agenda-query-occ-boundary-overlaps-start-edge () + "Boundary: an event that began before the window but is still running is in. +This is the 23:00-01:00 case -- the whole reason the predicate is intersects +rather than starts-inside." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 1 8 2026)) + (win-end (test-agenda-query-occ--epoch 0 23 1 8 2026))) + (should (= 1 (length (test-agenda-query-occ--of + "<2026-07-31 Fri 23:00>--<2026-08-01 Sat 01:00>" + win-start win-end)))))) + +(ert-deftest test-agenda-query-occ-boundary-touches-edge-exactly () + "Boundary: an event ending exactly at the window start is still included." + (let* ((win-start (test-agenda-query-occ--epoch 0 10 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 18 31 7 2026))) + (should (= 1 (length (test-agenda-query-occ--of + "<2026-07-31 Fri 09:00-10:00>" win-start win-end)))))) + +(ert-deftest test-agenda-query-occ-boundary-all-day-covers-window () + "Boundary: an all-day entry covers any window inside its day." + (let* ((win-start (test-agenda-query-occ--epoch 0 13 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 30 13 31 7 2026)) + (occ (test-agenda-query-occ--of "<2026-07-31 Fri>" win-start win-end))) + (should (= 1 (length occ))) + ;; No range in the source, so no end is invented. + (should-not (cdar occ)))) + +(ert-deftest test-agenda-query-occ-boundary-outside-window () + "Boundary: an event finishing before the window opens is excluded." + (let* ((win-start (test-agenda-query-occ--epoch 0 12 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 18 31 7 2026))) + (should-not (test-agenda-query-occ--of "<2026-07-31 Fri 09:00-10:00>" + win-start win-end)))) + +;;; ---------- repeat expansion ---------- + +(ert-deftest test-agenda-query-occ-normal-daily-repeat-reaches-today () + "Normal: a daily repeater based a month back yields today's occurrence. +Returning the raw base date would put a task genuinely due today far outside +the window -- this is the failure the expansion exists to prevent." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (starts (test-agenda-query-occ--starts "<2026-07-01 Wed 09:00 +1d>" + win-start win-end))) + (should (equal starts (list (test-agenda-query-occ--epoch 0 9 31 7 2026)))))) + +(ert-deftest test-agenda-query-occ-normal-repeat-preserves-duration () + "Normal: an expanded occurrence keeps the base timestamp's duration." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (occ (car (test-agenda-query-occ--of "<2026-07-01 Wed 09:00-10:30 +1d>" + win-start win-end)))) + (should occ) + (should (equal (car occ) (test-agenda-query-occ--epoch 0 9 31 7 2026))) + (should (equal (cdr occ) (test-agenda-query-occ--epoch 30 10 31 7 2026))))) + +(ert-deftest test-agenda-query-occ-boundary-one-row-per-occurrence () + "Boundary: a window wider than the interval yields a row per occurrence. +A count is derivable from rows; rows are not derivable from a count, so the +row form is what the query returns." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 27 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (starts (test-agenda-query-occ--starts "<2026-07-01 Wed 09:00 +1d>" + win-start win-end))) + (should (= 5 (length starts))) + (should (equal starts + (list (test-agenda-query-occ--epoch 0 9 27 7 2026) + (test-agenda-query-occ--epoch 0 9 28 7 2026) + (test-agenda-query-occ--epoch 0 9 29 7 2026) + (test-agenda-query-occ--epoch 0 9 30 7 2026) + (test-agenda-query-occ--epoch 0 9 31 7 2026)))))) + +(ert-deftest test-agenda-query-occ-boundary-weekly-lands-on-its-day () + "Boundary: a weekly repeater yields only the days it actually falls on. +2026-07-01 is a Wednesday, so within Mon 27 -- Fri 31 July only Wed 29 counts." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 27 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (starts (test-agenda-query-occ--starts "<2026-07-01 Wed 09:00 +1w>" + win-start win-end))) + (should (equal starts (list (test-agenda-query-occ--epoch 0 9 29 7 2026)))))) + +(ert-deftest test-agenda-query-occ-boundary-restart-style-expands () + "Boundary: a .+ repeater expands from its base like any other style. + +Org rewrites a restart repeater's base timestamp when the task is completed, +so for an open task the base IS the last repeat and base-relative expansion is +what the agenda shows. All three styles agree here." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (expected (list (test-agenda-query-occ--epoch 0 9 31 7 2026)))) + (dolist (raw '("<2026-07-01 Wed 09:00 +1d>" + "<2026-07-01 Wed 09:00 ++1d>" + "<2026-07-01 Wed 09:00 .+1d>")) + (should (equal expected + (test-agenda-query-occ--starts raw win-start win-end)))))) + +(ert-deftest test-agenda-query-occ-boundary-repeat-not-yet-started () + "Boundary: a repeater whose base is after the window yields nothing." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026))) + (should-not (test-agenda-query-occ--starts "<2026-12-01 Tue 09:00 +1d>" + win-start win-end)))) + +(ert-deftest test-agenda-query-occ-boundary-zero-value-repeater () + "Boundary: org treats a zero-value repeater as void, so it behaves as a +plain timestamp -- absent when its base is outside the window, and present +exactly once when the base is inside it. + +Both halves are asserted deliberately. The absent half alone would also pass +against an implementation with no repeater support at all, which makes it no +evidence about zero-value handling." + (should-not (test-agenda-query-occ--starts + "<2026-07-01 Wed 09:00 +0d>" + (test-agenda-query-occ--epoch 0 0 31 7 2026) + (test-agenda-query-occ--epoch 59 23 31 7 2026))) + (should (equal (list (test-agenda-query-occ--epoch 0 9 1 7 2026)) + (test-agenda-query-occ--starts + "<2026-07-01 Wed 09:00 +0d>" + (test-agenda-query-occ--epoch 0 0 1 7 2026) + (test-agenda-query-occ--epoch 59 23 1 7 2026))))) + +(ert-deftest test-agenda-query-occ-boundary-repeat-in-progress-at-window-start () + "Boundary: a repeating event that began before the window and is still +running is returned. + +The non-repeating path honors intersects-not-contains; the repeating path has +to as well. Scanning only days inside the window misses this, because the +occurrence's own day starts earlier: a nightly 22:00-02:00 job is the thing +actually happening at 03:00, and a renderer that drops it shows an empty slot +during the event." + (let ((raw "<2026-07-01 Wed 22:00 +1d>--<2026-07-02 Thu 02:00>")) + (should (= 1 (length (test-agenda-query-occ--of + raw + (test-agenda-query-occ--epoch 0 0 31 7 2026) + (test-agenda-query-occ--epoch 0 6 31 7 2026))))) + ;; The same occurrence seen from inside its own evening. + (should (= 1 (length (test-agenda-query-occ--of + raw + (test-agenda-query-occ--epoch 0 21 31 7 2026) + (test-agenda-query-occ--epoch 0 23 31 7 2026))))))) + +(ert-deftest test-agenda-query-occ-boundary-repeat-extent-follows-dst () + "Boundary: an all-day repeat's extent is recomputed per occurrence day. + +US DST ends 2026-11-01, making that day 25 hours long. Carrying the base +day's length forward as a fixed number of seconds leaves the occurrence +ending an hour early, so a window late on that day sees nothing while the +identical non-repeating entry is found." + (let ((win-start (test-agenda-query-occ--epoch 30 23 1 11 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 1 11 2026))) + (should (= 1 (length (test-agenda-query-occ--of "<2026-07-01 Wed +1d>" + win-start win-end)))) + ;; The non-repeating control: same day, same window, must agree. + (should (= 1 (length (test-agenda-query-occ--of "<2026-11-01 Sun>" + win-start win-end)))))) + +;;; ---------- error cases ---------- + +(ert-deftest test-agenda-query-occ-error-inverted-window () + "Error: a window whose start is after its end matches nothing. +Without the guard the intersection test passes for any long-running event, +which would silently return rows for a nonsense request." + (let* ((win-start (test-agenda-query-occ--epoch 0 18 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 8 31 7 2026))) + (should-not (test-agenda-query-occ--of "<2026-07-31 Fri 09:00-10:00>" + win-start win-end)) + (should-not (test-agenda-query-occ--of "<2026-07-01 Wed 09:00 +1d>" + win-start win-end)))) + +(ert-deftest test-agenda-query-occ-error-nil-timestamp () + "Error: a nil timestamp yields no occurrences rather than signaling." + (should-not (cj/--agenda-query-occurrences nil 0 100))) + +(provide 'test-agenda-query--occurrences) +;;; test-agenda-query--occurrences.el ends here diff --git a/tests/test-agenda-query.el b/tests/test-agenda-query.el new file mode 100644 index 00000000..4b6b0dc1 --- /dev/null +++ b/tests/test-agenda-query.el @@ -0,0 +1,381 @@ +;;; test-agenda-query.el --- Tests for the agenda JSON query -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/--agenda-query-buffer-events', `cj/agenda-window-json' and the +;; atomic writer. +;; +;; The load-bearing test here is the SCHEDULED/DEADLINE one. Org stores +;; planning timestamps as properties on a `planning' element rather than as +;; children in the parse tree, so the obvious implementation -- mapping over +;; \='timestamp -- returns neither, silently. A fixture without a SCHEDULED +;; entry would pass against that broken implementation, so every fixture that +;; matters carries one. +;; +;; Helpers carry a file-unique prefix on purpose: the editor hook loads every +;; agenda-query test file into ONE process, so a shared helper name here would +;; silently redefine its namesake in a sibling file. + +;;; Code: + +(require 'ert) +(require 'org) +(require 'org-element) +(require 'org-agenda) +(require 'seq) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'agenda-query) + +(defun test-aq-json--epoch (min hour day month year) + "Return the epoch for local MIN HOUR DAY MONTH YEAR." + (time-convert (encode-time (list 0 min hour day month year nil -1 nil)) + 'integer)) + +(defun test-aq-json--day-window () + "Return the window covering all of 2026-07-31 as a cons." + (cons (test-aq-json--epoch 0 0 31 7 2026) + (test-aq-json--epoch 59 23 31 7 2026))) + +(defmacro test-aq-json--with-org (text &rest body) + "Parse TEXT in an org-mode buffer and run BODY with `events' bound. +`events' holds the rows the buffer contributes for all of 2026-07-31." + (declare (indent 1)) + `(with-temp-buffer + (insert ,text) + (org-mode) + (let* ((window (test-aq-json--day-window)) + (events (cj/--agenda-query-buffer-events + (current-buffer) "/tmp/fixture.org" + (car window) (cdr window)))) + ,@body))) + +(defun test-aq-json--field (event key) + "Return EVENT's KEY, a symbol." + (alist-get key event)) + +(defun test-aq-json--of-type (events type) + "Return the EVENTS whose type is TYPE." + (seq-filter (lambda (e) (equal type (test-aq-json--field e 'type))) events)) + +(defmacro test-aq-json--with-agenda-file (text &rest body) + "Write TEXT to a temp agenda file and run BODY with `file' and `window' bound. +Kills the visited buffer afterwards so the run leaves no state behind." + (declare (indent 1)) + `(let* ((dir (make-temp-file "agenda-query-" t)) + (file (expand-file-name "todo.org" dir)) + (window (test-aq-json--day-window))) + (unwind-protect + (progn + (with-temp-file file (insert ,text)) + (let ((org-agenda-files (list file))) + ,@body)) + (dolist (buffer (buffer-list)) + (when (equal (buffer-file-name buffer) file) (kill-buffer buffer))) + (delete-directory dir t)))) + +;;; ---------- the planning-property trap ---------- + +(ert-deftest test-agenda-query-normal-scheduled-and-deadline-are-found () + "Normal: SCHEDULED and DEADLINE both reach the output. + +These are properties on the planning element, not children in the parse tree. +An implementation that maps over \='timestamp returns the body stamp only and +drops these two silently -- so this asserts they are present, not merely that +the count is right." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00> DEADLINE: <2026-07-31 Fri 17:00>\nBody <2026-07-31 Fri 14:00>\n" + (should (= 1 (length (test-aq-json--of-type events "scheduled")))) + (should (= 1 (length (test-aq-json--of-type events "deadline")))) + (should (= 1 (length (test-aq-json--of-type events "timestamp")))) + (should (equal (test-aq-json--epoch 0 9 31 7 2026) + (test-aq-json--field + (car (test-aq-json--of-type events "scheduled")) 'start))) + (should (equal (test-aq-json--epoch 0 17 31 7 2026) + (test-aq-json--field + (car (test-aq-json--of-type events "deadline")) 'start))))) + +(ert-deftest test-agenda-query-normal-scheduled-alone-is-found () + "Normal: an entry whose only timestamp is SCHEDULED still produces a row. +The positive control for the trap: with no body timestamp to mask it, a broken +implementation returns nothing at all here." + (test-aq-json--with-org + "* TODO Water plants\nSCHEDULED: <2026-07-31 Fri>\n" + (should (= 1 (length events))) + (should (equal "scheduled" (test-aq-json--field (car events) 'type))))) + +;;; ---------- field content ---------- + +(ert-deftest test-agenda-query-normal-title-is-stripped () + "Normal: the title carries no keyword, priority cookie or tags." + (test-aq-json--with-org + "* TODO [#A] Standup with Nerses :work:urgent:\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (equal "Standup with Nerses" + (test-aq-json--field (car events) 'title))))) + +(ert-deftest test-agenda-query-normal-title-renders-org-links () + "Normal: an org link in the title becomes its description text. + +Craig's captured web items carry link syntax in the headline, so this is not +hypothetical -- his live agenda has one today. A wallpaper showing +\"[[https://…][Tracking your habits]]\" is a bug the consumer cannot fix +without parsing org markup." + (test-aq-json--with-org + "* TODO [[https://orgmode.org/x][Tracking your habits]]\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (equal "Tracking your habits" + (test-aq-json--field (car events) 'title)))) + ;; A bare link has no description, so its target is the best available text. + (test-aq-json--with-org + "* TODO [[https://orgmode.org/x]]\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (equal "https://orgmode.org/x" + (test-aq-json--field (car events) 'title))))) + +(ert-deftest test-agenda-query-normal-location-and-organizer () + "Normal: LOCATION and ORGANIZER properties reach the row." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n:PROPERTIES:\n:LOCATION: Room 3\n:ORGANIZER: Nerses\n:END:\n" + (should (equal "Room 3" (test-aq-json--field (car events) 'location))) + (should (equal "Nerses" (test-aq-json--field (car events) 'organizer))))) + +(ert-deftest test-agenda-query-normal-completion-state () + "Normal: a closed entry reports done true and keeps its raw keyword. +Without this a DONE task carrying today's SCHEDULED renders as an upcoming +event, and the error compounds over a working day." + (test-aq-json--with-org + "* DONE Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (eq t (test-aq-json--field (car events) 'done))) + (should (equal "DONE" (test-aq-json--field (car events) 'keyword))))) + +(ert-deftest test-agenda-query-boundary-open-task-is-not-done () + "Boundary: an open task reports done false, not null or missing." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (eq :false (test-aq-json--field (car events) 'done))) + (should (equal "TODO" (test-aq-json--field (car events) 'keyword))))) + +(ert-deftest test-agenda-query-boundary-plain-headline-has-null-keyword () + "Boundary: an entry with no keyword reports null rather than an empty string." + (test-aq-json--with-org + "* Lunch\n<2026-07-31 Fri 12:00-13:00>\n" + (should (eq :null (test-aq-json--field (car events) 'keyword))) + (should (eq :false (test-aq-json--field (car events) 'done))))) + +(ert-deftest test-agenda-query-boundary-repeater-cookie-in-row () + "Boundary: a repeating entry carries its raw cookie so the consumer can mark it." + (test-aq-json--with-org + "* TODO Water plants\nSCHEDULED: <2026-07-01 Wed 09:00 +1d>\n" + (should (= 1 (length events))) + (should (equal "+1d" (test-aq-json--field (car events) 'repeater))) + (should (equal (test-aq-json--epoch 0 9 31 7 2026) + (test-aq-json--field (car events) 'start))))) + +(ert-deftest test-agenda-query-boundary-absent-fields-are-null () + "Boundary: absent optional values are null, so the shape stays stable." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri>\n" + (let ((event (car events))) + (should (eq :null (test-aq-json--field event 'end))) + (should (eq :null (test-aq-json--field event 'location))) + (should (eq :null (test-aq-json--field event 'organizer))) + (should (eq :null (test-aq-json--field event 'repeater))) + (should (eq t (test-aq-json--field event 'all-day)))))) + +;;; ---------- selection ---------- + +(ert-deftest test-agenda-query-boundary-inactive-excluded () + "Boundary: an inactive timestamp never reaches an agenda, so it is excluded." + (test-aq-json--with-org + "* Note\nLogged [2026-07-31 Fri 10:00]\n" + (should-not events))) + +(ert-deftest test-agenda-query-boundary-nested-headlines-not-double-counted () + "Boundary: a child's timestamp belongs to the child alone. +Collecting per-headline by mapping a headline's whole subtree would attribute +each child stamp to every ancestor too." + (test-aq-json--with-org + "* Parent\nSCHEDULED: <2026-07-31 Fri 09:00>\n** Child\nSCHEDULED: <2026-07-31 Fri 11:00>\n" + (should (= 2 (length events))) + (should (equal '("Parent" "Child") + (mapcar (lambda (e) (test-aq-json--field e 'title)) events))))) + +(ert-deftest test-agenda-query-boundary-archived-and-commented-excluded () + "Boundary: archived and commented subtrees are skipped, as org's agenda does. +A query that disagrees with the agenda Craig sees is worse than one returning +less, and both of these are off his agenda." + (test-aq-json--with-org + (concat "* Archived thing :ARCHIVE:\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + "* COMMENT Commented\nSCHEDULED: <2026-07-31 Fri 10:00>\n" + "* Live\nSCHEDULED: <2026-07-31 Fri 11:00>\n") + (should (equal '("Live") + (mapcar (lambda (e) (test-aq-json--field e 'title)) events))))) + +(ert-deftest test-agenda-query-boundary-archive-applies-to-children () + "Boundary: archiving a parent takes its whole subtree off the agenda." + (test-aq-json--with-org + (concat "* Parent :ARCHIVE:\n** Child\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + "* Live\nSCHEDULED: <2026-07-31 Fri 11:00>\n") + (should (equal '("Live") + (mapcar (lambda (e) (test-aq-json--field e 'title)) events))))) + +(ert-deftest test-agenda-query-boundary-outside-window-excluded () + "Boundary: an entry on another day contributes nothing." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-08-15 Sat 09:00>\n" + (should-not events))) + +(ert-deftest test-agenda-query-boundary-empty-buffer () + "Boundary: an empty buffer yields no rows." + (test-aq-json--with-org "" (should-not events))) + +;;; ---------- error cases ---------- + +(ert-deftest test-agenda-query-error-diary-sexp-is-skipped () + "Error: a diary sexp timestamp cannot expand to an instant, and is skipped +without signaling -- one unusable entry must not fail the whole query." + (test-aq-json--with-org + "* Floating\n<%%(diary-float t 3 3)>\n* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (= 1 (length events))) + (should (equal "Standup" (test-aq-json--field (car events) 'title))))) + +(ert-deftest test-agenda-query-error-headline-without-timestamp () + "Error: an entry with no timestamp at all contributes nothing." + (test-aq-json--with-org "* TODO Someday\nJust prose.\n" + (should-not events))) + +;;; ---------- JSON output ---------- + +(ert-deftest test-agenda-query-normal-json-round-trips () + "Normal: the output parses as JSON and preserves the fields. +Booleans arrive as real JSON booleans and absent values as null, so the +consumer can test on them rather than string-matching." + (test-aq-json--with-agenda-file + "* DONE Standup\nSCHEDULED: <2026-07-31 Fri 09:00-09:30>\n" + (let* ((json (cj/agenda-window-json (car window) (cdr window))) + (parsed (json-parse-string json :object-type 'alist))) + (should (= 1 (length parsed))) + (let ((event (aref parsed 0))) + (should (equal "Standup" (alist-get 'title event))) + (should (eq t (alist-get 'done event))) + (should (eq :false (alist-get 'all-day event))) + (should (equal file (alist-get 'file event))) + (should (eq :null (alist-get 'repeater event))) + (should (equal (test-aq-json--epoch 30 9 31 7 2026) + (alist-get 'end event))))))) + +(ert-deftest test-agenda-query-boundary-json-empty-is-array () + "Boundary: an empty result is an empty JSON array, never null. +The consumer parses the same shape whether or not anything is scheduled." + (let ((org-agenda-files nil)) + (should (equal "[]" (cj/agenda-window-json 0 100))))) + +(ert-deftest test-agenda-query-boundary-json-sorted-by-start () + "Boundary: rows come back in start order regardless of file order." + (test-aq-json--with-agenda-file + "* Late\nSCHEDULED: <2026-07-31 Fri 17:00>\n* Early\nSCHEDULED: <2026-07-31 Fri 08:00>\n" + (let ((parsed (json-parse-string + (cj/agenda-window-json (car window) (cdr window)) + :object-type 'alist))) + (should (equal '("Early" "Late") + (mapcar (lambda (e) (alist-get 'title e)) + (append parsed nil))))))) + +(ert-deftest test-agenda-query-error-json-rejects-non-numeric-bounds () + "Error: a non-numeric bound signals rather than returning a wrong answer." + (should-error (cj/agenda-window-json "now" 100) :type 'wrong-type-argument) + (should-error (cj/agenda-window-json 0 nil) :type 'wrong-type-argument)) + +(ert-deftest test-agenda-query-error-rejects-absurdly-wide-window () + "Error: a window wider than the cap signals instead of trying to answer. + +This is the milliseconds-for-seconds mistake, which a JavaScript consumer +makes by passing `Date.now()' straight through. Answering it means building +tens of millions of rows inside the daemon Craig is working in; a renderer +losing one frame is much the cheaper failure." + (let ((org-agenda-files nil) + (now 1785474000)) + (should-error (cj/agenda-window-json now (* now 1000)) :type 'user-error) + ;; A window at the cap is still answered. + (should (equal "[]" (cj/agenda-window-json + now (+ now cj/agenda-query-max-window-seconds)))))) + +(ert-deftest test-agenda-query-error-rejects-millisecond-bounds () + "Error: BOTH bounds in milliseconds is rejected on magnitude. + +This is the likelier shape of the units mistake and the width cap cannot see +it: `Date.now()' and `Date.now() + 3600000' look like a 41-day window, so it +passes the width check and answers with timestamps in the year 58549. A +wrong answer that parses is worse than an error." + (let ((org-agenda-files nil) + (ms 1785474000000)) + (should-error (cj/agenda-window-json ms (+ ms 3600000)) :type 'user-error) + ;; The same instants in seconds are a perfectly ordinary request. + (should (equal "[]" (cj/agenda-window-json 1785474000 1785477600))))) + +;;; ---------- atomic write ---------- + +(ert-deftest test-agenda-query-normal-writes-file-atomically () + "Normal: OUT-PATH receives the JSON and no temp file is left behind." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (out (expand-file-name "agenda.json" dir)) + (org-agenda-files nil)) + (unwind-protect + (progn + (should (equal "[]" (cj/agenda-window-json 0 100 out))) + (should (file-exists-p out)) + (with-temp-buffer + (insert-file-contents out) + (should (equal "[]" (buffer-string)))) + ;; The rename consumed the temp file; only the target remains. + (should (equal '("agenda.json") + (directory-files + dir nil directory-files-no-dot-files-regexp)))) + (delete-directory dir t)))) + +(ert-deftest test-agenda-query-boundary-write-is-readable-by-others () + "Boundary: the written file is not left at the temp file's private 0600. + +`make-temp-file' creates 0600, and the rename carries that mode onto the +target. The whole point of OUT-PATH is that another process reads it, so a +private mode would work only while the reader runs as Craig." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (out (expand-file-name "agenda.json" dir))) + (unwind-protect + (progn + (cj/--agenda-query-write-atomically out "[]") + ;; Readable beyond the owner, following the session umask... + (should (= (logand (file-modes out) #o044) + (logand #o044 (default-file-modes)))) + ;; ...but never executable. `default-file-modes' is 777 minus the + ;; umask, so using it unmasked publishes the JSON as 0755. + ;; No assertion that the mode differs from 0600: under umask 077 + ;; that IS the correct answer, and asserting otherwise would fail + ;; for a reason that has nothing to do with this code. + (should (zerop (logand (file-modes out) #o111)))) + (delete-directory dir t)))) + +(ert-deftest test-agenda-query-boundary-write-replaces-existing () + "Boundary: an existing file is replaced wholesale, not appended to." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (out (expand-file-name "agenda.json" dir))) + (unwind-protect + (progn + (with-temp-file out (insert "stale content that is much longer")) + (cj/--agenda-query-write-atomically out "[]") + (with-temp-buffer + (insert-file-contents out) + (should (equal "[]" (buffer-string))))) + (delete-directory dir t)))) + +(ert-deftest test-agenda-query-error-write-to-missing-dir-preserves-target () + "Error: a write into a nonexistent directory signals and litters nothing." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (missing (expand-file-name "nope/agenda.json" dir))) + (unwind-protect + (progn + (should-error (cj/--agenda-query-write-atomically missing "[]")) + (should-not (file-exists-p missing)) + (should-not (directory-files + dir nil directory-files-no-dot-files-regexp))) + (delete-directory dir t)))) + +(provide 'test-agenda-query) +;;; test-agenda-query.el ends here |
