From 615a2c8284aa803fc3c646c07b91fa5131811369 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 3 Feb 2015 23:44:30 -0800 Subject: [PATCH] logger-typed --- quad/logger-typed.rkt | 46 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) create mode 100644 quad/logger-typed.rkt diff --git a/quad/logger-typed.rkt b/quad/logger-typed.rkt new file mode 100644 index 00000000..43787985 --- /dev/null +++ b/quad/logger-typed.rkt @@ -0,0 +1,46 @@ +#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))) +