From 68647d3c1aa8130df878223638bc54c5d332cc5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 3 Aug 2020 00:58:40 +0200 Subject: Move methods to own module for easier loading. --- module/entry-points/import.scm | 4 +- module/entry-points/server.scm | 10 +-- module/output/html.scm | 2 +- module/output/ical.scm | 4 +- module/output/terminal.scm | 2 +- module/vcomponent.scm | 4 +- module/vcomponent/instance.scm | 154 ++------------------------------- module/vcomponent/instance/methods.scm | 148 +++++++++++++++++++++++++++++++ 8 files changed, 168 insertions(+), 160 deletions(-) create mode 100644 module/vcomponent/instance/methods.scm 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 () - (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 ) 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 ) args) - (next-method) - - (format (current-error-port) "Building 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/-timestream (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 ) 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) 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 calendar-files: (get-config 'calendar-files))) + (make (@@ (vcomponent instance methods) ) + 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 () + (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 ) uid) + (hash-ref (slot-ref this 'uid-map) uid)) + + + +(define-method (fixed-events-in-range (this ) 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 ) args) + (next-method) + + (format (current-error-port) "Building 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/-timestream (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 ) 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) 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)) + -- cgit v1.2.3