;; lib/events/tests/calendar.sx — civil date core + RRULE window expansion.

(define ev-cal-pass 0)
(define ev-cal-fail 0)
(define ev-cal-failures (list))

(define
  ev-cal-check!
  (fn
    (name got expected)
    (if
      (= got expected)
      (set! ev-cal-pass (+ ev-cal-pass 1))
      (do
        (set! ev-cal-fail (+ ev-cal-fail 1))
        (append!
          ev-cal-failures
          (str name "\n    expected: " expected "\n    got:      " got))))))

;; Project occurrences to (civil weekday) pairs for legible assertions.
(define
  ev-cal-shape
  (fn
    (occs)
    (map
      (fn
        (o)
        (list (ev-dt->civil (get o :start)) (ev-dt-weekday (get o :start))))
      occs)))

(define
  ev-cal-starts
  (fn (occs) (map (fn (o) (ev-dt->civil (get o :start))) occs)))

(define
  ev-cal-run-all!
  (fn
    ()
    (do
      (ev-cal-check!
        "epoch day zero"
        (ev-days-from-civil 1970 1 1)
        0)
      (ev-cal-check!
        "y2k day number"
        (ev-days-from-civil 2000 1 1)
        10957)
      (ev-cal-check!
        "leap day round trip"
        (ev-civil-from-days
          (ev-days-from-civil 2024 2 29))
        (list 2024 2 29))
      (ev-cal-check!
        "pre-epoch round trip"
        (ev-civil-from-days
          (ev-days-from-civil 1969 12 31))
        (list 1969 12 31))
      (ev-cal-check!
        "epoch is thursday"
        (ev-weekday-of-days 0)
        3)
      (ev-cal-check!
        "2026-06-06 is saturday"
        (ev-dt-weekday (ev-date 2026 6 6))
        5)
      (ev-cal-check!
        "dt carries time of day"
        (ev-dt-tod
          (ev-dt 2026 6 1 9 30))
        570)
      (ev-cal-check!
        "civil from dt"
        (ev-dt->civil
          (ev-dt 2026 12 25 8 0))
        (list 2026 12 25))
      (ev-cal-check!
        "days in feb 2024 (leap)"
        (ev-days-in-month 2024 2)
        29)
      (ev-cal-check!
        "days in feb 2026"
        (ev-days-in-month 2026 2)
        28)
      (ev-cal-check!
        "add months wraps year"
        (ev-add-months 2026 11 3)
        (list 2027 2))
      (ev-cal-check!
        "add months within year"
        (ev-add-months 2026 1 5)
        (list 2026 6))
      (let
        ((ev (ev-event (quote one) (ev-dt 2026 6 10 14 0) 60 nil 1)))
        (do
          (ev-cal-check!
            "single inside window emits once"
            (len
              (ev-expand
                ev
                (ev-date 2026 6 1)
                (ev-date 2026 7 1)))
            1)
          (ev-cal-check!
            "single before window omitted"
            (len
              (ev-expand
                ev
                (ev-date 2026 7 1)
                (ev-date 2026 8 1)))
            0)
          (ev-cal-check!
            "single after window omitted"
            (len
              (ev-expand
                ev
                (ev-date 2026 1 1)
                (ev-date 2026 2 1)))
            0)
          (ev-cal-check!
            "occurrence end is start plus duration"
            (get
              (first
                (ev-expand
                  ev
                  (ev-date 2026 6 1)
                  (ev-date 2026 7 1)))
              :end)
            (+
              (ev-dt 2026 6 10 14 0)
              60))))
      (let
        ((daily (ev-event (quote d) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 5} 1)))
        (do
          (ev-cal-check!
            "daily count caps occurrences"
            (ev-cal-starts
              (ev-expand
                daily
                (ev-date 2026 6 1)
                (ev-date 2026 7 1)))
            (list
              (list 2026 6 1)
              (list 2026 6 2)
              (list 2026 6 3)
              (list 2026 6 4)
              (list 2026 6 5)))
          (ev-cal-check!
            "daily preserves time of day"
            (ev-dt-tod
              (get
                (first
                  (ev-expand
                    daily
                    (ev-date 2026 6 1)
                    (ev-date 2026 7 1)))
                :start))
            540)))
      (let
        ((di (ev-event (quote di) (ev-dt 2026 6 1 0 0) 30 {:interval 3 :freq :daily :until (ev-date 2026 6 30)} 1)))
        (ev-cal-check!
          "daily interval 3 steps by three days"
          (ev-cal-starts
            (ev-expand
              di
              (ev-date 2026 6 1)
              (ev-date 2026 6 13)))
          (list
            (list 2026 6 1)
            (list 2026 6 4)
            (list 2026 6 7)
            (list 2026 6 10)
            (list 2026 6 13))))
      (let
        ((dc (ev-event (quote dc) (ev-dt 2026 6 1 0 0) 30 {:freq :daily :count 10} 1)))
        (ev-cal-check!
          "count is window-independent (clip middle)"
          (ev-cal-starts
            (ev-expand
              dc
              (ev-date 2026 6 5)
              (ev-date 2026 6 8)))
          (list
            (list 2026 6 5)
            (list 2026 6 6)
            (list 2026 6 7)
            (list 2026 6 8))))
      (let
        ((dc2 (ev-event (quote dc2) (ev-dt 2026 6 1 0 0) 30 {:freq :daily :count 3} 1)))
        (ev-cal-check!
          "count exhausted before window yields nothing"
          (len
            (ev-expand
              dc2
              (ev-date 2026 6 10)
              (ev-date 2026 6 20)))
          0))
      (let
        ((wk (ev-event (quote w) (ev-dt 2026 6 1 18 0) 90 {:freq :weekly :byday (list 0 2 4)} 1)))
        (ev-cal-check!
          "weekly byday mon/wed/fri first two weeks"
          (ev-cal-shape
            (ev-expand
              wk
              (ev-date 2026 6 1)
              (ev-date 2026 6 13)))
          (list
            (list (list 2026 6 1) 0)
            (list (list 2026 6 3) 2)
            (list (list 2026 6 5) 4)
            (list (list 2026 6 8) 0)
            (list (list 2026 6 10) 2)
            (list (list 2026 6 12) 4))))
      (let
        ((wu (ev-event (quote wu) (ev-dt 2026 6 1 18 0) 90 {:freq :weekly :until (ev-dt 2026 6 10 23 0) :byday (list 0 2)} 1)))
        (ev-cal-check!
          "weekly until clips trailing occurrences"
          (ev-cal-starts
            (ev-expand
              wu
              (ev-date 2026 6 1)
              (ev-date 2026 7 1)))
          (list
            (list 2026 6 1)
            (list 2026 6 3)
            (list 2026 6 8)
            (list 2026 6 10))))
      (let
        ((wi (ev-event (quote wi) (ev-dt 2026 6 1 18 0) 90 {:interval 2 :freq :weekly :byday (list 0)} 1)))
        (ev-cal-check!
          "weekly interval 2 skips alternate weeks"
          (ev-cal-starts
            (ev-expand
              wi
              (ev-date 2026 6 1)
              (ev-date 2026 7 6)))
          (list
            (list 2026 6 1)
            (list 2026 6 15)
            (list 2026 6 29))))
      (let
        ((wd (ev-event (quote wd) (ev-dt 2026 6 3 12 0) 60 {:freq :weekly :count 3} 1)))
        (ev-cal-check!
          "weekly default byday is dtstart weekday"
          (ev-cal-shape
            (ev-expand
              wd
              (ev-date 2026 6 1)
              (ev-date 2026 8 1)))
          (list
            (list (list 2026 6 3) 2)
            (list (list 2026 6 10) 2)
            (list (list 2026 6 17) 2))))
      (let
        ((wc (ev-event (quote wc) (ev-dt 2026 6 1 18 0) 90 {:freq :weekly :count 10 :byday (list 0 2)} 1)))
        (ev-cal-check!
          "weekly count window-independent (clip middle)"
          (ev-cal-starts
            (ev-expand
              wc
              (ev-date 2026 6 15)
              (ev-date 2026 7 5)))
          (list
            (list 2026 6 15)
            (list 2026 6 17)
            (list 2026 6 22)
            (list 2026 6 24)
            (list 2026 6 29)
            (list 2026 7 1))))
      (let
        ((wf (ev-event (quote wf) (ev-dt 2026 6 3 18 0) 90 {:freq :weekly :count 4 :byday (list 0 2 4)} 1)))
        (ev-cal-check!
          "first week skips byday earlier than dtstart"
          (ev-cal-starts
            (ev-expand
              wf
              (ev-date 2026 6 1)
              (ev-date 2026 7 1)))
          (list
            (list 2026 6 3)
            (list 2026 6 5)
            (list 2026 6 8)
            (list 2026 6 10))))
      (let
        ((md (ev-event (quote md) (ev-dt 2026 1 15 9 0) 60 {:bymonthday (list 15) :freq :monthly} 1)))
        (do
          (ev-cal-check!
            "monthly bymonthday 15th"
            (ev-cal-starts
              (ev-expand
                md
                (ev-date 2026 1 1)
                (ev-date 2026 4 1)))
            (list
              (list 2026 1 15)
              (list 2026 2 15)
              (list 2026 3 15)))
          (ev-cal-check!
            "monthly preserves time of day"
            (ev-dt-tod
              (get
                (first
                  (ev-expand
                    md
                    (ev-date 2026 1 1)
                    (ev-date 2026 4 1)))
                :start))
            540)))
      (let
        ((mm (ev-event (quote mm) (ev-dt 2026 1 1 9 0) 60 {:bymonthday (list 1 15) :freq :monthly :count 4} 1)))
        (ev-cal-check!
          "monthly multiple bymonthday sorted within month"
          (ev-cal-starts
            (ev-expand
              mm
              (ev-date 2026 1 1)
              (ev-date 2026 12 1)))
          (list
            (list 2026 1 1)
            (list 2026 1 15)
            (list 2026 2 1)
            (list 2026 2 15))))
      (let
        ((ml (ev-event (quote ml) (ev-dt 2026 1 31 9 0) 60 {:bymonthday (list -1) :freq :monthly} 1)))
        (ev-cal-check!
          "monthly bymonthday -1 is last day"
          (ev-cal-starts
            (ev-expand
              ml
              (ev-date 2026 1 1)
              (ev-date 2026 4 1)))
          (list
            (list 2026 1 31)
            (list 2026 2 28)
            (list 2026 3 31))))
      (let
        ((mn (ev-event (quote mn) (ev-dt 2026 1 1 9 0) 60 {:freq :monthly :byday (list {:ord 2 :wd 1})} 1)))
        (ev-cal-check!
          "monthly 2nd tuesday"
          (ev-cal-shape
            (ev-expand
              mn
              (ev-date 2026 1 1)
              (ev-date 2026 4 1)))
          (list
            (list (list 2026 1 13) 1)
            (list (list 2026 2 10) 1)
            (list (list 2026 3 10) 1))))
      (let
        ((mz (ev-event (quote mz) (ev-dt 2026 1 1 9 0) 60 {:freq :monthly :byday (list {:ord -1 :wd 4})} 1)))
        (ev-cal-check!
          "monthly last friday"
          (ev-cal-shape
            (ev-expand
              mz
              (ev-date 2026 1 1)
              (ev-date 2026 4 1)))
          (list
            (list (list 2026 1 30) 4)
            (list (list 2026 2 27) 4)
            (list (list 2026 3 27) 4))))
      (let
        ((m31 (ev-event (quote m31) (ev-dt 2026 1 31 9 0) 60 {:freq :monthly :count 4} 1)))
        (ev-cal-check!
          "monthly default day-of-month skips short months"
          (ev-cal-starts
            (ev-expand
              m31
              (ev-date 2026 1 1)
              (ev-date 2026 12 1)))
          (list
            (list 2026 1 31)
            (list 2026 3 31)
            (list 2026 5 31)
            (list 2026 7 31))))
      (let
        ((mi (ev-event (quote mi) (ev-dt 2026 1 10 9 0) 60 {:interval 3 :freq :monthly :count 3} 1)))
        (ev-cal-check!
          "monthly interval 3 steps by quarter"
          (ev-cal-starts
            (ev-expand
              mi
              (ev-date 2026 1 1)
              (ev-date 2027 1 1)))
          (list
            (list 2026 1 10)
            (list 2026 4 10)
            (list 2026 7 10))))
      (let
        ((mc (ev-event (quote mc) (ev-dt 2026 1 5 9 0) 60 {:freq :monthly :count 12} 1)))
        (ev-cal-check!
          "monthly count window-independent (clip middle)"
          (ev-cal-starts
            (ev-expand
              mc
              (ev-date 2026 4 1)
              (ev-date 2026 6 30)))
          (list
            (list 2026 4 5)
            (list 2026 5 5)
            (list 2026 6 5))))
      (let
        ((a (ev-event (quote a) (ev-dt 2026 6 2 10 0) 30 {:freq :daily :count 2} 1))
          (b
            (ev-event
              (quote b)
              (ev-dt 2026 6 1 9 0)
              30
              {:freq :daily :count 2}
              1)))
        (ev-cal-check!
          "expand-all sorts merged occurrences by start"
          (map
            (fn (o) (list (get o :id) (ev-dt->civil (get o :start))))
            (ev-expand-all
              (list a b)
              (ev-date 2026 6 1)
              (ev-date 2026 7 1)))
          (list
            (list (quote b) (list 2026 6 1))
            (list (quote b) (list 2026 6 2))
            (list (quote a) (list 2026 6 2))
            (list (quote a) (list 2026 6 3))))))))

