MOORE

3 files changed, 159 insertions, 97 deletions

diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm
index 67d66b02..290a8d3e 100644
--- a/module/vcomponent/parse.scm
+++ b/module/vcomponent/parse.scm
@@ -1,107 +1,13 @@
-;;; Commentary:
-;; Code for parsing vdir's and icalendar files.
-;; This module handles the finding of files, while
-;; (vcomponent parse ical) handles reading data from icalendar files.
-;;; Code:
-
 (define-module (vcomponent parse)
-  :use-module (srfi srfi-1)
-
-  :use-module ((ice-9 hash-table) :select (alist->hash-table))
-  :use-module ((ice-9 rdelim) :select (read-line))
-  :use-module ((ice-9 ftw) :select (scandir ftw))
-
   :use-module (util)
-  :use-module (util time)
-  :use-module (util exceptions)
   :use-module (vcomponent base)
+  :use-module ((vcomponent vdir parse) :select (parse-vdir))
+  :use-module ((util time) :select (report-time!))
 
   :use-module (vcomponent ical parse)
   :re-export (parse-calendar)
   )
 
-
-
-
-;; All VTIMEZONE's seem to be in "local" time in relation to
-;; themselves. Therefore, a simple comparison should work,
-;; and then the TZOFFSETTO properties can be subtd.
-(define (parse-vdir path)
-  (let ((/ (lambda args (string-join args file-name-separator-string 'infix))))
-    (let ((color
-           (catch 'system-error
-             (lambda () (call-with-input-file (/ path "color") read-line))
-             (const "#FFFFFF")))
-          (name
-           (catch 'system-error
-             (lambda () (call-with-input-file (/ path "displayname") read-line))
-             (const #f))))
-
-      (reduce (lambda (item calendar)
-
-                (define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e)))
-                                                         (children item)))
-
-
-                ;; (assert (eq? 'VCALENDAR (type calendar)))
-                (assert (eq? 'VCALENDAR (type item)))
-
-                (for child in (children item)
-                     (set! (prop child '-X-HNH-FILENAME)
-                       (prop (parent child) '-X-HNH-FILENAME)))
-
-                ;; NOTE The vdir standard says that each file should contain
-                ;; EXACTLY one event. It can however contain multiple VEVENT
-                ;; components, but they are still the same event.
-                ;; In our case this means exceptions to reccurence rules, which
-                ;; is set up here, and then later handled in rrule-generate.
-                ;; NOTE These events also share UID, but are diferentiated
-                ;; by RECURRENCE-ID. As far as I can tell this goes against
-                ;; the standard. Section 3.8.4.4.
-                (case (length events)
-                  [(0) (warning "No events in component~%~a"
-                           (prop item '-X-HNH-FILENAME))]
-                  [(1)
-                   (let ((child (car events)))
-                    (assert (memv (type child) '(VTIMEZONE VEVENT)))
-                    (add-child! calendar child))]
-
-                  ;; two or more
-                  [else
-
-                   ;; Sorting on SEQUENCE here would have been nice.
-                   ;; But the patches can apparently share a sequence number
-                   ;; of 0 with the original event!
-                   ;; (╯°□°）╯ ┻━┻
-                   (let* ((head (find (negate (extract 'RECURRENCE-ID))
-                                      events))
-                          (rest (delete head events eq?)))
-
-                     (set! (prop head '-X-HNH-ALTERNATIVES)
-                       (alist->hash-table
-                        (map cons
-                             (map (extract 'RECURRENCE-ID) rest)
-                             rest))
-                       #;
-                       (sort*! rest ;; HERE
-                               date/-time< (extract 'RECURRENCE-ID)))
-                     (add-child! calendar head))])
-
-                ;; return
-                calendar)
-              (make-vcomponent)
-              (map #; (@ (ice-9 threads) par-map)
-               (lambda (fname)
-                 (let ((fullname (/ path fname)))
-                   (let ((cal (call-with-input-file fullname
-                                parse-calendar)))
-                     (set! (prop cal 'COLOR) color
-                           (prop cal 'NAME) name
-                           (prop cal '-X-HNH-FILENAME) fullname)
-                     cal)))
-               (scandir path (lambda (s) (and (not (string= "." (string-take s 1)))
-                                         (string= "ics" (string-take-right s 3))))))))))
-
 ;; Parse a vdir or ics file at the given path.
 (define-public (parse-cal-path path)
   ;; TODO check (access? path R_OK) ?
@@ -127,4 +33,3 @@
           (string-append "[" (basename path) "]"))))
 
   cal)
-
diff --git a/module/vcomponent/vdir/parse.scm b/module/vcomponent/vdir/parse.scm
new file mode 100644
index 00000000..ae4ea692
--- /dev/null
+++ b/module/vcomponent/vdir/parse.scm
@@ -0,0 +1,102 @@
+;;; Commentary:
+;; Code for parsing vdir's and icalendar files.
+;; This module handles the finding of files, while
+;; (vcomponent parse ical) handles reading data from icalendar files.
+;;; Code:
+
+(define-module (vcomponent parse)
+  :use-module (srfi srfi-1)
+
+  :use-module ((ice-9 hash-table) :select (alist->hash-table))
+  :use-module ((ice-9 rdelim) :select (read-line))
+  :use-module ((ice-9 ftw) :select (scandir ftw))
+
+  :use-module (util)
+  :use-module (util exceptions)
+  :use-module (vcomponent base)
+
+  :use-module (vcomponent ical parse)
+  )
+
+
+
+
+;; All VTIMEZONE's seem to be in "local" time in relation to
+;; themselves. Therefore, a simple comparison should work,
+;; and then the TZOFFSETTO properties can be subtd.
+(define (parse-vdir path)
+  (let ((/ (lambda args (string-join args file-name-separator-string 'infix))))
+    (let ((color
+           (catch 'system-error
+             (lambda () (call-with-input-file (/ path "color") read-line))
+             (const "#FFFFFF")))
+          (name
+           (catch 'system-error
+             (lambda () (call-with-input-file (/ path "displayname") read-line))
+             (const #f))))
+
+      (reduce (lambda (item calendar)
+
+                (define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e)))
+                                                         (children item)))
+
+
+                ;; (assert (eq? 'VCALENDAR (type calendar)))
+                (assert (eq? 'VCALENDAR (type item)))
+
+                (for child in (children item)
+                     (set! (prop child '-X-HNH-FILENAME)
+                       (prop (parent child) '-X-HNH-FILENAME)))
+
+                ;; NOTE The vdir standard says that each file should contain
+                ;; EXACTLY one event. It can however contain multiple VEVENT
+                ;; components, but they are still the same event.
+                ;; In our case this means exceptions to reccurence rules, which
+                ;; is set up here, and then later handled in rrule-generate.
+                ;; NOTE These events also share UID, but are diferentiated
+                ;; by RECURRENCE-ID. As far as I can tell this goes against
+                ;; the standard. Section 3.8.4.4.
+                (case (length events)
+                  [(0) (warning "No events in component~%~a"
+                           (prop item '-X-HNH-FILENAME))]
+                  [(1)
+                   (let ((child (car events)))
+                    (assert (memv (type child) '(VTIMEZONE VEVENT)))
+                    (add-child! calendar child))]
+
+                  ;; two or more
+                  [else
+
+                   ;; Sorting on SEQUENCE here would have been nice.
+                   ;; But the patches can apparently share a sequence number
+                   ;; of 0 with the original event!
+                   ;; (╯°□°）╯ ┻━┻
+                   (let* ((head (find (negate (extract 'RECURRENCE-ID))
+                                      events))
+                          (rest (delete head events eq?)))
+
+                     (set! (prop head '-X-HNH-ALTERNATIVES)
+                       (alist->hash-table
+                        (map cons
+                             (map (extract 'RECURRENCE-ID) rest)
+                             rest))
+                       #;
+                       (sort*! rest ;; HERE
+                               date/-time< (extract 'RECURRENCE-ID)))
+                     (add-child! calendar head))])
+
+                ;; return
+                calendar)
+              (make-vcomponent)
+              (map #; (@ (ice-9 threads) par-map)
+               (lambda (fname)
+                 (let ((fullname (/ path fname)))
+                   (let ((cal (call-with-input-file fullname
+                                parse-calendar)))
+                     (set! (prop cal 'COLOR) color
+                           (prop cal 'NAME) name
+                           (prop cal '-X-HNH-FILENAME) fullname)
+                     cal)))
+               (scandir path (lambda (s) (and (not (string= "." (string-take s 1)))
+                                         (string= "ics" (string-take-right s 3))))))))))
+
diff --git a/module/vcomponent/vdir/save-delete.scm b/module/vcomponent/vdir/save-delete.scm
new file mode 100644
index 00000000..02db9d7a
--- /dev/null
+++ b/module/vcomponent/vdir/save-delete.scm
@@ -0,0 +1,55 @@
+;;; Commentary:
+;;; Module for writing components to the vdir storage format.
+;;; Currently also has some cases for "big" icalendar files,
+;;; but those are currently unsupported.
+
+;;; TODO generalize save-event and remove-event into a general interface,
+;;; which different database backends can implement. Actually, do that for all
+;;; loading and writing.
+
+;;; Code:
+
+(define-module (vcomponent vdir save-delete)
+  :use-module (util)
+  :use-module (vcomponent ical output)
+  :use-module (vcomponent)
+  :use-module ((util io) :select (with-atomic-output-to-file))
+  )
+
+
+(define / file-name-separator-string)
+
+(define-public (save-event event)
+  (define calendar (parent event))
+  (case (prop calendar '-X-HNH-SOURCETYPE)
+    [(file)
+     (error "Importing into direct calendar files not supported")]
+
+    [(vdir)
+     (let* ((uid (or (prop event 'UID) (uuidgen))))
+       (set! (prop event 'UID) uid
+             ;; TODO use existing filename if present?
+             (prop event '-X-HNH-FILENAME) (string-append
+                                            (prop calendar '-X-HNH-DIRECTORY)
+                                            / uid ".ics"))
+       (with-atomic-output-to-file (prop event '-X-HNH-FILENAME)
+        (lambda () (print-components-with-fake-parent (list event))))
+       uid)]
+
+    [else
+     (error "Source of calendar unknown, aborting.")
+     ]))
+
+
+(define-public (remove-event event)
+  (define calendar (parent event))
+  (case (prop calendar '-X-HNH-SOURCETYPE)
+    [(file)
+     (error "Removing events from large files unsupported")]
+
+    [(vdir)
+     (delete-file (prop event '-X-HNH-FILENAME))]
+
+    [else
+     (error "Source of calendar unknown, aborting.")
+     ]))