From dc4383fa8992c91aef8f5f580d4cb5288dfeb40a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Fri, 22 Mar 2019 19:51:07 +0100
Subject: Cleanup and cleandown in (v r generate).

---
 vcalendar/recurrence/generate.scm | 96 +++++++++++++++++++++++----------------
 1 file changed, 57 insertions(+), 39 deletions(-)

diff --git a/vcalendar/recurrence/generate.scm b/vcalendar/recurrence/generate.scm
index c9e1c114..fae404ec 100644
--- a/vcalendar/recurrence/generate.scm
+++ b/vcalendar/recurrence/generate.scm
@@ -6,7 +6,7 @@
 
   #:use-module (srfi srfi-26)           ; Cut
   #:use-module (srfi srfi-41)           ; Streams
-  #:use-module (ice-9 control)          ; ?
+  ;; #:use-module (ice-9 control)          ; call-with-escape-continuation
   #:use-module (ice-9 match)
   #:use-module (vcalendar)
   #:use-module (vcalendar datetime)
@@ -34,75 +34,93 @@
 ;;; Can have VALUE parameter, specyfying "DATE-TIME", "DATE" or "PREIOD".
 ;;; PERIOD (see 3.3.9)
 
-(define (seconds-in interval)
-  (case interval
+(define (seconds-in freq)
+  (case freq
     ((SECONDLY) 1)
     ((MINUTELY) 60)
     ((HOURLY) (* 60 60))
     ((DAILY) (* 60 60 24))
     ((WEEKLY) (* 60 60 24 7))))
 
+
+;; BYDAY and the like depend on the freq?
+;; Line 7100
+;; Table @@ 2430
+;; 
+;; Event x Rule → Bool (continue?)
+;; Alternative, monadic solution using <optional>.
+;; @example
+;; (optional->bool
+;;  (do (<$> (cut time<=? (attr last 'DTSTART)) (until r))
+;;      (<$> (negate zero?) (count r))
+;;    (just #t)))
+;; @end example
 (define-stream (recur-event-stream event rule-obj)
   (stream-unfold
-   ;; Rule → event
+
+   ;; Event x Rule → Event
    (match-lambda
      ((last r)
       (let ((e (copy-vcomponent last)))   ; new event
-        ;; TODO
-        ;; Update DTEND as (add-duration DTSTART DURATINO)
         (cond
 
-         ;; BYDAY and the like depend on the freq?
-         ;; Line 7100
-         ;; Table @ 2430
-
          ((memv (freq r) '(SECONDLY MINUTELY HOURLY DAILY WEEKLY))
-          (mod! (attr e "DTSTART")
+          (mod! (attr e 'DTSTART)       ; MUTATE
                 (cut add-duration! <>
                      (make-duration
-                      ;; INTERVAL
-                      (* (interval r)
+                      (* (interval r)   ; INTERVAL
                          (seconds-in (freq r)))))))
 
          ((memv (freq r) '(MONTHLY YEARLY))
-          ;; Hur fasen beräkrnar man det här!!!!
-          #f
-          )
-
-         (else #f))
+          #f ; Hur fasen beräkrnar man det här!!!!
+          ))
+
+        ;; TODO this is just here for testing
+        (mod! (attr e 'NEW_ATTR) not)   ; MUTATE
+        ;; This segfaults...
+        ;; (set! (attr e 'N) #t)           ; MUTATE
+        ((@ (vcalendar output) print-vcomponent) e)
+        (set! (attr e 'D) #t)
+
+        (set! (attr e 'DTEND)           ; MUTATE
+              (add-duration
+               (attr e 'DTSTART)
+               (attr e 'DURATION)))
         e)))
 
-   ;; Rule → Bool (#t if continue, #f if stop)
+   ;; Event x Rule → Bool (continue?)
    (match-lambda
-     ((last r)
+     ((e r)
 
-      ;; (optional->bool
-      ;;  (do (<$> (cut time<=? (attr last 'DTSTART)) (until r))
-      ;;      (<$> (negate zero?) (count r))
-      ;;    (just #t)))
+      (or (and (not (until r)) (not (count r)))                   ; Never ending
+          (and=> (count r) (negate zero?))                        ; COUNT
+          (and=> (until r) (cut time<=? (attr e 'DTSTART) <>))))) ; UNTIL
 
-      (or (and (not (until r)) (not (count r)))
-          (and=> (until r) (cut time<=? (attr last 'DTSTART) <>)) ; UNTIL
-          (and=> (count r) (negate zero?)))                      ; COUNT
-
-      )
-     )
-
-   ;; Rule → (next) Rule
+   ;; _ x Rule → (_, (next) Rule)
    (match-lambda
-     ((last r)
-      ;; Note that this doesn't modify, since r is immutable.
-      (list last
-            (if (count r)
-                (mod! (count r) 1-)
-                r))))
+     ((e r)
+      (list
+       e (if (count r)
+             ;; Note that this doesn't modify, since r is immutable.
+             (mod! (count r) 1-)
+             r))))
+
+   ;; Seed
    (list event rule-obj)))
 
 
 (define (generate-recurrence-set event)
   (unless (attr event "DURATION")
-    (set! (attr event "DURATION")
+    (set! (attr event "DURATION")       ; MUTATE
           (time-difference
            (attr event "DTEND")
            (attr event "DTSTART"))))
   (recur-event-stream event (parse-recurrence-rule (attr event "RRULE"))))
+
+  ;; How doee stream-unfold even work?
+  ;; What element is used as the next seed?
+;;; stream-fold:
+;; (stream-let recur ((base base))
+;;     (if (pred? base)
+;;         (stream-cons (mapper base) (recur (generator base)))
+;;         stream-null))
-- 
cgit v1.2.3