From 9ae3d41443d59c253257f637b03d7ed5854ad675 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sat, 9 Mar 2019 11:47:50 +0100
Subject: Minor cleanups.

---
 util.scm            |  7 ++++++-
 vcalendar.scm       | 13 ++-----------
 vcalendar/recur.scm | 29 ++++++++++++++---------------
 3 files changed, 22 insertions(+), 27 deletions(-)

diff --git a/util.scm b/util.scm
index 30b87a2e..54addb4c 100644
--- a/util.scm
+++ b/util.scm
@@ -2,7 +2,8 @@
   #:use-module (srfi srfi-1)
   #:export (destructure-lambda let-multi fold-lists catch-let
                                for-each-in
-                               define-quick-record define-quick-record!)
+                               define-quick-record define-quick-record!
+                               mod!)
   #:replace (let*)
   )
 
@@ -104,3 +105,7 @@
            body ...)))]
 
     ))
+
+;; Like set!, but applies a transformer on the already present value.
+(define-syntax-rule (mod! field transform-proc)
+  (set! field (transform-proc field)))
diff --git a/vcalendar.scm b/vcalendar.scm
index c664c1aa..143d9e79 100644
--- a/vcalendar.scm
+++ b/vcalendar.scm
@@ -9,8 +9,8 @@
   "Parse all start times into scheme date objects."
   (for-each-in (children cal 'VEVENT)
                (lambda (ev)
-                 (transform-attr! ev "DTSTART" parse-datetime)
-                 (transform-attr! ev "DTEND"   parse-datetime)))
+                 (mod! (attr ev "DTSTART") parse-datetime)
+                 (mod! (attr ev "DTEND")   parse-datetime)))
   cal)
 
 (define-public (make-vcomponent path)
@@ -57,15 +57,6 @@
 (define-public push-child! %vcomponent-push-child!)
 (define-public attributes %vcomponent-attribute-list)
 
-(define-public (transform-attr! ev field transformer)
-  "Apply transformer to field in ev, and store the result back."
-  ;; TODO make transform C primitive.
-  ;; Halfing the lookups.
-  (set! (attr ev field)
-        (transformer (attr ev field))))
-
-;; { (attr ev field) := (transformer (attr ev field)) }
-
 (define-public copy-vcomponent %vcomponent-shallow-copy)
 
 (define-public (search cal term)
diff --git a/vcalendar/recur.scm b/vcalendar/recur.scm
index 3a02aa73..4ca71f29 100644
--- a/vcalendar/recur.scm
+++ b/vcalendar/recur.scm
@@ -1,13 +1,11 @@
 (define-module (vcalendar recur)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-8)            ; Recieve
   #:use-module (srfi srfi-9 gnu)        ; Records
   #:use-module (srfi srfi-19)           ; Datetime
   #:use-module (srfi srfi-19 util)
   #:use-module (srfi srfi-26)           ; Cut
   #:use-module (srfi srfi-41)           ; Streams
   #:use-module (ice-9 curried-definitions)
-  ;; #:use-module (ice-9 match)
   #:use-module (vcalendar)
   #:use-module (vcalendar datetime)
   #:use-module (util)
@@ -119,28 +117,29 @@
         (string-split str #\;))))
 
 (define (generate-next event rule)
-  (let ((new-event (copy-vcomponent event)))
+  (let ((ne (copy-vcomponent event)))   ; new event
     (case (freq rule)
       ((WEEKLY)
-       (transform-attr! new-event "DTSTART" (cut time-add <> 1 weeks))
-       (set! (attr new-event "DTEND")
-             (add-duration (attr new-event "DTSTART")
-                           (attr new-event "DURATION")))
-       (values new-event rule))
+       (mod! (attr ne "DTSTART") (cut time-add <> 1 weeks))
+
+       (set! (attr ne "DTEND")
+             (add-duration (attr ne "DTSTART")
+                           (attr ne "DURATION")))
+       (values ne rule))
 
       ((DAILY)
-       (transform-attr! new-event "DTSTART" (cut time-add <> 1 days))
-       (set! (attr new-event "DTEND")
-             (add-duration  (attr new-event "DTSTART")
-                            (attr new-event "DURATION")))
-       (values new-event rule))
+       (mod! (attr ne "DTSTART") (cut time-add <> 1 days))
+
+       (set! (attr ne "DTEND")
+             (add-duration  (attr ne "DTSTART")
+                            (attr ne "DURATION")))
+       (values ne rule))
 
       (else (values '() rule)))))
 
 (define-stream (recur-event-stream event rule-obj)
   (stream-cons event
-               (receive (next-event next-rule)
-                   (generate-next event rule-obj)
+               (let* ([next-event next-rule (generate-next event rule-obj)])
                  (if (null? next-event)
                      stream-null
                      (recur-event-stream next-event next-rule)))))
-- 
cgit v1.2.3