diff options
| -rw-r--r-- | module/entry-points/ical.scm | 12 | ||||
| -rw-r--r-- | module/output/ical.scm | 18 | ||||
| -rw-r--r-- | module/vcomponent.scm | 5 | ||||
| -rw-r--r-- | module/vcomponent/load.scm | 38 |
4 files changed, 44 insertions, 29 deletions
diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm index 99253160..92d0d31c 100644 --- a/module/entry-points/ical.scm +++ b/module/entry-points/ical.scm @@ -2,7 +2,7 @@ :export (main) :use-module (util) :use-module (output ical) - :use-module ((vcomponent) :select (load-calendars)) + :use-module ((vcomponent) :select (load-calendars*)) :use-module ((parameters) :select (calendar-files)) :use-module (ice-9 getopt-long) :use-module (srfi srfi-19) @@ -21,10 +21,10 @@ (define end (cond [(option-ref opts 'to #f) => parse-freeform-date] [else (normalize-date* (set (date-month start) = (+ 1)))])) - (define-values (calendars events) - (load-calendars - calendar-files: (cond [(option-ref opts 'file #f) => list] - [else (calendar-files)]) )) + ;; TODO this contains repeated events multiple times + (define-values (calendars regular repeating) + (load-calendars* calendar-files: (cond [(option-ref opts 'file #f) => list] + [else (calendar-files)]) )) - (ical-main calendars events start end) + (ical-main calendars regular repeating start end) ) diff --git a/module/output/ical.scm b/module/output/ical.scm index 146afc8c..d2f5800c 100644 --- a/module/output/ical.scm +++ b/module/output/ical.scm @@ -98,7 +98,8 @@ CALSCALE:GREGORIAN\r (define (print-footer) (format #t "END:VCALENDAR\r\n")) -(define-public (ical-main calendars events start end) +;; list x list x list x time x time → +(define-public (ical-main calendars regular-events repeating-events start end) (print-header) (let ((tzs (make-hash-table))) @@ -109,11 +110,16 @@ CALSCALE:GREGORIAN\r (hash-for-each (lambda (key component) (component->ical-string component)) tzs)) - ;; TODO this contains repeated events multiple times - (stream-for-each + ;; TODO add support for running without a range limiter, emiting all objects. + (for-each component->ical-string - (filter-sorted-stream (lambda (ev) ((in-date-range? start end) - (time-utc->date (attr ev 'DTSTART)))) - events)) + (filter-sorted (lambda (ev) ((in-date-range? start end) + (time-utc->date (attr ev 'DTSTART)))) + regular-events)) + + ;; TODO RECCURENCE-ID exceptions + ;; We just dump all repeating objects, since it's much cheaper to do it this way than + ;; to actually figure out which are applicable for the given date range. + (for-each component->ical-string repeating-events) (print-footer)) diff --git a/module/vcomponent.scm b/module/vcomponent.scm index f40756e2..32406f0a 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -3,7 +3,8 @@ :use-module (vcomponent parse) :use-module (vcomponent load) :use-module (util) - :re-export (make-vcomponent parse-cal-path - parse-calendar load-calendars)) + :re-export (make-vcomponent + parse-cal-path parse-calendar + load-calendars load-calendars*)) (re-export-modules (vcomponent base)) diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm index fb25732d..2d339c64 100644 --- a/module/vcomponent/load.scm +++ b/module/vcomponent/load.scm @@ -1,5 +1,5 @@ (define-module (vcomponent load) - :export (load-calendars) + :export (load-calendars load-calendars*) :use-module (util) :use-module (srfi srfi-1) :use-module (srfi srfi-19) @@ -13,12 +13,23 @@ :use-module ((vcomponent datetime) :select (ev-time<?))) -;; Reads all calendar files from disk, and creates a list of "regular" events, -;; and a stream of "repeating" events, which are passed in that order to the -;; given procedure @var{proc}. -;; -;; Given as a sepparate function from main to ease debugging. +;; Reads all calendar files from disk, generate recurence-sets for all repeating events, +;; and returns a list of calendars, and a stream of all events "ready" for display. (define* (load-calendars #:key (calendar-files (calendar-files))) + (let* ((calendars regular repeating (load-calendars* calendar-files: calendar-files))) + (values + calendars + (interleave-streams + ev-time<? + (cons (list->stream regular) + (map generate-recurrence-set repeating)))))) + +;; Basic version, loads calendrs, sorts the events, and returns +;; regular and repeating events separated from each other. +;; +;; (list string) → (list calendar), (list event), (list event) +(define* (load-calendars* #:key (calendar-files (calendar-files))) + (define calendars (map parse-cal-path calendar-files)) (define events (concatenate ;; TODO does this drop events? @@ -28,12 +39,9 @@ (let* ((repeating regular (partition repeating? events))) - (set! repeating (sort*! repeating time<? (extract 'DTSTART)) - regular (sort*! regular time<? (extract 'DTSTART))) - - (values - calendars - (interleave-streams - ev-time<? - (cons (list->stream regular) - (map generate-recurrence-set repeating)))))) + ;; NOTE There might be instances where we don't care if the + ;; collection if sorted, but for the time beieng it's much + ;; easier to always sort it. + (values calendars + (sort*! regular time<? (extract 'DTSTART)) + (sort*! repeating time<? (extract 'DTSTART))))) |