diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-17 22:14:18 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-28 14:17:01 +0200 |
commit | 1da5a277188a954d881316cb605962ee66053285 (patch) | |
tree | 4f77be46498f321d08bfaa072636e4fd252b4f9d /module/c | |
parent | Unsmarted define-config% (diff) | |
download | calp-1da5a277188a954d881316cb605962ee66053285.tar.gz calp-1da5a277188a954d881316cb605962ee66053285.tar.xz |
Normalize errors.
Diffstat (limited to '')
-rw-r--r-- | module/c/cpp.scm | 8 | ||||
-rw-r--r-- | module/c/parse.scm | 20 | ||||
-rw-r--r-- | module/calp/entry-points/convert.scm | 4 | ||||
-rw-r--r-- | module/calp/entry-points/html.scm | 2 | ||||
-rw-r--r-- | module/calp/html/components.scm | 5 | ||||
-rw-r--r-- | module/calp/html/util.scm | 1 | ||||
-rw-r--r-- | module/calp/html/view/calendar.scm | 4 | ||||
-rw-r--r-- | module/calp/main.scm | 12 | ||||
-rw-r--r-- | module/calp/repl.scm | 5 | ||||
-rw-r--r-- | module/calp/util/config.scm | 19 | ||||
-rw-r--r-- | module/crypto.scm | 4 |
11 files changed, 58 insertions, 26 deletions
diff --git a/module/c/cpp.scm b/module/c/cpp.scm index 8710fdd2..3f50fb87 100644 --- a/module/c/cpp.scm +++ b/module/c/cpp.scm @@ -5,7 +5,6 @@ :use-module (ice-9 match) :use-module (ice-9 regex) :use-module ((rnrs io ports) :select (call-with-port)) - :use-module (ice-9 pretty-print) ; used by one error handler :use-module (ice-9 format) :use-module ((hnh util io) :select (read-lines)) :use-module (hnh util graph) @@ -26,7 +25,10 @@ (aif (regexp-exec define-re header-line) (cons (match:substring it 1) (match:substring it 4)) - (error "Line dosen't match" header-line))) + (scm-error 'c-parse-error + "tokenize-define-line" + "Line dosen't match: ~s" + (list header-line) #f))) (define-public (do-funcall function arguments) @@ -100,7 +102,7 @@ (map (lambda (line) (catch #t (lambda () (parse-cpp-define line)) - (lambda (err caller fmt args . _) + (lambda (err caller fmt args data) (format #t "~a ~?~%" fmt args) #f))) lines)) diff --git a/module/c/parse.scm b/module/c/parse.scm index 3e3d8024..8030da77 100644 --- a/module/c/parse.scm +++ b/module/c/parse.scm @@ -34,7 +34,9 @@ [(LL) '(long-long)] [(L) '(long)] [(U) '(unsigned)]) - (error "Invalid integer suffix"))) + (scm-error 'c-parse-error "parse-integer-suffix" + "Invalid integer suffix ~s" + (list str) #f))) (define (parse-lexeme-tree tree) (match tree @@ -113,11 +115,11 @@ `(funcall ,(parse-lexeme-tree function) ,(parse-lexeme-tree arguments))] - [bare (throw 'parse-error - 'parse-lexeme-tree - "Naked literal in lex-tree. How did that get there?" - '() - bare)])) + [bare (scm-error 'c-parse-error + "parse-lexeme-tree" + "Naked literal in lex-tree: ~s" + (list bare) + #f)])) ;; https://en.wikipedia.org/wiki/Operators_in_C_and_C%2B%2B @@ -175,7 +177,11 @@ (parse-lexeme-tree op) (mark-other (parse-lexeme-tree right)))] - [other (error "Not an infix tree ~a" other)])) + [other (scm-error 'c-parse-error + "flatten-infix" + "Not an infix tree ~a" + (list other) + #f)])) diff --git a/module/calp/entry-points/convert.scm b/module/calp/entry-points/convert.scm index 3f602b07..1ce33d9c 100644 --- a/module/calp/entry-points/convert.scm +++ b/module/calp/entry-points/convert.scm @@ -68,7 +68,7 @@ (@ (vcomponent formats xcal parse) sxcal->vcomponent) ;; TODO strip *TOP* xml->sxml)] - [else (error "")] + [else (scm-error 'misc-error "convert-main" "Unexpected parser type: ~a" (list from) #f)] )) (define writer @@ -85,7 +85,7 @@ (sxml->xml ((@ (vcomponent formats xcal output) vcomponent->sxcal) component) port))] - [else (error "")])) + [else (scm-error 'misc-error "convert-main" "Unexpected writer type: ~a" (list to) #f)])) (call-with-output-file outfile diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm index 61489a85..37b0285b 100644 --- a/module/calp/entry-points/html.scm +++ b/module/calp/entry-points/html.scm @@ -173,7 +173,7 @@ pre-start: (start-of-week start) post-end: (end-of-week (end-of-month start)))] [else - (error "Unknown html style: ~a" style)]) + (scm-error 'misc-error "html-main" "Unknown html style: ~a" (list style) #f)]) ((@ (calp util time) report-time!) "all done") ) diff --git a/module/calp/html/components.scm b/module/calp/html/components.scm index 2f8c85ec..37d50697 100644 --- a/module/calp/html/components.scm +++ b/module/calp/html/components.scm @@ -57,7 +57,10 @@ allow-other-keys: rest: args) (when (and onclick href) - (error "Only give one of onclick, href and submit.")) + (scm-error 'wrong-type-arg "btn" + "href, onclick, and submit mutually exclusive. href = ~s, onclick = ~s, submit = ~s." + (list href onclick submit) + #f)) (let ((body #f)) `(,(cond [href 'a] diff --git a/module/calp/html/util.scm b/module/calp/html/util.scm index 75137d4e..54c92e92 100644 --- a/module/calp/html/util.scm +++ b/module/calp/html/util.scm @@ -17,6 +17,7 @@ ;; Returns a color with good contrast to the given background color. ;; https://stackoverflow.com/questions/1855884/determine-font-color-based-on-background-color/1855903#1855903 (define-public (calculate-fg-color c) + ;; TODO what errors can actually appear here? (catch #t (lambda () (define (str->num c n) (string->number (substring/shared c n (+ n 2)) 16)) diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index 670ad9b6..5a8e977e 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -74,10 +74,10 @@ ,display))) (unless next-start - (error 'html-generate "Next-start needs to be a procedure")) + (scm-error 'misc-error "html-generate" "Next-start needs to be a procedure" #f #f)) (unless prev-start - (error 'html-generate "Prev-start needs to be a procedure")) + (scm-error 'misc-error "html-generate" "Prev-start needs to be a procedure" #f #f)) (xhtml-doc (@ (lang sv)) diff --git a/module/calp/main.scm b/module/calp/main.scm index 18b8b731..607b9f1b 100644 --- a/module/calp/main.scm +++ b/module/calp/main.scm @@ -120,8 +120,11 @@ (cond [altconfig (if (file-exists? altconfig) altconfig - (throw 'option-error - "Configuration file ~a missing" altconfig))] + (scm-error 'misc-error + "wrapped-main" + "Configuration file ~a missing" + (list altconfig) + #f))] ;; altconfig could be placed in the list below. But I want to raise an error ;; if an explicitly given config is missing. [(find file-exists? @@ -213,7 +216,10 @@ (when (option-ref opts 'update-zoneinfo #f) (let* ((locations (list "/usr/libexec/calp/tzget" (path-append (xdg-data-home) "tzget"))) (filename (or (find file-exists? locations) - (error "tzget not installed, please put it in one of ~a" locations))) + (scm-error 'missing-helper "wrapped-main" + "tzget not installed, please put it in one of ~a" + (list locations) + (list "tzget" locations)))) (pipe (open-input-pipe filename))) ;; (define path (read-line pipe)) diff --git a/module/calp/repl.scm b/module/calp/repl.scm index e25c2649..47c35a40 100644 --- a/module/calp/repl.scm +++ b/module/calp/repl.scm @@ -21,8 +21,9 @@ [else 'UNIX]) [(UNIX) (add-hook! shutdown-hook (lambda () (catch 'system-error (lambda () (delete-file address)) - (lambda (err proc fmt . args) - (warning "Failed to unlink ~a" address args) + (lambda (err proc fmt args data) + (warning (format #f "Failed to unlink ~a: ~?" + address fmt args)) err)))) (make-unix-domain-server-socket path: address)] [(IPv4) (apply (case-lambda diff --git a/module/calp/util/config.scm b/module/calp/util/config.scm index e1417d86..4862bbda 100644 --- a/module/calp/util/config.scm +++ b/module/calp/util/config.scm @@ -39,7 +39,11 @@ (for (key value) in (group kwargs 2) (aif (hashq-ref config-properties key) (set! (it name) value) - (error "Missing config protperty slot " key))) + (scm-error 'configuration-error + "define-config" + "No configuration slot named ~s, when defining ~s" + (list key name) + #f))) (set-config! name (get-config name default-value))) (define-syntax define-config @@ -52,7 +56,12 @@ (define-public (set-config! name value) (hashq-set! config-values name (aif (pre name) - (or (it value) (error "Pre crashed for" name)) + (or (it value) + (scm-error 'configuration-error + "set-config!" + "Pre-property failed when setting ~s to ~s" + (list name value) + #f)) value)) (awhen (post name) (it value))) @@ -63,8 +72,10 @@ (if (eq? default %uniq) (let ((v (hashq-ref config-values key %uniq))) (when (eq? v %uniq) - ;; TODO throw descript error - (error "Missing config" key)) + (scm-error 'configuration-error + "get-config" + "No configuration item named ~s" + (list key) #f)) v) (hashq-ref config-values key default))) diff --git a/module/crypto.scm b/module/crypto.scm index 79eaaf89..477014e9 100644 --- a/module/crypto.scm +++ b/module/crypto.scm @@ -22,7 +22,9 @@ (define bv (cond ((bytevector? msg) msg) ((string? msg) (string->utf8 msg)) - (else (throw 'value-error "Invalid type")))) + (else (scm-error 'wrong-type-arg "sha256" + "Wrong type argument. Expected string or bytevector, got ~s" + (list msg) (list msg))))) (SHA256 ((@ (system foreign) bytevector->pointer) bv) (bytevector-length bv) ((@ (system foreign) bytevector->pointer) md)) |