;; ---- EXDATE / RDATE exceptions ----
(define
  ev-cal-ex-run-all!
  (fn
    ()
    (do
      ;; EXDATE removes a matching occurrence from the recurrence
      (let
        ((ex
           (ev-event-full
             (quote standup)
             (ev-dt 2026 6 1 9 0)
             30
             {:freq :daily :count 5}
             1
             (list (ev-dt 2026 6 3 9 0))
             (list))))
        (ev-cal-check!
          "EXDATE excludes the matching occurrence"
          (ev-cal-starts (ev-expand ex (ev-date 2026 6 1) (ev-date 2026 7 1)))
          (list (list 2026 6 1) (list 2026 6 2) (list 2026 6 4) (list 2026 6 5))))
      ;; EXDATE that matches nothing is a no-op
      (let
        ((ex2
           (ev-event-full
             (quote s)
             (ev-dt 2026 6 1 9 0)
             30
             {:freq :daily :count 3}
             1
             (list (ev-dt 2026 6 9 9 0))
             (list))))
        (ev-cal-check!
          "EXDATE not matching any occurrence is a no-op"
          (len (ev-expand ex2 (ev-date 2026 6 1) (ev-date 2026 7 1)))
          3))
      ;; RDATE adds an explicit occurrence (within the window)
      (let
        ((rd
           (ev-event-full
             (quote s)
             (ev-dt 2026 6 1 9 0)
             30
             {:freq :daily :count 3}
             1
             (list)
             (list (ev-dt 2026 6 10 9 0)))))
        (do
          (ev-cal-check!
            "RDATE adds an explicit occurrence, sorted in"
            (ev-cal-starts (ev-expand rd (ev-date 2026 6 1) (ev-date 2026 7 1)))
            (list (list 2026 6 1) (list 2026 6 2) (list 2026 6 3) (list 2026 6 10)))
          (ev-cal-check!
            "RDATE outside the window is dropped"
            (len (ev-expand rd (ev-date 2026 6 1) (ev-date 2026 6 5)))
            3)))
      ;; RDATE coinciding with an rrule occurrence is de-duplicated
      (let
        ((rdup
           (ev-event-full
             (quote s)
             (ev-dt 2026 6 1 9 0)
             30
             {:freq :daily :count 3}
             1
             (list)
             (list (ev-dt 2026 6 2 9 0)))))
        (ev-cal-check!
          "RDATE duplicating an occurrence does not double it"
          (len (ev-expand rdup (ev-date 2026 6 1) (ev-date 2026 7 1)))
          3))
      ;; EXDATE wins over RDATE for the same datetime
      (let
        ((both
           (ev-event-full
             (quote s)
             (ev-dt 2026 6 1 9 0)
             30
             {:freq :daily :count 3}
             1
             (list (ev-dt 2026 6 2 9 0))
             (list (ev-dt 2026 6 2 9 0)))))
        (ev-cal-check!
          "EXDATE wins over RDATE and the rrule for the same date"
          (ev-cal-starts (ev-expand both (ev-date 2026 6 1) (ev-date 2026 7 1)))
          (list (list 2026 6 1) (list 2026 6 3))))
      ;; RDATE-only event (no rrule)
      (let
        ((ronly
           (ev-event-full
             (quote s)
             (ev-dt 2026 6 1 9 0)
             30
             nil
             1
             (list)
             (list (ev-dt 2026 6 5 9 0) (ev-dt 2026 6 3 9 0)))))
        (ev-cal-check!
          "RDATE-only event yields dtstart plus the extra dates, sorted"
          (ev-cal-starts (ev-expand ronly (ev-date 2026 6 1) (ev-date 2026 7 1)))
          (list (list 2026 6 1) (list 2026 6 3) (list 2026 6 5))))
      ;; plain ev-event (no exception keys) is unaffected
      (let
        ((plain (ev-event (quote p) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 3} 1)))
        (ev-cal-check!
          "plain event without exceptions expands unchanged"
          (len (ev-expand plain (ev-date 2026 6 1) (ev-date 2026 7 1)))
          3)))))

