From 1da5a277188a954d881316cb605962ee66053285 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 17 Mar 2022 22:14:18 +0100 Subject: Normalize errors. --- module/vcomponent/duration.scm | 16 ++++++++++++---- module/vcomponent/formats/common/types.scm | 3 ++- module/vcomponent/formats/ical/parse.scm | 12 ++++++++---- module/vcomponent/formats/xcal/parse.scm | 14 ++++++++------ module/vcomponent/recurrence/generate.scm | 4 +++- module/vcomponent/recurrence/parse.scm | 8 +++++--- module/vcomponent/util/parse-cal-path.scm | 5 ++++- 7 files changed, 42 insertions(+), 20 deletions(-) (limited to 'module/vcomponent') diff --git a/module/vcomponent/duration.scm b/module/vcomponent/duration.scm index 786675b8..637d7db4 100644 --- a/module/vcomponent/duration.scm +++ b/module/vcomponent/duration.scm @@ -20,7 +20,9 @@ key: (sign '+) week day time) (when (and week (or day time)) - (error "Can't give week together with day or time")) + (scm-error 'misc-error "duration" + "Can't give week together with day or time" + #f #f)) (make-duration sign week day time)) @@ -64,7 +66,10 @@ (define (parse-duration str) (let ((m (match-pattern dur-pattern str))) (unless m - (throw 'parse-error "~a doesn't appar to be a duration" str)) + (scm-error 'parse-error "parse-duration" + "~s doesn't appar to be a duration" + (list str) + #f)) (unless (= (peg:end m) (string-length str)) (warning "Garbage at end of duration")) @@ -83,9 +88,12 @@ [(H) `(hour: ,n)] [(M) `(minute: ,n)] [(S) `(second: ,n)] - [else (error "Invalid key")]))] + [else (scm-error 'misc-error "parse-duration" + "Invalid key ~a" type #f)]))] [a - (error "~a not on form ((number ) type)" a)]) + (scm-error 'misc-error "parse-duration" + "~s not on expected form ((number ) type)" + (list a) #f)]) (context-flatten (lambda (x) (and (pair? (car x)) (eq? 'number (caar x)))) (cdr (member "P" tree))) diff --git a/module/vcomponent/formats/common/types.scm b/module/vcomponent/formats/common/types.scm index efe17f36..97980e1a 100644 --- a/module/vcomponent/formats/common/types.scm +++ b/module/vcomponent/formats/common/types.scm @@ -136,4 +136,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 30a1837f..08f31ae7 100644 --- a/module/vcomponent/formats/ical/parse.scm +++ b/module/vcomponent/formats/ical/parse.scm @@ -121,7 +121,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 +195,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 @@ -319,7 +323,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 "ERROR parse error around ~a @@ -327,7 +331,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/xcal/parse.scm b/module/vcomponent/formats/xcal/parse.scm index 7dee8d67..b21e72b5 100644 --- a/module/vcomponent/formats/xcal/parse.scm +++ b/module/vcomponent/formats/xcal/parse.scm @@ -81,10 +81,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 @@ -108,9 +108,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))] diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm index b498e033..33f86e3d 100644 --- a/module/vcomponent/recurrence/generate.scm +++ b/module/vcomponent/recurrence/generate.scm @@ -217,7 +217,9 @@ [(BYHOUR) (to-dt (set (hour t) value))] [(BYMINUTE) (to-dt (set (minute t) value))] [(BYSECOND) (to-dt (set (second t) value))] - [else (error "Unrecognized by-extender" key)]))) + [else (scm-error 'wrong-type-arg "update" + "Unrecognized by-extender ~s" + key #f)]))) date-object extension-rule)) diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm index c2e3a10f..65d44331 100644 --- a/module/vcomponent/recurrence/parse.scm +++ b/module/vcomponent/recurrence/parse.scm @@ -51,7 +51,9 @@ (define-macro (quick-case key . cases) (let ((else-clause (or (assoc-ref cases 'else) - '(error "Guard failed")))) + '(scm-error 'misc-error "quick-case" + "Guard failed" + #f #f)))) `(case ,key ,@(map (match-lambda ((key guard '=> body ...) @@ -74,10 +76,10 @@ (define* (string->number/throw string optional: (radix 10)) (or (string->number string radix) - (scm-error 'wrong-type-argument + (scm-error 'wrong-type-arg "string->number/throw" "Can't parse ~s as number in base ~a" - '(string radix) #f))) + (list string radix) (list string radix)))) ;; RFC 5545, Section 3.3.10. Recurrence Rule, states that the UNTIL value MUST have ;; the same type as the DTSTART of the event (date or datetime). I have seen events diff --git a/module/vcomponent/util/parse-cal-path.scm b/module/vcomponent/util/parse-cal-path.scm index 11a32064..df3fbf75 100644 --- a/module/vcomponent/util/parse-cal-path.scm +++ b/module/vcomponent/util/parse-cal-path.scm @@ -25,7 +25,10 @@ (prop comp '-X-HNH-DIRECTORY) path) comp)] [(block-special char-special fifo socket unknown symlink) - => (lambda (t) (error "Can't parse file of type " t))])) + => (lambda (t) (scm-error 'misc-error "parse-cal-path" + "Can't parse file of type ~s" + (list t) + #f))])) (unless (prop cal "NAME") (set! (prop cal "NAME") -- cgit v1.2.3