From f463f3efed13d7b4e18960682ebb2365969b9220 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 6 Sep 2020 01:38:01 +0200 Subject: Improve datetime error messages. --- module/datetime.scm | 81 ++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 62 insertions(+), 19 deletions(-) (limited to 'module') diff --git a/module/datetime.scm b/module/datetime.scm index d004b2a5..001af59e 100644 --- a/module/datetime.scm +++ b/module/datetime.scm @@ -202,19 +202,29 @@ (cond [(datetime? date/-time) (get-date date/-time)] [(date? date/-time) date/-time] [(time? date/-time) (date)] - [else (error "Object not a date, time, or datetime object ~a" date/-time)])) + [else (scm-error 'wrong-type-arg + "as-date" + "Object not a date, time, or datetime object ~a" + (list date/-time) + #f)])) (define-public (as-time date/-time) (cond [(datetime? date/-time) (get-time% date/-time)] [(date? date/-time) (time)] [(time? date/-time) date/-time] - [else (error "Object not a date, time, or datetime object ~a" date/-time)])) + [else (scm-error 'wrong-type-arg "as-time" + "Object not a date, time, or datetime object ~a" + (list date/-time) + #f)])) (define-public (as-datetime dt) (cond [(datetime? dt) dt] [(date? dt) (datetime date: dt time: (time))] [(time? dt) (datetime time: dt date: (date))] - [else (error "Object not a date, time, or datetime object ~a" dt)])) + [else (scm-error 'wrong-type-arg "as-datetime" + "Object not a date, time, or datetime object ~a" + (list dt) + #f)])) @@ -238,7 +248,10 @@ ((feb) (if (leap-year? (year date)) 29 28)) - (else (error "No month ~a (~a)" (month date) date)))) + (else (scm-error 'out-of-range "days-in-month" + "No month number ~a (~a)" + (list (month date) date) + #f)))) (define-public (days-in-year date) (if (leap-year? (year date)) @@ -366,10 +379,10 @@ (let ((str (catch 'out-of-range (lambda () (locale-day (1+ (modulo week-day-number 7)) locale)) (lambda (oor str num) - (scm-error 'out-of-range 'week-day-name - "~a == (~a % 7) + 1" - (list num week-day-number) - (list week-day-number)))))) + (scm-error 'out-of-range "week-day-name" + "~a == (~a % 7) + 1" + (list num week-day-number) + #f))))) ;; I also know about the @var{locale-day-short} method, but I need ;; strings of length 2. (if truncate-to @@ -545,7 +558,10 @@ (days-in-interval start-date end-date)) ] [(or (not (zero? (month (get-date dt)))) (not (zero? (year (get-date dt))))) - (error "Multi-month intervals only supported when start-date is given" dt)] + (scm-error 'misc-error "datetime->decimal-hour" + "Multi-month intervals only supported when start-date is given (~a)" + (list dt) + #f)] [else (day (get-date dt))]))) (+ (time->decimal-hour (get-time% dt)) (* (1- date-diff) 24)))) @@ -594,7 +610,10 @@ ((#\B) (display (locale-month (month date)))) ((#\Z) (when (equal? "UTC" (get-timezone datetime)) (display "Z"))) (else (unless allow-unknown? - (error 'datetime->string "Invalid format token ~a" token)))) + (scm-error 'misc-error "datetime->string" + "Invalid format token ~a" + (list token) + #f)))) #f) (else (unless (char=? #\~ token) (display token)) token))) #f @@ -640,7 +659,13 @@ (loop (cdr str) (cddr fmt) dt) - (error "Non-match"))] + ;; TODO name the loop-local variables something + ;; other than the top level, to allow better error + ;; messages. + (scm-error 'misc-error "string->datetime" + "Mismatched symbol, expected ~a got ~a" + (list #\~ (car str)) + #f))] [(#\Z) (if (eq? #\Z (car str)) (loop (cdr str) @@ -672,14 +697,19 @@ (as-dt (set (year date) num))))] [else - (error "Unimplemented or incorrect parse token")])] + (scm-error 'misc-error "string->datetime" + "Unimplemented or incorrect parse token ~S" + (list str) + #f)])] [else (if (eq? (car str) (car fmt)) (loop (cdr str) (cdr fmt) dt) - (error (format #f "Mismatched symbol, expected ~a got ~a" - (car fmt) (car str))))]))) + (scm-error 'misc-error "string->datetime" + "Mismatched symbol, expected ~a got ~a" + (list (car fmt) (car str)) + #f))]))) (define*-public (string->time str optional: (fmt "~H:~M:~S")) (get-time% (string->datetime str fmt))) @@ -914,11 +944,16 @@ (when (or (negative? (year change)) (negative? (month change)) (negative? (day change))) - (error "Change can't be negative")) + (scm-error 'misc-error "date+%" "Negative change ~a invalid (base=~a)" + (list change base) + #f)) (unless (and (< 0 (month base)) (< 0 (day base))) - (error "Base day and month needs to be at least one" base)) + (scm-error 'misc-error "date+%" + "~a needs day and month to be at least one" + (list base) + #f)) (date+%% change base)) @@ -964,11 +999,16 @@ (when (or (negative? (year change)) (negative? (month change)) (negative? (day change))) - (error "Change can't be negative")) + (scm-error 'misc-error "date-%" "Negative change ~a invalid (base=~a)" + (list change base) + #f)) (when (or (negative? (month base)) (negative? (day base))) - (error "Base month or day can't be negative")) + (scm-error 'misc-error "date-%" + "~a needs day and month to be at least one" + (list base) + #f)) (date-%% change base) ) @@ -1142,7 +1182,10 @@ (negative? (day b)) (negative? (month a)) (negative? (day a)) ) - (error "Negative months or days are errors")) + (scm-error 'misc-error "date-difference" + "~a or ~a contains negative months or days" + (list a b) + #f)) (date-difference% (set-> b (month = (- 1)) -- cgit v1.2.3