η-reduce icr:make-bysetpos-filter

This commit is contained in:
Mattias Engdegård 2026-03-02 17:10:04 +01:00
parent 9a092fd74e
commit b223f825f6
2 changed files with 23 additions and 26 deletions

View file

@ -953,8 +953,8 @@ BYSECOND=... clause; see `icalendar-recur' for the possible values."
(BYMINUTE (icr:refine-byminute interval values vtimezone)) (BYMINUTE (icr:refine-byminute interval values vtimezone))
(BYSECOND (icr:refine-bysecond interval values vtimezone)))) (BYSECOND (icr:refine-bysecond interval values vtimezone))))
(defun icr:make-bysetpos-filter (setpos) (defun icr:bysetpos-filter (setpos recurrences)
"Return a filter on values for the indices in SETPOS. "Filter RECURRENCES on values for the indices in SETPOS.
SETPOS should be a list of positive or negative integers between -366 SETPOS should be a list of positive or negative integers between -366
and 366, indicating a fixed index in a set of recurrences for *one and 366, indicating a fixed index in a set of recurrences for *one
@ -963,25 +963,24 @@ an `icalendar-recur'. For example, in a YEARLY recurrence rule with an
INTERVAL of 1, the SETPOS represent indices in the recurrence instances INTERVAL of 1, the SETPOS represent indices in the recurrence instances
generated for a single year. generated for a single year.
The returned value is a closure which can be called on the list of The returned value is RECURRENCES filtered by index."
recurrences for one interval to filter it by index." (let* ((len (length recurrences))
(lambda (dts) (keep-indices (mapcar
(let* ((len (length dts)) (lambda (pos)
(keep-indices (mapcar ;; sequence indices are 0-based, POS's are 1-based:
(lambda (pos) (if (< pos 0)
;; sequence indices are 0-based, POS's are 1-based: (+ pos len)
(if (< pos 0) (1- pos)))
(+ pos len) setpos))
(1- pos))) (r nil)
setpos)) (i 0)
(r nil) (dts recurrences))
(i 0)) (while dts
(while dts (when (memq i keep-indices)
(when (memq i keep-indices) (push (car dts) r))
(push (car dts) r)) (incf i)
(incf i) (pop dts))
(pop dts)) (nreverse r)))
(nreverse r))))
(defun icr:refine-from-clauses (interval recur-value dtstart (defun icr:refine-from-clauses (interval recur-value dtstart
&optional vtimezone) &optional vtimezone)
@ -1225,8 +1224,7 @@ retrieved on subsequent calls with the same arguments."
(keep-indices (ical:recur-by* 'BYSETPOS recur-value)) (keep-indices (ical:recur-by* 'BYSETPOS recur-value))
(pos-recs (pos-recs
(if keep-indices (if keep-indices
(funcall (icr:make-bysetpos-filter keep-indices) (icr:bysetpos-filter keep-indices sub-recs)
sub-recs)
sub-recs)) sub-recs))
;; Remove any recurrences before DTSTART or after UNTIL ;; Remove any recurrences before DTSTART or after UNTIL
;; (both of which are inclusive bounds): ;; (both of which are inclusive bounds):

View file

@ -117,13 +117,12 @@ END:VTIMEZONE
;; Tests for basic functions: ;; Tests for basic functions:
(ert-deftest ict:recur-bysetpos-filter () (ert-deftest ict:recur-bysetpos-filter ()
"Test that `icr:make-bysetpos-filter' filters correctly by position" "Test that `icr:bysetpos-filter' filters correctly by position"
(let* ((t1 (list 1 1 2024)) (let* ((t1 (list 1 1 2024))
(t2 (list 2 1 2024)) (t2 (list 2 1 2024))
(t3 (list 12 30 2024)) (t3 (list 12 30 2024))
(dts (list t1 t2 t3)) (dts (list t1 t2 t3))
(filter (icr:make-bysetpos-filter (list 1 -1))) (filtered (icr:bysetpos-filter (list 1 -1) dts)))
(filtered (funcall filter dts)))
(should (member t1 filtered)) (should (member t1 filtered))
(should (member t3 filtered)) (should (member t3 filtered))
(should-not (member t2 filtered)))) (should-not (member t2 filtered))))