Files
racket-audio/audio-errors.rkt
T
2026-07-07 11:39:31 +02:00

72 lines
1.9 KiB
Racket

#lang racket/base
(require (for-syntax racket/base)
racket/path)
(provide exn:fail:audio
exn:fail:audio?
exn:fail:audio-code
raise-audio-error
make-audio-error-code
exn-audio-code
)
(struct exn:fail:audio exn:fail
(code source line)
#:transparent)
(define exn-audio-code exn:fail:audio-code)
(define (audio-codes)
'(no-decoder no-encoder
file-not-found
invalid-audio-file
no-audio-reader
audio-file-corrupt
audio-error))
(define (make-audio-code code)
(if (symbol? code)
(letrec ((f (λ (l)
(if (null? (cdr l))
(car l)
(if (eq? (car l) code)
code
(f (cdr l)))))))
(f (audio-codes)))
(make-audio-code (string->symbol (format "~a" code)))))
(define (make-audio-error-code c)
(make-audio-code c))
(define (raise-audio-error* code source line message . args)
(displayln (format "raise-audio-error*: code=~a source=~a line=~a message=~a args=~a" code source line message args))
(let* ((msg (apply format (cons message args)))
(src* (file-name-from-path (build-path source)))
(msg* (format "~a at ~a, line ~a" msg src* line)))
(raise (exn:fail:audio msg*
(current-continuation-marks)
(make-audio-code code)
source
line))))
(define-syntax (raise-audio-error stx)
(syntax-case stx ()
((_ code message ...)
(let ((src (syntax-source stx))
(line (syntax-line stx)))
#`(displayln code)
#`(displayln (list message ...))
#`(displayln '#,src)
#`(displayln '#,line)
#`(raise-audio-error* code '#,src '#,line message ...)))))
(define (test x)
(if (> x 10)
(raise-audio-error 'file-notd-found "File not found: ~a" "c:/muziek/a.flac")
#t))