You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
47 lines
1.6 KiB
Racket
47 lines
1.6 KiB
Racket
10 years ago
|
#lang typed/racket/base
|
||
|
|
(require (for-syntax racket/base))
|
||
|
|
(require/typed "world-typed.rkt" [world:logging-level (Parameterof Log-Level)])
|
||
|
|
(require/typed racket/date [current-date (-> Any)]
|
||
|
|
[date->string ((Any) (Any) . ->* . String)])
|
||
|
|
(require racket/match)
|
||
|
|
(provide (all-defined-out))
|
||
|
|
|
||
|
|
(define-syntax-rule (define-orphan-logger name)
|
||
|
|
(begin
|
||
|
|
(define remember-cl (current-logger))
|
||
|
|
(define dummy-cl (make-logger))
|
||
|
|
(current-logger dummy-cl)
|
||
|
|
(define-logger name)
|
||
|
|
(current-logger remember-cl)))
|
||
|
|
|
||
|
|
(define levels '(none fatal error warning info debug))
|
||
|
|
|
||
|
|
(define-logger quad)
|
||
|
|
|
||
|
|
(define-syntax-rule (activate-logger logger)
|
||
|
|
(begin
|
||
|
|
(define logger-receiver (make-log-receiver logger (world:logging-level)))
|
||
|
|
(define log-file (build-path (current-directory) (format "~a.txt" 'logger)))
|
||
|
|
(with-output-to-file log-file #:exists 'truncate void)
|
||
|
|
(void (thread
|
||
|
|
(λ ()
|
||
|
|
(let loop ()
|
||
|
|
(match (sync logger-receiver)
|
||
|
|
[(vector event-level event-message event-value name)
|
||
|
|
(define msg (format "[~a] ~a\n" event-level event-message))
|
||
|
|
; (eprintf msg)
|
||
|
|
(flush-output)
|
||
|
|
(with-output-to-file log-file #:exists 'append (λ () (display msg)))])
|
||
|
|
(loop))))
|
||
|
|
(log-quad-info "started at ~a" (date->string (current-date) #t)))))
|
||
|
|
|
||
|
|
(define-syntax-rule (log-quad-debug-report x)
|
||
|
|
(begin
|
||
|
|
(log-quad-debug "~a = ~a" 'x x)
|
||
|
|
x))
|
||
|
|
|
||
|
|
(define-syntax-rule (log-quad-debug* xs)
|
||
|
|
(when (equal? (world:logging-level) 'debug)
|
||
|
|
(map (λ(x) (log-quad-debug x)) xs)))
|
||
|
|
|