(module log mzscheme
(require
(lib "contract.ss")
(all-except
(lib "list.ss" "srfi" "1")
any)
(lib "string.ss" "srfi" "13")
(lib "cut.ss" "srfi" "26")
(lib "parameter.ss" "unlib")
(planet "aif.ss" ("schematics" "macro.plt" 1))
(file "base.ss")
)
(provide
(all-defined)
)
(define-parameter current-log-preamble
(lambda () null)
(lambda (val)
(if (procedure? val)
val
(raise-exn/format exn:fail:unlib
"Expected (symbol -> (list-of string)), received ~a." val)))
with-log-preamble)
(define-parameter current-log-port
current-output-port
(lambda (val)
(if (output-port? val)
val
(raise-exn/format exn:fail:unlib
"Expected output-port, received ~a." val)))
with-log-port)
(define log-message
(lambda args
(log-generic 'M args)))
(define log-warning
(lambda args
(log-generic 'W args)))
(define log-error
(lambda args
(log-generic 'E args)))
(define/contract log-generic
(-> symbol? list? any/c)
(lambda (message-type message-components)
(let* ([time
(current-seconds)]
[items
(cons message-type
(append ((current-log-preamble))
message-components))]
[out (aif log-port parameter? (current-log-port)
(log-port)
log-port)])
(display
(string-join
(map
(cut format "~s" <>)
items)
",")
out)
(newline out)
time)))
)