From f82286eabe54ad58dc32df81fd3dcbb4e2bb2e65 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 23 Feb 2023 03:22:34 +0100 Subject: Put base for new store-load interface. --- doc/ref/guile.texi | 1 + doc/ref/guile/save-load.texi | 63 +++++++++++ module/vcomponent/data-stores/common.scm | 26 +++++ module/vcomponent/data-stores/file.scm | 4 + module/vcomponent/data-stores/sqlite.scm | 180 ++++++++++++++++++++++++++++++ module/vcomponent/data-stores/vdir.scm | 17 +++ module/vcomponent/formats/ical.scm | 18 +++ module/vcomponent/formats/xcal.scm | 20 ++++ module/vcomponent/util/parse-cal-path.scm | 2 + 9 files changed, 331 insertions(+) create mode 100644 doc/ref/guile/save-load.texi create mode 100644 module/vcomponent/data-stores/common.scm create mode 100644 module/vcomponent/data-stores/file.scm create mode 100644 module/vcomponent/data-stores/sqlite.scm create mode 100644 module/vcomponent/data-stores/vdir.scm create mode 100644 module/vcomponent/formats/ical.scm create mode 100644 module/vcomponent/formats/xcal.scm diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index 970e8dee..95f593a7 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -1,6 +1,7 @@ @node Guile @chapter Guile +@include guile/save-load.texi @include guile/datetime.texi @include guile/zic.texi @include guile/srfi-41.texi diff --git a/doc/ref/guile/save-load.texi b/doc/ref/guile/save-load.texi new file mode 100644 index 00000000..f7d63ca6 --- /dev/null +++ b/doc/ref/guile/save-load.texi @@ -0,0 +1,63 @@ +@node Saving and Loading +@section Saving and Loading + +@subsection Data Formats +A data format is some way that an individual event may get serialized +to disk. The default is iCalendar (TODO reference RFC 5545), but +others might be available (TODO footnote and reference xcal). + +Each available format should be included as +@code{(vcomponent formats @var{format-name})}. +Which module corresponds to what file type is currently defined out of band. + +Each module should expose the following procedures. + +@deffn serialize component port +Write a serialized representation of @var{component} to @var{port}. +@end deffn + +@deffn deserialize port +Read a serialized representation of a component from @var{port}, and +return the deserialized instance of this object. +@end deffn + +@subsubsection iCalendar +RFC 5545 + +@subsubsection xCal + +@subsection Data Stores +Data stores are persistant stores for events, such as databases or the +file system. Each data store can support any number of data formats, +but which is an implementation detail of that format and shouldn't be +needed information from the high level view. +@footnote{It is however important for interoperability with other programs}. + +@c (make #:path ``hello'') + +@deffn path store +@end deffn + +@deffn get-calendar this +Returns a vcomponent object of type @code{VCALENDAR}. Should contain +all @code{VEVENT} components of this calendar. +@end deffn + +@deffn get-by-uid this uid +Return the event object with UID equal to the string @var{uid}. +@end deffn + +@deffn queue-save this event +Queue a save event of @var{event} to the store. +@end deffn + +@deffn flush this +Force write of all queued actions. +@end deffn + +@subsubsection VDir +[VDIR]: http://vdirsyncer.pimutils.org/en/latest/vdir.html + +@subsubsection File + +@subsubsection SQLite diff --git a/module/vcomponent/data-stores/common.scm b/module/vcomponent/data-stores/common.scm new file mode 100644 index 00000000..d6775141 --- /dev/null +++ b/module/vcomponent/data-stores/common.scm @@ -0,0 +1,26 @@ +(define-module (vcomponent data-stores common) + :use-module ((srfi srfi-88) :select ()) + :use-module (oop goops) + :export ( + path + get-all + get-by-uid)) + + +(define-class () + (path init-keyword: path: + getter: path) + ) + + +(define-method (get-all (this )) + (scm-error 'not-implemented "get-all" + "Get-all is not implemented for ~s" + (list (class-of this)) + #f)) + +(define-method (get-by-uid (this ) (uid )) + (scm-error 'not-implemented "get-by-uid" + "Get-by-uid is not implemented for ~s" + (list (class-of this)) + #f)) diff --git a/module/vcomponent/data-stores/file.scm b/module/vcomponent/data-stores/file.scm new file mode 100644 index 00000000..0f09d81c --- /dev/null +++ b/module/vcomponent/data-stores/file.scm @@ -0,0 +1,4 @@ +(define-module (vcomponent data-stores file) + :use-module (oop goops) + :use-module (vcomponent data-stores common) + ) diff --git a/module/vcomponent/data-stores/sqlite.scm b/module/vcomponent/data-stores/sqlite.scm new file mode 100644 index 00000000..f26cd688 --- /dev/null +++ b/module/vcomponent/data-stores/sqlite.scm @@ -0,0 +1,180 @@ +(define-module (vcomponent data-stores sqlite) + :use-module (sqlite3) + :use-module (oop goops) + :use-module (vcomponent data-stores common) + :use-module (srfi srfi-71) + :use-module ((srfi srfi-88) :select ()) + :use-module (vcomponent) + :use-module ((vcomponent formats ical) :prefix #{ical:}#) + :use-module ((hnh util) :select (aif)) + ) + +;; (define (sqlite-exec db str) +;; (display str) +;; ((@ (sqlite3) sqlite-exec) db str)) + +(define-class () + (database accessor: database) + (name init-keyword: name: getter: calendar-name) + ) + +(define (initialize-database db) + ;;; Setup Content type + + (sqlite-exec db " +CREATE TABLE IF NOT EXISTS content_type +( id INTEGER PRIMARY KEY AUTOINCREMENT +, name TEXT NOT NULL +)") + + (let ((stmt (sqlite-prepare db " +INSERT OR IGNORE INTO content_type +( name ) VALUES ( ? )"))) + (for-each (lambda (content-type) + (sqlite-reset stmt) + (sqlite-bind-arguments stmt ) + (sqlite-step stmt)) + '("ical" + "xcal" + "jcal"))) + + ;;; Setup calendar + + (sqlite-exec db " +CREATE TABLE IF NOT EXISTS calendar +( id INTEGER PRIMARY KEY AUTOINCREMENT +, name TEXT NOT NULL +)") + + (sqlite-exec db " +CREATE TABLE IF NOT EXISTS calendar_properties +( id INTEGER PRIMARY KEY AUTOINCREMENT +, calendar INTEGER NOT NULL +, key TEXT NOT NULL +, value TEXT NOT NULL +, FOREIGN KEY (calendar) REFERENCES calendar(id) +)") + + ;; INSERT INTO calendar_properties (id, key, value) + ;; VALUES ( (SELECT id FROM calendar WHERE name = 'Calendar') + ;; , 'color' + ;; , '#1E90FF') + + ;;; Setup event + + (sqlite-exec db " +CREATE TABLE IF NOT EXISTS event +( uid TEXT PRIMARY KEY +, content_type INTEGER NOT NULL +, content TEXT NOT NULL +, calendar INTEGER NOT NULL +, FOREIGN KEY (content_type) REFERENCES content_type(id) +, FOREIGN KEY (calendar) REFERENCES calendar(id) +)") + + (sqlite-exec db " +CREATE TABLE IF NOT EXISTS event_instances +( id INTEGER PRIMARY KEY AUTOINCREMENT +, event TEXT NOT NULL +, start DATETIME NOT NULL +, end DATETIME +, FOREIGN KEY (event) REFERENCES event(uid) +)") + + (sqlite-exec db " +CREATE TABLE IF NOT EXISTS event_instances_valid_range +( start DATETIME NOT NULL +, end DATETIME NOT NULL +)") + ) + +(define-method (initialize (this ) args) + (next-method) + (if (calendar-name this) + (set! (database this) (sqlite-open (path this))) + (let ((path db-name + (aif (string-rindex (path this) #\#) + (values (substring (path this) 0 it) + (substring (path this) (1+ it))) + (scm-error 'misc-error "(initialize )" + "Target calendar name not specified" + '() #f)))) + (set! (database this) (sqlite-open path)) + (slot-set! this 'name db-name))) + + (initialize-database (database this))) + + +(define-method (get-calendar (this )) + (let ((db (database this)) + (calendar (make-vcomponent 'VCALENDAR))) + (let ((stmt (sqlite-prepare db " +SELECT key, value FROM calendar_properties cp +LEFT JOIN calendar c ON cp.calendar = c.id +WHERE c.name = ? +"))) + (sqlite-bind-arguments stmt (calendar-name this)) + (sqlite-fold (lambda (row calendar) + (let ((key (vector-ref row 0)) + (value (vector-ref row 1))) + (set-property! calendar + (string->symbol key) + value)) + calendar) + calendar + stmt)) + + (let ((stmt (sqlite-prepare db " +SELECT content_type.name, content +FROM event +LEFT JOIN calendar ON event.calendar = calendar.id +LEFT JOIN content_type ON event.content_type = content_type.id +WHERE calendar.name = ? +"))) + (sqlite-bind-arguments stmt (calendar-name this)) + (sqlite-fold (lambda (row calendar) + (case (string->symbol (vector-ref row 0)) + ((ical) + (add-child! calendar + (call-with-input-string (vector-ref row 1) + ics:deserialize)) + calendar) + (else + (scm-error 'misc-error "(get-calendar )" + "Only iCal data supported, got ~a" + (list (vector-ref row 0)) #f) + )) + ) + calendar + stmt)) + + calendar)) + + +#; +(define-method (get-by-uid (this ) (uid )) + (let ((stmt (sqlite-prepare db " +SELECT name, content +FROM event +LEFT JOIN content_type ON event.content_type = content_type.id +WHERE event.uid = ?"))) + (sqlite-bind-arguments stmt uid) + (cond ((sqlite-step stmt) + => (lambda (record) + (case (string->symbol (vector-ref content 0)) + ((ics) + ;; TODO dispatch to higher instance + ) + (else + (scm-error 'value-error "get-by-uid" + "Can only deserialize ics (uid=~s)" + (list uid) #f))) + + )) + (else + ;; TODO possibly throw no-such-value + #f + )) + + ) + ) diff --git a/module/vcomponent/data-stores/vdir.scm b/module/vcomponent/data-stores/vdir.scm new file mode 100644 index 00000000..fca59092 --- /dev/null +++ b/module/vcomponent/data-stores/vdir.scm @@ -0,0 +1,17 @@ +(define-module (vcomponent data-stores vdir) + :use-module (oop goops) + :use-module (vcomponent data-stores common) + :use-module ((srfi srfi-88) :select ()) + :export ()) + +(define-class () + ) + +(define-method (get-all (this )) + '()) + +(define-method (get-by-uid (this ) (uid )) + #f + ) + +;; (define (get-in-date-interval )) diff --git a/module/vcomponent/formats/ical.scm b/module/vcomponent/formats/ical.scm new file mode 100644 index 00000000..294642de --- /dev/null +++ b/module/vcomponent/formats/ical.scm @@ -0,0 +1,18 @@ +(define-module (vcomponent formats ical) + :use-module ((vcomponent formats ical output) + :select (component->ical-string)) + :use-module ((vcomponent formats ical parse) + :select (parse-calendar)) + :export (serialize + deserialize + ) + ) + + +(define (serialize component port) + (display (component->ical-string component) + port)) + +(define (deserialize port) + (parse-calendar port) + ) diff --git a/module/vcomponent/formats/xcal.scm b/module/vcomponent/formats/xcal.scm new file mode 100644 index 00000000..2732a5a7 --- /dev/null +++ b/module/vcomponent/formats/xcal.scm @@ -0,0 +1,20 @@ +(define-module (vcomponent formats xcal) + :use-module (sxml simple) + :use-module ((vcomponent formats xcal output) + :select (vcomponent->sxcal ns-wrap)) + :use-module ((vcomponent formats xcal parse) + :select (sxcal->vcomponent)) + :use-module ((hnh util) :select (->)) + :export (serialize deserialize)) + + +(define (serialize component port) + (-> (vcomponent->sxcal component) + ns-wrap + (sxml->xml port) + )) + + +(define (deserialize port) + (-> (xml->sxml port) + sxcal->vcomponent)) diff --git a/module/vcomponent/util/parse-cal-path.scm b/module/vcomponent/util/parse-cal-path.scm index 24eee04e..fe3a6b7d 100644 --- a/module/vcomponent/util/parse-cal-path.scm +++ b/module/vcomponent/util/parse-cal-path.scm @@ -1,3 +1,5 @@ +;;; TODO remove this module, it should be part of the vdir interface + (define-module (vcomponent util parse-cal-path) :use-module (hnh util) :use-module ((calp util time) :select (report-time!)) -- cgit v1.2.3