From 7c81b056a56eb0f142b99423509994fa2ed4cf71 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Fri, 8 Mar 2019 10:42:59 +0100
Subject: Got DAILY repeating event!

---
 strbuf.c                    |  4 ++++
 test.scm                    | 37 +++++++++++++++++++++++++++++++++++++
 testcal/repeating-event.ics | 28 ++++++++++++++++++++++++++++
 vcalendar/recur.scm         | 33 ++++++++++++++++-----------------
 4 files changed, 85 insertions(+), 17 deletions(-)
 create mode 100755 test.scm
 create mode 100644 testcal/repeating-event.ics

diff --git a/strbuf.c b/strbuf.c
index 886276e5..455100a2 100644
--- a/strbuf.c
+++ b/strbuf.c
@@ -69,6 +69,10 @@ int DEEP_COPY(strbuf)(strbuf* dest, strbuf* src) {
 		retval = 1;
 	}
 
+	if (src->scm != NULL) {
+		dest->scm = src->scm;
+	}
+
 	dest->len = src->len;
 	memcpy(dest->mem, src->mem, src->len);
 	return retval;
diff --git a/test.scm b/test.scm
new file mode 100755
index 00000000..ac0308ad
--- /dev/null
+++ b/test.scm
@@ -0,0 +1,37 @@
+#!/usr/bin/guile -s
+!#
+
+(add-to-load-path (dirname (current-filename)))
+
+(use-modules (rnrs base)                ; assert
+             (srfi srfi-1)
+             (srfi srfi-19)
+             (srfi srfi-41)
+             (code)
+             (vcalendar)
+             (vcalendar recur)
+             (vcalendar datetime))
+
+(define cal (make-vcomponent "testcal/repeating-event.ics"))
+
+(define ev (find (lambda (ev) (eq? 'VEVENT (type ev)))
+                 (children cal)))
+
+(define ev-copy (copy-vcomponent ev))
+
+(assert (equal? (children ev)
+                (children ev-copy)))
+
+(transform-attr! ev "DTSTART" parse-datetime)
+
+
+(stream-for-each
+ (lambda (ev)
+   (display (date->string (attr ev "DTSTART") "~1 ~3")) (newline))
+ (stream-take 10 (recur-event ev)))
+
+(define stream-cadr (compose stream-car stream-cdr))
+
+(newline)
+(display (date->string (attr ev "DTSTART") "~1 ~3")) (newline)
+(display (date->string (attr (stream-cadr (recur-event ev)) "DTSTART") "~1 ~3")) (newline)
diff --git a/testcal/repeating-event.ics b/testcal/repeating-event.ics
new file mode 100644
index 00000000..2605d3e1
--- /dev/null
+++ b/testcal/repeating-event.ics
@@ -0,0 +1,28 @@
+BEGIN:VCALENDAR
+VERSION:2.0
+PRODID:-//PIMUTILS.ORG//NONSGML khal / icalendar //EN
+BEGIN:VTIMEZONE
+TZID:Europe/Stockholm
+BEGIN:STANDARD
+DTSTART;VALUE=DATE-TIME:20181028T020000
+TZNAME:CET
+TZOFFSETFROM:+0200
+TZOFFSETTO:+0100
+END:STANDARD
+BEGIN:DAYLIGHT
+DTSTART;VALUE=DATE-TIME:20190331T030000
+TZNAME:CEST
+TZOFFSETFROM:+0100
+TZOFFSETTO:+0200
+END:DAYLIGHT
+END:VTIMEZONE
+BEGIN:VEVENT
+SUMMARY:Repeating event
+DTSTART;TZID=Europe/Stockholm;VALUE=DATE-TIME:20190302T160000
+DTEND;TZID=Europe/Stockholm;VALUE=DATE-TIME:20190302T170000
+DTSTAMP;VALUE=DATE-TIME:20190302T165849Z
+UID:USG7HSRFJSZ6YURWCNSH3UCKI2PHP19SWGBG
+SEQUENCE:0
+RRULE:FREQ=DAILY
+END:VEVENT
+END:VCALENDAR
diff --git a/vcalendar/recur.scm b/vcalendar/recur.scm
index 15afdd26..a480d946 100644
--- a/vcalendar/recur.scm
+++ b/vcalendar/recur.scm
@@ -10,7 +10,7 @@
   #:use-module (vcalendar)
   #:use-module (vcalendar datetime)
   #:use-module (util)
-  #:export (<recur-rule> build-recur-rules))
+  #:export (<recur-rule> build-recur-rules recur-event))
 
 (define-immutable-record-type <recur-rule>
   (make-recur-rules
@@ -122,29 +122,28 @@
 
 
 (define (generate-next event rule)
-  (match rule
-    (($ <recur-rule> freq until count interval bysecond byminute byhour wkst)
-     (case freq
-       ((WEEKLY)
-        ;; TODO implement copy-event
-        (let ((new-event (copy-event event)))
-          (transform-attr! new-event "DTSTART"
-                           (cut date-add <> 1 weeks)))))
-     
-     ))
-
-  )
+  (let ((new-event (copy-vcomponent event)))
+    (match rule
+      (($ <recur-rule> freq until count interval bysecond byminute byhour wkst)
+       (case freq
+         ((WEEKLY) (transform-attr! new-event "DTSTART" (cut date-add <> 1 weeks))
+          (values new-event rule))
+         ((DAILY) (transform-attr! new-event "DTSTART" (cut date-add <> 1 days))
+          (values new-event rule))
+         (else (values '() rule))))
+      (_ (values event rule)))))
 
 (define-stream (recur-event-stream event rule-obj)
   (stream-cons event
-               (receive (next-event next-rule) (generate-next event rule-obj)
-                 (recur-event-stream next-event next-rule))))
+               (receive (next-event next-rule)
+                   (generate-next event rule-obj)
+                 (if (null? next-event)
+                     stream-null
+                     (recur-event-stream next-event next-rule)))))
 
 (define (recur-event event)
   (recur-event-stream event (build-recur-rules (get-attr event "RRULE"))))
 
-
-
 (define tzero (make-time time-utc 0 0))
 (define dzero (time-utc->date tzero))
 
-- 
cgit v1.2.3