;; ---- per-occurrence overrides (reschedule one instance) ----
(define
  ev-cal-ov-run-all!
  (fn
    ()
    (let
      ((base (ev-event (quote standup) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 4} 1)))
      (do
        ;; reschedule one instance to a new time + duration
        (let
          ((moved (ev-with-override base (ev-dt 2026 6 2 9 0) (ev-dt 2026 6 2 14 0) 45)))
          (let
            ((occs (ev-expand moved (ev-date 2026 6 1) (ev-date 2026 6 5))))
            (do
              (ev-cal-check!
                "override moves only the targeted instance"
                (map (fn (o) (ev-dt-tod (get o :start))) occs)
                (list 540 840 540 540))
              (ev-cal-check!
                "override applies the new duration"
                (map (fn (o) (- (get o :end) (get o :start))) occs)
                (list 30 45 30 30))
              (ev-cal-check!
                "override keeps the series length"
                (len occs)
                4))))
        ;; an instance moved out of the window vacates its slot
        (let
          ((movedout (ev-with-override base (ev-dt 2026 6 2 9 0) (ev-dt 2026 6 20 9 0) 30)))
          (ev-cal-check!
            "instance moved out of window is dropped, slot vacated"
            (ev-cal-starts (ev-expand movedout (ev-date 2026 6 1) (ev-date 2026 6 5)))
            (list (list 2026 6 1) (list 2026 6 3) (list 2026 6 4))))
        ;; override for a non-existent original start is a no-op
        (let
          ((noop (ev-with-override base (ev-dt 2026 6 9 9 0) (ev-dt 2026 6 9 14 0) 45)))
          (ev-cal-check!
            "override for a non-occurring start is a no-op"
            (len (ev-expand noop (ev-date 2026 6 1) (ev-date 2026 6 5)))
            4))
        ;; overrides re-sort the agenda when an instance moves earlier
        (let
          ((early (ev-with-override base (ev-dt 2026 6 3 9 0) (ev-dt 2026 6 1 7 0) 30)))
          (ev-cal-check!
            "an instance moved earlier re-sorts into place"
            (map (fn (o) (ev-dt-tod (get o :start))) (ev-expand early (ev-date 2026 6 1) (ev-date 2026 6 5)))
            (list 420 540 540 540)))))))

(define
  ev-calendar-tests-run!
  (fn
    ()
    (do
      (set! ev-cal-pass 0)
      (set! ev-cal-fail 0)
      (set! ev-cal-failures (list))
      (ev-cal-run-all!)
      (ev-cal-ex-run-all!)
      (ev-cal-ov-run-all!)
      {:failures ev-cal-failures :total (+ ev-cal-pass ev-cal-fail) :passed ev-cal-pass :failed ev-cal-fail})))