1. David Krentzlin
  2. climax

Commits

certainty  committed d5eab4c Draft

polished error handling and error-hooks

  • Participants
  • Parent commits e90482a
  • Branches default

Comments (0)

Files changed (1)

File climax.scm

View file
  • Ignore whitespace
 (module climax
 
 ( default-error-code default-invalid-data-code default-success-code
-  error-port output-port input-port
-  notice-prefix warning-prefix error-prefix
-  notice-formatter warning-formatter error-formatter
-  notice> warning> error>
+  error-port output-port input-port debug-port
+  notice-prefix warning-prefix error-prefix debug-prefix
+  notice-formatter warning-formatter error-formatter debug-formatter
+  notice> warning> error> debug>
   exit-now!)
 
 
     (else status)))
 
 (define error-port   (make-parameter  (current-error-port)))
-(define warning-port (make-parameter (current-output-port)))
+(define warning-port (make-parameter  (current-output-port)))
 (define output-port  (make-parameter  (current-output-port)))
+(define debug-port   (make-parameter  (current-output-port)))
 (define input-port   (make-parameter  (current-input-port)))
 
+
 (define notice-prefix  (make-parameter "INFO: "))
 (define warning-prefix (make-parameter "WARNING: "))
 (define error-prefix   (make-parameter "ERROR: "))
+(define debug-prefix   (make-parameter "DEBUG: "))
 
 (define ((make-formatter prefix) fmt . args)
   (conc (prefix) (apply sprintf fmt args)))
 (define notice-formatter  (make-parameter (make-formatter notice-prefix)))
 (define warning-formatter (make-parameter (make-formatter warning-prefix)))
 (define error-formatter   (make-parameter (make-formatter error-prefix)))
+(define debug-formatter   (make-parameter (make-formatter debug-prefix)))
 
 (define (notice> fmt . args)
   (with-output-to-port (output-port)
       (display (apply (error-formatter) fmt args))
       (newline))))
 
+(define (debug> fmt . args)
+  (with-output-to-port (debug-port)
+    (lambda ()
+      (display (apply (debug-formatter) fmt args))
+      (newline)))
+  (flush-output (debug-port)))
+
 (define (port-for-status code)
   (if (eq? code 'error)
       (error-port)
 (define current-error-hooks (make-parameter (list)))
 
 (define (on-error handler)
-  (current-error-hooks (cons (current-error-hooks) handler)))
+  (current-error-hooks (cons handler (current-error-hooks))))
 
-(define (run-error-hooks error)
-  (for-each (cut apply <> (list error)) (current-error-hooks)))
+(define (run-error-hooks err)
+  (condition-case
+      (for-each
+       (lambda (handler)
+         (handler err))
+       (reverse  (current-error-hooks)))
+    (ex ()
+        (exit-now! status: 'error  message: "there was an error in your error-hook!"))))
 
 ;; main entry point
 (define (climax app-name main)
            (exit-now! status: 'error message: (message-from-error err))))))
 
 (define (message-from-error exn)
-  "later")
+  ((condition-property-accessor 'exn 'message "Unknown error") exn))
 
-(climax "test" (lambda () (error "I die now")))
+
+
+;; Examples
+;; (on-error (lambda (err)
+;;             (debug> "I've been called")))
+
+;; (climax "test" (lambda () (error "I die now")))
 
 
 )