rpc-log.scm
(module rpc-log mzscheme
        (provide rpc-register-logger
                 rpc-log-error
                 rpc-log-info
                 rpc-log-warn
                 rpc-log-debug
                 rpc-log-fatal
                 rpc-log
                 rpc-log-level
                 )
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;; Internals
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define _logger (lambda (type message)
                          (display (format "~a:~s~%" type message))))
        
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;; exported functions
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        ;;;; * rpc-register-logger
        (define (rpc-register-logger F)
          (set! _logger F))
        
        ;;;; * rpc-log-error
        (define (_rpc-log-error . messages)
          (_logger 'error (apply string-append (map (lambda (x) (format "~a" x)) messages))))
        
        
        ;;;; * rpc-log-info
        (define (_rpc-log-info . messages)
          (_logger 'info  (apply string-append (map (lambda (x) (format "~a" x)) messages))))
        
        ;;;; * rpc-log-debug
        (define (_rpc-log-debug . messages)
          (_logger 'debug  (apply string-append (map (lambda (x) (format "~a" x)) messages))))
        
        ;;;; * rpc-log-warn
        (define (_rpc-log-warn . messages)
          (_logger 'warn  (apply string-append (map (lambda (x) (format "~a" x)) messages))))
        
        ;;;; * rpc-log-fatal
        (define (_rpc-log-fatal . messages)
          (_logger 'fatal  (apply string-append (map (lambda (x) (format "~a" x)) messages))))
        
        (define rpc-log        _rpc-log-error)
        (define rpc-log-error  _rpc-log-error)
        (define rpc-log-info   _rpc-log-info)
        (define rpc-log-warn   _rpc-log-warn)
        (define rpc-log-debug  _rpc-log-debug)
        (define rpc-log-fatal  _rpc-log-debug)
        (define (noop) #t)
        
        ;;;; * rpc-log-level
        (define (rpc-log-init d i w e f)
          (let ((getf (lambda (x) (if (eq? x #f) noop x))))
            (set! rpc-log (getf e))
            (set! rpc-log-error (getf e))
            (set! rpc-log-fatal (getf f))
            (set! rpc-log-warn  (getf w))
            (set! rpc-log-info  (getf i))
            (set! rpc-log-debug (getf d))
            ))
        
        ;;;; rpc-log-level
        (define (rpc-log-level level)
          (cond ((eq? level 'debug) (rpc-log-init _rpc-log-debug _rpc-log-info _rpc-log-warn _rpc-log-error _rpc-log-fatal))
                ((eq? level 'info)  (rpc-log-init #f _rpc-log-info _rpc-log-warn _rpc-log-error _rpc-log-fatal))
                ((eq? level 'warn)  (rpc-log-init #f #f _rpc-log-warn _rpc-log-error _rpc-log-fatal))
                ((eq? level 'error) (rpc-log-init #f #f #f _rpc-log-error _rpc-log-fatal))
                (else (error (format "rpc-log-level: unknown level ~s" level)))))
        
        
        );;;; module-end