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.
typesetting/quad/logger-typed.rkt

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)))