(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
)
(define _logger (lambda (type message)
(display (format "~a:~s~%" type message))))
(define (rpc-register-logger F)
(set! _logger F))
(define (_rpc-log-error . messages)
(_logger 'error (apply string-append (map (lambda (x) (format "~a" x)) messages))))
(define (_rpc-log-info . messages)
(_logger 'info (apply string-append (map (lambda (x) (format "~a" x)) messages))))
(define (_rpc-log-debug . messages)
(_logger 'debug (apply string-append (map (lambda (x) (format "~a" x)) messages))))
(define (_rpc-log-warn . messages)
(_logger 'warn (apply string-append (map (lambda (x) (format "~a" x)) messages))))
(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)
(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))
))
(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)))))
)