suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Move part of unstable/logging to racket/logging.

Browse Source 
... and improve and extend its interface at the same time.
This commit is contained in:
Vincent St-Amour 2015-07-22 16:42:05 -05:00
parent 46a8506f99
commit 0f2d02cdd2
3 changed files with 156 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
pkgs/racket-doc/scribblings/reference/logging.scrbl
View File

@ -84,7 +84,7 @@ otherwise.}
@defproc[(make-logger [topic (or/c symbol? #f) #f]
[parent (or/c logger? #f) #f]
[propagate-level (or/c 'none 'fatal 'error 'warning 'info 'debug) 'debug]
[propagate-level log-level/c 'debug]
[propagate-topic (or/c #f symbol?) #f]
... ...)
logger?]{
@ -134,7 +134,7 @@ created when @racket[define-logger] is evaluated.}
@section{Logging Events}
@defproc[(log-message [logger logger?]
[level (or/c 'fatal 'error 'warning 'info 'debug)]
[level log-level/c]
[topic (or/c symbol? #f) (logger-name logger)]
[message string?]
[data any/c]
@ -155,7 +155,7 @@ by @racket[": "] before it is sent to receivers.
@defproc[(log-level? [logger logger?]
[level (or/c 'fatal 'error 'warning 'info 'debug)]
[level log-level/c]
[topic (or/c symbol? #f) #f])
boolean?]{
@ -180,7 +180,7 @@ that any event information it receives will never become accessible).
@defproc[(log-max-level [logger logger?]
[topic (or/c symbol? #f) #f])
(or/c #f 'fatal 'error 'warning 'info 'debug)]{
(or/c log-level/c #f)]{
Similar to @racket[log-level?], but reports the maximum-detail level of logging for
which @racket[log-level?] on @racket[logger] and @racket[topic] returns @racket[#t]. The
@ -191,7 +191,7 @@ currently returns @racket[#f] for all levels.
@defproc[(log-all-levels [logger logger?])
(list/c (or/c #f 'fatal 'error 'warning 'info 'debug)
(list/c (or/c #f log-level/c)
(or/c #f symbol?)
... ...)]{
@ -289,7 +289,7 @@ Returns @racket[#t] if @racket[v] is a @tech{log receiver}, @racket[#f]
otherwise.}
@defproc[(make-log-receiver [logger logger?]
[level (or/c 'none 'fatal 'error 'warning 'info 'debug)]
[level log-level/c]
[topic (or/c #f symbol?) #f]
... ...)
log-receiver?]{
@ -316,3 +316,75 @@ the last given @racket[level]). A @racket[level] for a @racket[#f]
provided @racket[topic]. If the same @racket[topic] is provided multiple
times, the @racket[level] provided with the last instance in the
argument list takes precedence.}
@; ----------------------------------------
@section{Additional Logging Functions}
@note-lib[racket/logging]
@(require (for-label racket/logging))
@(define log-eval (make-base-eval))
@(interaction-eval #:eval log-eval
(require racket/logging))
@defproc[(log-level/c [v any/c])
boolean?]{
Returns @racket[#t] if @racket[v] is a valid logging level (@racket['none],
@racket['fatal], @racket['error], @racket['warning], @racket['info], or
@racket['debug]), @racket[#f] otherwise.
@history[#:added "6.2.900.5"]{}
}
@defproc[(with-intercepted-logging
[interceptor (-> (vector/c
log-level/c
string?
any/c
(or/c symbol? #f))
any)]
[proc (-> any)]
[log-spec (or/c log-level/c #f)] ...)
any]{
Runs @racket[proc], calling @racket[interceptor] on any log event that would
be received by @racket[(make-log-receiver (current-logger) log-spec ...)].
Returns whatever @racket[proc] returns.
@defexamples[
#:eval log-eval
(let ([warning-counter 0])
(with-intercepted-logging
(lambda (l)
(when (eq? (vector-ref l 0) ; actual level
'warning)
(set! warning-counter (add1 warning-counter))))
(lambda ()
(log-warning "Warning!")
(log-warning "Warning again!")
(+ 2 2))
'warning)
warning-counter)]
@history[#:added "6.2.900.5"]{}}
@defproc[(with-logging-to-port
[port output-port?] [proc (-> any)]
[log-spec (or/c 'fatal 'error 'warning 'info 'debug symbol? #f)] ...)
any]{
Runs @racket[proc], outputting any logging that would be received by
@racket[(make-log-receiver (current-logger) log-spec ...)] to @racket[port].
Returns whatever @racket[proc] returns.
@defexamples[
#:eval log-eval
(let ([my-log (open-output-string)])
(with-logging-to-port my-log
(lambda ()
(log-warning "Warning World!")
(+ 2 2))
'warning)
(get-output-string my-log))]
@history[#:added "6.2.900.5"]{}}

18
pkgs/racket-test-core/tests/racket/logger.rktl
View File

@ -238,6 +238,24 @@
(test #f sync/timeout 0 r2)
(test #f sync/timeout 0 r22))
; --------------------
; racket/logging
(require racket/logging)
(define (test-intercepted-logging)
(define log '())
(cons (with-intercepted-logging
(lambda (v) (set! log (cons (vector-ref v 1) log)))
(lambda ()
(log-warning "1")
(log-warning "2")
(log-warning "3")
(log-info "4")
#t)
'warning)
log))
(test '(#t "3" "2" "1") test-intercepted-logging)
; --------------------
(report-errs)

60
racket/collects/racket/logging.rkt Normal file
View File

@ -0,0 +1,60 @@
#lang racket/base
(require racket/contract/base)
(provide log-level/c)
(define log-level/c (or/c 'none 'fatal 'error 'warning 'info 'debug))
(define log-spec? (listof (or/c symbol? #f)))
(define log-event? (vector-immutable/c log-level/c string? any/c (or/c symbol? #f)))
(provide/contract [with-intercepted-logging
(->* ((-> log-event? any)
(-> any))
#:rest log-spec?
any)]
[with-logging-to-port
(->* (output-port? (-> any))
#:rest log-spec?
any)])
(define (receiver-thread receiver stop-chan intercept)
(thread
(lambda ()
(define (clear-events)
(let ([l (sync/timeout 0 receiver)])
(when l ; still something to read
(intercept l) ; interceptor gets the whole vector
(clear-events))))
(let loop ()
(let ([l (sync receiver stop-chan)])
(cond [(eq? l 'stop)
;; we received all the events we were supposed
;; to get, read them all (w/o waiting), then
;; stop
(clear-events)]
[else ; keep going
(intercept l)
(loop)]))))))
(define (with-intercepted-logging interceptor proc . log-spec)
(let* ([orig-logger (current-logger)]
;; We use a local logger to avoid getting messages that didn't
;; originate from proc. Since it's a child of the original logger,
;; the rest of the program still sees the log entries.
[logger (make-logger #f orig-logger)]
[receiver (apply make-log-receiver logger log-spec)]
[stop-chan (make-channel)]
[t (receiver-thread receiver stop-chan interceptor)])
(begin0
(parameterize ([current-logger logger])
(proc))
(channel-put stop-chan 'stop) ; stop the receiver thread
(thread-wait t))))
(define (with-logging-to-port port proc . log-spec)
(apply with-intercepted-logging
(lambda (l) (displayln (vector-ref l 1) ; actual message
port))
proc
log-spec))