From 1da5a277188a954d881316cb605962ee66053285 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Thu, 17 Mar 2022 22:14:18 +0100
Subject: Normalize errors.

---
 module/vcomponent/formats/common/types.scm |  3 ++-
 module/vcomponent/formats/ical/parse.scm   | 12 ++++++++----
 module/vcomponent/formats/xcal/parse.scm   | 14 ++++++++------
 3 files changed, 18 insertions(+), 11 deletions(-)

(limited to 'module/vcomponent/formats')

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))]
 
-- 
cgit v1.2.3