aboutsummaryrefslogtreecommitdiff
path: root/tests/annoying-events.scm
blob: ba93b9c982367f01083d06eb524bd6fd323915d6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
(((srfi srfi-41 util) filter-sorted-stream)
 ((srfi srfi-41) stream stream->list stream-filter stream-take-while)
 ((vcomponent base) extract prop make-vcomponent)
 ((vcomponent datetime) event-overlaps?)
 ((datetime) date date+ date<)
 ((calp util) set!))

(define* (event key: summary dtstart dtend)
  (define ev (make-vcomponent 'VEVENT))
  (set! (prop ev 'SUMMARY) summary
        (prop ev 'DTSTART) dtstart
        (prop ev 'DTEND) dtend)
  ev)

(define start #2021-11-01)
(define end (date+ start (date day: 8)))

(define ev-set
  (stream
   (event                         ; should be part of the result
    summary: "A"
    dtstart: #2021-10-01
    dtend: #2021-12-01)
   (event                         ; should NOT be part of the result
    summary: "B"
    dtstart: #2021-10-10
    dtend: #2021-10-11)
   (event                         ; should also be part of the result
    summary: "C"
    dtstart: #2021-11-02
    dtend: #2021-11-03)))

;; (if (and (date< (prop ev 'DTSTART) start-date)
;;          (date<= (prop ev 'DTEND) end-date))
;;     ;; event will be picked, but next event might have
;;     (and (date< start-date (prop ev 'DTSTART))
;;          (date< end-date (prop ev 'DTEND)))
;;     ;; meaning that it wont be added, stopping filter-sorted-stream
;;     )

;; The naïve way to get all events in an interval. Misses C due to B being "in the way"

(test-equal "incorrect handling of non-contigious"
  '("A" #; "C")
  (map (extract 'SUMMARY)
       (stream->list
        (filter-sorted-stream
         (lambda (ev) (event-overlaps? ev start (date+ start (date day: 8))))
         ev-set))))

;; A correct way

(test-equal "correct handling of non-contigious"
  '("A" "C")
  (map (extract 'SUMMARY)
       (stream->list
        (stream-filter (lambda (ev) (event-overlaps? ev start end))
                       (stream-take-while (lambda (ev) (date< (prop ev 'DTSTART) end))
                                          ev-set)))))