Move <events> methods to own module for easier loading.

8 files changed, 168 insertions, 160 deletions

diff --git a/module/entry-points/import.scm b/module/entry-points/import.scm
index 9e8e3d7b..956ccc91 100644
--- a/module/entry-points/import.scm
+++ b/module/entry-points/import.scm
@@ -4,10 +4,10 @@
   :use-module (util options)
   :use-module (ice-9 getopt-long)
   :use-module (ice-9 rdelim)
-  :use-module (vcomponent)
   :use-module (srfi srfi-1)
   :use-module (output vdir)
-  :autoload (vcomponent instance) (get-calendars global-event-object)
+  :use-module (vcomponent)
+  :autoload (vcomponent instance) (global-event-object)
   )
 
 (define options
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
index 824770af..7fa6ceb0 100644
--- a/module/entry-points/server.scm
+++ b/module/entry-points/server.scm
@@ -33,7 +33,7 @@
   :use-module (output html)
   :use-module (output ical)
 
-  :autoload (vcomponent instance) (get-calendars global-event-object)
+  :autoload (vcomponent instance) (global-event-object)
 
   :export (main)
   )
@@ -113,12 +113,12 @@
            (return (build-response code: 400)
                    "uid required"))
 
-         (aif (get-event-by-uid uid)
+         (aif (get-event-by-uid global-event-object uid)
               (begin
                 ;; It's hard to properly remove a file. I also want a way to undo accidental
                 ;; deletions. Therefore I simply save the X-HNH-REMOVED flag to the file, and
                 ;; then simple don't use those events when loading.
-                (catch 'stack-overflow (lambda () (remove-event it))
+                (catch 'stack-overflow (lambda () (remove-event global-event-object it))
                   (lambda _
                     (display "It overflew...\n" (current-error-port))
                     (return (build-response code: 500)
@@ -240,7 +240,7 @@
                         (print-all-events))))))
 
    (GET "/calendar/:uid{.*}.xcs" (uid)
-        (aif (get-event-by-uid uid)
+        (aif (get-event-by-uid global-event-object uid)
              (return '((content-type application/calendar+xml))
                      ;; TODO sxml->xml takes a port, would be better
                      ;; to give it the return port imidiately.
@@ -256,7 +256,7 @@
                      (format #f "No component with UID=~a found." uid))))
 
    (GET "/calendar/:uid{.*}.ics" (uid)
-        (aif (get-event-by-uid uid)
+        (aif (get-event-by-uid global-event-object uid)
              (return '((content-type text/calendar))
                      (with-output-to-string
                        (lambda () (print-components-with-fake-parent
diff --git a/module/output/html.scm b/module/output/html.scm
index d2addd5a..167ae78d 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -19,7 +19,7 @@
   #:use-module (text util)
   #:use-module (vcomponent datetime output)
 
-  #:autoload (vcomponent instance) (#|get-calendars get-event-set|# global-event-object)
+  #:autoload (vcomponent instance) (global-event-object)
 
   #:use-module (git)
   ;; #:use-module (module config all)
diff --git a/module/output/ical.scm b/module/output/ical.scm
index 94622e2f..a9d325f8 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -15,7 +15,7 @@
   :use-module (vcomponent geo)
   :use-module (output types)
   :use-module (output common)
-  :autoload (vcomponent instance) (#|get-calendars get-event-set|# global-event-object)
+  :autoload (vcomponent instance) (global-event-object)
   :autoload (datetime instance) (zoneinfo)
   )
 
@@ -228,7 +228,7 @@ CALSCALE:GREGORIAN\r
            ;; 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.
-           (get-repeating-events global-even-object))))
+           (get-repeating-events global-event-object))))
 
 (define-public (print-events-in-interval start end)
   (print-components-with-fake-parent
diff --git a/module/output/terminal.scm b/module/output/terminal.scm
index b8c1b4ac..1d88015a 100644
--- a/module/output/terminal.scm
+++ b/module/output/terminal.scm
@@ -29,7 +29,7 @@
   #:use-module (oop goops)
   #:use-module (oop goops describe)
 
-  #:autoload (vcomponent instance) (#|get-calendars get-event-set|# global-event-object)
+  #:autoload (vcomponent instance) (global-event-object)
 
   #:export (main-loop))
 
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index bcadbd97..1272cea1 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -3,10 +3,12 @@
   :use-module (util config)
   :use-module (vcomponent base)
   :use-module (vcomponent parse)
+  :use-module (vcomponent instance methods)
   :re-export (make-vcomponent
               parse-cal-path parse-calendar))
 
-(re-export-modules (vcomponent base))
+(re-export-modules (vcomponent base)
+                   (vcomponent instance methods))
 
 (define-config calendar-files '()
   "Which files to parse. Takes a list of paths or a single string which will be globbed."
diff --git a/module/vcomponent/instance.scm b/module/vcomponent/instance.scm
index 575aeda0..a53cd3b3 100644
--- a/module/vcomponent/instance.scm
+++ b/module/vcomponent/instance.scm
@@ -1,158 +1,16 @@
 (define-module (vcomponent instance)
   :use-module (util)
-  :use-module (util config)
-  :use-module (srfi srfi-1)
-  :use-module (srfi srfi-41)
-  :use-module (srfi srfi-41 util)
-  :use-module (datetime)
-  :use-module (vcomponent base)
-  :use-module (vcomponent parse)
-  :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?))
-  :use-module ((vcomponent datetime) :select (ev-time<?))
-  :use-module (oop goops)
-  :export (add-event remove-event
+  :use-module ((util config) :select (get-config))
+  :use-module ((oop goops) :select (make))
+  :export (global-event-object)
+)
 
-                     global-event-object
-
-                     get-event-by-uid
-                     fixed-events-in-range
-
-                     get-event-set get-calendars
-                     get-fixed-events get-repeating-events
-                     ))
-
-(define-public (load-calendars calendar-files)
-  (map parse-cal-path calendar-files))
 
 
 
 
-;;; TODO both add- and remove-event sometimes crash with
-;;;;; Warning: Unwind-only `stack-overflow' exception; skipping pre-unwind handler.
-;;; I belive this is due to how getf and setf work.
-
-
-
-;; == vcomponent ==
-;; - calendar
-;; - events
-;; - repeating-events
-;; - fixed-events
-;; - event-set
-;; - uid-map
-
-
-
-(define-class <events> ()
-  (calendar-files init-keyword: calendar-files:)
-  (calendars getter: get-calendars)
-  (events getter: get-events)
-  (repeating-events getter: get-repeating-events)
-  (fixed-events getter: get-fixed-events)
-  (event-set getter: get-event-set)
-  uid-map
-  )
-
-
-(define (get-event-by-uid uid)
-  (hash-ref (slot-ref global-event-object 'uid-map) uid))
-
-
-
-(define-method (fixed-events-in-range (this <events>) start end)
-  (filter-sorted (lambda (ev) ((in-date-range? start end)
-                          (as-date (prop ev 'DTSTART))))
-                 (slot-ref this 'fixed-events)))
-
-
-(define-method (initialize (this <events>) args)
-  (next-method)
-
-  (format (current-error-port) "Building <events> from ~a~%"
-          (slot-ref this 'calendar-files))
-
-  (slot-set! this 'calendars (load-calendars (slot-ref this 'calendar-files)))
-
-  (slot-set! this 'events
-             (concatenate
-              (map (lambda (cal) (remove
-                             (extract 'X-HNH-REMOVED)
-                             (filter (lambda (o) (eq? 'VEVENT (type o)))
-                                     (children cal))))
-                   (slot-ref this 'calendars))))
-
-  (let* ((repeating regular (partition repeating? (slot-ref this 'events))))
-    (slot-set! this 'fixed-events     (sort*! regular   date/-time<? (extract 'DTSTART)))
-    (slot-set! this 'repeating-events (sort*! repeating date/-time<? (extract 'DTSTART))))
-
-
-  (slot-set! this 'event-set
-             (interleave-streams
-              ev-time<?
-              (cons (list->stream (slot-ref this 'fixed-events))
-                    (map generate-recurrence-set (slot-ref this 'repeating-events)))))
-
-  (slot-set! this 'uid-map
-             (let ((ht (make-hash-table)))
-               (for-each (lambda (event) (hash-set! ht (prop event 'UID) event))
-                         (slot-ref this 'events))
-               ht)))
-
-;;; TODO what should happen when an event with that UID already exists
-;;; in the calendar? Fail? Overwrite? Currently it adds a second element
-;;; with the same UID, which is BAD.
-(define-method (add-event (this <events>) calendar event)
-
-  (add-child! calendar event)
-  (unless (prop event 'UID)
-    (set! (prop event 'UID) (uuidgen)))
-
-
-
-
-  (slot-set! this 'events
-             (cons event (slot-ref this 'events)))
-
-  (let* ((slot-name (if (repeating? event) 'repeating-events 'fixed-events))
-         (events (slot-ref this slot-name)))
-    (slot-set! this slot-name (insert-ordered event events ev-time<?)))
-
-  (slot-set! this 'event-set
-             (interleave-streams
-              ev-time<?
-              (list (if (repeating? event)
-                        (generate-recurrence-set event)
-                        (stream event))
-                    (slot-ref this 'event-set))))
-
-  (hash-set! (slot-ref this 'uid-map) (prop event 'UID)
-             event)
-
-  (prop event 'UID))
-
-
-
-
-(define-method (remove-event (this <events>) event)
-  (slot-set! this 'events (delete event (slot-ref this 'events)))
-
-  (let ((slot-name (if (repeating? event) 'repeating-events 'fixed-events)))
-    (slot-set! this slot-name
-               (delete event (slot-ref this slot-name))))
-
-  (slot-set! this 'event-set
-             (stream-remove
-              (lambda (ev)
-                (equal? (prop ev 'UID)
-                        (prop event 'UID)))
-              (slot-ref this 'event-set)))
-
-  (hash-set! (slot-ref this 'uid-map) (prop event 'UID)
-             #f))
-
-
-
 ;; this is loaded on compile, meaning that Guile's auto-compiler may
 ;; evaluate this to early.
 (define-once global-event-object
-  (make <events> calendar-files: (get-config 'calendar-files)))
+  (make (@@ (vcomponent instance methods) <events>)
+    calendar-files: (get-config 'calendar-files)))
diff --git a/module/vcomponent/instance/methods.scm b/module/vcomponent/instance/methods.scm
new file mode 100644
index 00000000..49cc3ed2
--- /dev/null
+++ b/module/vcomponent/instance/methods.scm
@@ -0,0 +1,148 @@
+(define-module (vcomponent instance methods)
+  :use-module (util)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-41)
+  :use-module (srfi srfi-41 util)
+  :use-module (datetime)
+  :use-module (vcomponent base)
+  :use-module (vcomponent parse)
+  :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?))
+  :use-module ((vcomponent datetime) :select (ev-time<?))
+  :use-module (oop goops)
+
+  :export (add-event
+           remove-event
+
+           get-event-by-uid
+           fixed-events-in-range
+
+           get-event-set get-calendars
+           get-fixed-events get-repeating-events
+           ))
+
+(define-public (load-calendars calendar-files)
+  (map parse-cal-path calendar-files))
+
+;;; TODO both add- and remove-event sometimes crash with
+;;;;; Warning: Unwind-only `stack-overflow' exception; skipping pre-unwind handler.
+;;; I belive this is due to how getf and setf work.
+
+
+
+;; == vcomponent ==
+;; - calendar
+;; - events
+;; - repeating-events
+;; - fixed-events
+;; - event-set
+;; - uid-map
+
+
+
+(define-class <events> ()
+  (calendar-files init-keyword: calendar-files:)
+  (calendars getter: get-calendars)
+  (events getter: get-events)
+  (repeating-events getter: get-repeating-events)
+  (fixed-events getter: get-fixed-events)
+  (event-set getter: get-event-set)
+  uid-map
+  )
+
+
+(define-method (get-event-by-uid (this <events>) uid)
+  (hash-ref (slot-ref this 'uid-map) uid))
+
+
+
+(define-method (fixed-events-in-range (this <events>) start end)
+  (filter-sorted (lambda (ev) ((in-date-range? start end)
+                          (as-date (prop ev 'DTSTART))))
+                 (slot-ref this 'fixed-events)))
+
+
+(define-method (initialize (this <events>) args)
+  (next-method)
+
+  (format (current-error-port) "Building <events> from ~a~%"
+          (slot-ref this 'calendar-files))
+
+  (slot-set! this 'calendars (load-calendars (slot-ref this 'calendar-files)))
+
+  (slot-set! this 'events
+             (concatenate
+              (map (lambda (cal) (remove
+                             (extract 'X-HNH-REMOVED)
+                             (filter (lambda (o) (eq? 'VEVENT (type o)))
+                                     (children cal))))
+                   (slot-ref this 'calendars))))
+
+  (let* ((repeating regular (partition repeating? (slot-ref this 'events))))
+    (slot-set! this 'fixed-events     (sort*! regular   date/-time<? (extract 'DTSTART)))
+    (slot-set! this 'repeating-events (sort*! repeating date/-time<? (extract 'DTSTART))))
+
+
+  (slot-set! this 'event-set
+             (interleave-streams
+              ev-time<?
+              (cons (list->stream (slot-ref this 'fixed-events))
+                    (map generate-recurrence-set (slot-ref this 'repeating-events)))))
+
+  (slot-set! this 'uid-map
+             (let ((ht (make-hash-table)))
+               (for-each (lambda (event) (hash-set! ht (prop event 'UID) event))
+                         (slot-ref this 'events))
+               ht)))
+
+;;; TODO what should happen when an event with that UID already exists
+;;; in the calendar? Fail? Overwrite? Currently it adds a second element
+;;; with the same UID, which is BAD.
+(define-method (add-event (this <events>) calendar event)
+
+  (add-child! calendar event)
+  (unless (prop event 'UID)
+    (set! (prop event 'UID) (uuidgen)))
+
+
+
+
+  (slot-set! this 'events
+             (cons event (slot-ref this 'events)))
+
+  (let* ((slot-name (if (repeating? event) 'repeating-events 'fixed-events))
+         (events (slot-ref this slot-name)))
+    (slot-set! this slot-name (insert-ordered event events ev-time<?)))
+
+  (slot-set! this 'event-set
+             (interleave-streams
+              ev-time<?
+              (list (if (repeating? event)
+                        (generate-recurrence-set event)
+                        (stream event))
+                    (slot-ref this 'event-set))))
+
+  (hash-set! (slot-ref this 'uid-map) (prop event 'UID)
+             event)
+
+  (prop event 'UID))
+
+
+
+
+(define-method (remove-event (this <events>) event)
+  (slot-set! this 'events (delete event (slot-ref this 'events)))
+
+  (let ((slot-name (if (repeating? event) 'repeating-events 'fixed-events)))
+    (slot-set! this slot-name
+               (delete event (slot-ref this slot-name))))
+
+  (slot-set! this 'event-set
+             (stream-remove
+              (lambda (ev)
+                (equal? (prop ev 'UID)
+                        (prop event 'UID)))
+              (slot-ref this 'event-set)))
+
+  (hash-set! (slot-ref this 'uid-map) (prop event 'UID)
+             #f))
+