aboutsummaryrefslogtreecommitdiff
path: root/module/vcomponent/formats
diff options
context:
space:
mode:
Diffstat (limited to 'module/vcomponent/formats')
-rw-r--r--module/vcomponent/formats/common/types.scm3
-rw-r--r--module/vcomponent/formats/ical/parse.scm13
-rw-r--r--module/vcomponent/formats/vdir/parse.scm17
-rw-r--r--module/vcomponent/formats/vdir/save-delete.scm35
-rw-r--r--module/vcomponent/formats/xcal/parse.scm14
5 files changed, 53 insertions, 29 deletions
diff --git a/module/vcomponent/formats/common/types.scm b/module/vcomponent/formats/common/types.scm
index 9768cf70..9e18f1eb 100644
--- a/module/vcomponent/formats/common/types.scm
+++ b/module/vcomponent/formats/common/types.scm
@@ -137,4 +137,5 @@
(define-public (get-parser type)
(or (hashq-ref type-parsers type #f)
- (error (_ "No parser for type") type)))
+ (scm-error 'misc-error "get-parser" (_ "No parser for type ~a")
+ (list type) #f)))
diff --git a/module/vcomponent/formats/ical/parse.scm b/module/vcomponent/formats/ical/parse.scm
index 8b6cffeb..7f6c89cc 100644
--- a/module/vcomponent/formats/ical/parse.scm
+++ b/module/vcomponent/formats/ical/parse.scm
@@ -1,5 +1,6 @@
(define-module (vcomponent formats ical parse)
:use-module ((ice-9 rdelim) :select (read-line))
+ :use-module (ice-9 format)
:use-module (hnh util exceptions)
:use-module (hnh util)
:use-module (datetime)
@@ -121,7 +122,9 @@
(lambda (params value)
(let ((vv (parser params value)))
(when (list? vv)
- (throw 'parse-error (_ "List in enum field")))
+ (scm-error 'parse-error "enum-parser"
+ (_ "List in enum field")
+ #f #f))
(let ((v (string->symbol vv)))
(unless (memv v enum)
(warning "~a ∉ { ~{~a~^, ~} }"
@@ -193,7 +196,9 @@
DRAFT FINAL CANCELED))]
[(memv key '(REQUEST-STATUS))
- (throw 'parse-error (_ "TODO Implement REQUEST-STATUS"))]
+ (scm-error 'parse-error "build-vline"
+ (_ "TODO Implement REQUEST-STATUS")
+ #f #f)]
[(memv key '(ACTION))
(enum-parser '(AUDIO DISPLAY EMAIL
@@ -325,7 +330,7 @@
(set! (prop* (car stack) key) vline))))))
(loop (cdr lst) stack)])))
- (lambda (err fmt . args)
+ (lambda (err proc fmt fmt-args data)
(let ((linedata (get-metadata head*)))
(display (format
#f
@@ -339,7 +344,7 @@
line ~a ~a
Defaulting to string~%")
(get-string linedata)
- fmt args
+ fmt fmt-args
(get-line linedata)
(get-file linedata))
(current-error-port))
diff --git a/module/vcomponent/formats/vdir/parse.scm b/module/vcomponent/formats/vdir/parse.scm
index 4fc96e71..b21a5f2b 100644
--- a/module/vcomponent/formats/vdir/parse.scm
+++ b/module/vcomponent/formats/vdir/parse.scm
@@ -39,12 +39,16 @@
(reduce (lambda (item calendar)
- (define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e)))
- (children item)))
+ (define-values (events other)
+ (partition (lambda (e) (eq? 'VEVENT (type e)))
+ (children item)))
- ;; (assert (eq? 'VCALENDAR (type calendar)))
- (assert (eq? 'VCALENDAR (type item)))
+ (unless (eq? 'VCALENDAR (type item))
+ (scm-error 'misc-error "parse-vdir"
+ "Unexepected top level component. Expected VCALENDAR, got ~a. In file ~s"
+ (list (type item) (prop item '-X-HNH-FILENAME))
+ #f))
(for child in (children item)
(set! (prop child '-X-HNH-FILENAME)
@@ -61,10 +65,7 @@
(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))]
+ [(1) (add-child! calendar (car events))]
;; two or more
[else
diff --git a/module/vcomponent/formats/vdir/save-delete.scm b/module/vcomponent/formats/vdir/save-delete.scm
index 6068e34c..01d34f9f 100644
--- a/module/vcomponent/formats/vdir/save-delete.scm
+++ b/module/vcomponent/formats/vdir/save-delete.scm
@@ -11,8 +11,8 @@
(define-module (vcomponent formats vdir save-delete)
:use-module (hnh util)
+ :use-module (hnh util uuid)
:use-module ((hnh util path) :select (path-append))
- :use-module ((hnh util exceptions) :select (assert))
:use-module (vcomponent formats ical output)
:use-module (vcomponent)
:use-module ((hnh util io) :select (with-atomic-output-to-file))
@@ -22,14 +22,25 @@
(define-public (save-event event)
(define calendar (parent event))
- (assert (eq? 'vdir (prop calendar '-X-HNH-SOURCETYPE)))
-
- (let* ((uid (or (prop event 'UID) (uuidgen))))
- (set! (prop event 'UID) uid
- ;; TODO use existing filename if present?
- (prop event '-X-HNH-FILENAME) (path-append
- (prop calendar '-X-HNH-DIRECTORY)
- (string-append uid ".ics")))
+ (unless calendar
+ (scm-error 'wrong-type-arg "save-event"
+ (_ "Can only save events belonging to calendars, event uid = ~s")
+ (list (prop event 'UID))
+ #f))
+
+ (unless (eq? 'vdir (prop calendar '-X-HNH-SOURCETYPE))
+ (scm-error 'wrong-type-arg "save-event"
+ (_ "Can only save events belonging to vdir calendars. Calendar is of type ~s")
+ (list (prop calendar '-X-HNH-SOURCETYPE))
+ #f))
+
+ (let* ((uid (or (prop event 'UID) (uuid))))
+ (set! (prop event 'UID) uid)
+ (unless (prop event 'X-HNH-FILENAME)
+ (set! (prop event '-X-HNH-FILENAME)
+ (path-append
+ (prop calendar '-X-HNH-DIRECTORY)
+ (string-append uid ".ics"))))
(with-atomic-output-to-file (prop event '-X-HNH-FILENAME)
(lambda () (print-components-with-fake-parent (list event))))
uid))
@@ -37,5 +48,9 @@
(define-public (remove-event event)
(define calendar (parent event))
- (assert (eq? 'vdir (prop calendar '-X-HNH-SOURCETYPE)))
+ (unless (eq? 'vdir (prop calendar '-X-HNH-SOURCETYPE))
+ (scm-error 'wrong-type-arg "remove-event"
+ (_ "Can only remove events belonging to vdir calendars. Calendar is of type ~s")
+ (list (prop calendar '-X-HNH-SOURCETYPE))
+ #f))
(delete-file (prop event '-X-HNH-FILENAME)))
diff --git a/module/vcomponent/formats/xcal/parse.scm b/module/vcomponent/formats/xcal/parse.scm
index 66bb8460..d9020858 100644
--- a/module/vcomponent/formats/xcal/parse.scm
+++ b/module/vcomponent/formats/xcal/parse.scm
@@ -82,10 +82,10 @@
bymonthday byyearday byweekno
bymonth bysetpos)
(string->number value))
- (else (throw
- 'key-error
+ (else (scm-error 'key-error "handle-value"
(_ "Invalid type ~a, with value ~a")
- type value))))))
+ (list type value)
+ #f))))))
;; freq until count interval wkst
@@ -109,9 +109,11 @@
byyearday byweekno bymonth bysetpos)
(list (symbol->keyword key)
(map (lambda (v) (parse-value-of-that-type key v))
- (map car values)))
- )
- (else (throw 'error)))))))))]
+ (map car values))))
+ (else (scm-error 'misc-error "handle-value"
+ "Invalid key ~s"
+ (list key)
+ #f)))))))))]
[(time) (parse-iso-time (car value))]
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-03 21:40:16 +0200