diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..414b46f --- /dev/null +++ b/Makefile @@ -0,0 +1,10 @@ + + +all: + @echo "use make clean" + +clean: + find . -type f -name "*~" -exec rm {} \; + find . -type f -name "*.bak" -exec rm {} \; + rm -f scrbl/*.html scrbl/*.js scrbl/*.css + diff --git a/main.rkt b/main.rkt index 5146b1e..fa490bc 100644 --- a/main.rkt +++ b/main.rkt @@ -3,12 +3,16 @@ (require (for-syntax racket/syntax) racket/date racket-sprintf + data/queue ) -(provide def-log - log-to - log-to-file - log-to-display +(provide sl-def-log + sl-log-to + sl-log-to-file + sl-log-to-display + sl-log-to-file&display + sl-set-log-level + sl-log-level ) (define (iso-timestamp) @@ -21,6 +25,40 @@ (date-minute d) (date-second d)))) + +(define log-callbacks #f) +(set! log-callbacks '()) + +(define log-level #f) +(set! log-level 'debug) + +(define max-log-queue-len 1000) +(define log-queue (make-queue)) + +(define (sl-set-log-level l) + (if (or + (eq? l 'debug) + (eq? l 'info) + (eq? l 'warning) + (eq? l 'warn) + (eq? l 'err) + (eq? l 'error) + (eq? l 'dbg) + (eq? l 'fatal)) + (set! log-level + (cond + ((eq? l 'err) 'error) + ((eq? l 'warn) 'warning) + ((eq? l 'dbg) 'debug) + (else l))) + (error "Log level must be 'debug ('dbg), 'info, 'warning ('warn), 'error ('err) or 'fatal") + ) + log-level + ) + +(define (sl-log-level) + log-level) + (define (log-to* receiver log-callbacks) (void (thread @@ -31,11 +69,21 @@ (data (vector-ref v 2)) (dt (car data)) (topic (cadr data)) + (lc (log-callbacks)) ) - (for-each (λ (e) - (let ((callback (cdr e))) - (callback topic level dt msg))) - (log-callbacks)) + + (enqueue! log-queue (list topic level dt msg)) + (unless (null? lc) + (for-each (λ (log-entry) + (for-each (λ (e) + (let ((callback (cdr e))) + (apply callback log-entry))) + lc) + ) + (queue->list log-queue)) + (set! log-queue (make-queue))) + (when (> (queue-length log-queue) max-log-queue-len) + (dequeue! log-queue)) ) (loop) ) @@ -44,50 +92,56 @@ ) ) -(define-syntax (log-to stx) - (syntax-case stx () - ((_ id name callback) - (with-syntax ([log-callbacks (format-id #'id "log-callbacks-~a" #'id)]) - #'(set! log-callbacks (append - (filter (λ (e) - (not (eq? (car e) 'name))) - log-callbacks) (list (cons 'name callback)))) - ) +(define-syntax sl-log-to + (syntax-rules (log-callbacks) + ((_ name callback) + (set! log-callbacks (append + (filter (λ (e) (not (eq? (car e) 'name))) + log-callbacks) + (list (cons 'name callback))) + ) ) ) ) -(define-syntax log-to-display - (syntax-rules (display) - ((_ id) - (log-to id display - (λ (topic level dt msg) +(define (sl-log-to-file&display filename) + (log-to-display*) + (log-to-file* filename) + (dbg-simple-log "log to file and display enabled with file ~a" filename) + ) + +(define (log-to-display*) + (sl-log-to display + (λ (topic level dt msg) (displayln (format "~a:~a:~a:~a" topic level dt msg))) ) - ) - ) + ) + + +(define (sl-log-to-display) + (log-to-display*) + (dbg-simple-log "log-to-display enabled") ) -(define-syntax log-to-file - (syntax-rules (file) - ((_ id filename) +(define (log-to-file* filename) (let ((out (open-output-file filename #:exists 'replace))) - (log-to id file (λ (topic level dt msg) - (displayln (format "~a:~a:~a:~a" topic level dt msg) out) - (flush-output out)) - ) + (sl-log-to file (λ (topic level dt msg) + (displayln (format "~a:~a:~a:~a" topic level dt msg) out) + (flush-output out)) + ) ) - ) - ) ) +(define (sl-log-to-file filename) + (log-to-file* filename) + (dbg-simple-log "log-to-file enabled with file ~a" filename) + ) (define-syntax def-log2 (syntax-rules () ((_ id parent receiver log-callbacks dbgn infon warnn errn fataln) (begin (define l (make-logger 'id parent)) - (define log-callbacks '()) (define receiver (make-log-receiver l 'debug)) (define (log level msg args) (log-message l level #f (apply format (cons msg args)) (list (iso-timestamp) 'id))) @@ -103,23 +157,26 @@ ) -(define-syntax (def-log stx) - (syntax-case stx () +(define-syntax (sl-def-log stx) + (syntax-case stx (log-callbacks) ((_ id parent) (with-syntax ([receiver (format-id #'id "receiver-~a" #'id)] - [callbacks (format-id #'id "log-callbacks-~a" #'id)] [dbg-name (format-id #'id "dbg-~a" #'id)] [info-name (format-id #'id "info-~a" #'id)] [warn-name (format-id #'id "warn-~a" #'id)] [err-name (format-id #'id "err-~a" #'id)] [fatal-name (format-id #'id "fatal-~a" #'id)] ) - #'(def-log2 id parent receiver callbacks dbg-name info-name warn-name err-name fatal-name) + #'(def-log2 id parent receiver log-callbacks dbg-name info-name warn-name err-name fatal-name) ) ) ((_ id) - #'(def-log id (current-logger)) + #'(sl-def-log id (current-logger)) ) ) ) +(sl-def-log simple-log) + + + diff --git a/scrbl/simple-log.scrbl b/scrbl/simple-log.scrbl index 1b08105..82406b4 100644 --- a/scrbl/simple-log.scrbl +++ b/scrbl/simple-log.scrbl @@ -1,90 +1,151 @@ #lang scribble/manual -@(require (for-label racket/base - racket/date - racket/logging - racket-sprintf)) - -@defmodule{simple-log} - -@title{Logging} +@(require (for-label racket/base)) +@title{simple-log} @author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]] -@section{Overview} +A small logging layer on top of Racket’s logger system. A log definition +creates a logger plus five convenience procedures. Messages are formatted +with @racket[format], timestamped, and dispatched asynchronously to the +registered callbacks. -Small wrapper around @racket[logger] with per-logger callbacks. +@section{API} -A logger consists of a @racket[logger], a -@racket[log-receiver] (level @racket['debug]), a mutable -callback list, five logging procedures, and a background thread -dispatching messages. +@defmodule["simple-log"] -@section{Definition} +@defform*[((sl-def-log id) + (sl-def-log id parent))]{ -@defform*[((def-log id) - (def-log id parent))]{ +Defines a logger with topic @racket['id] and creates: -Defines a logger @racket[id]. If @racket[parent] is omitted, -@racket[(current-logger)] is used. - -Creates: - -@itemlist[ - #:style 'compact - @item{@racket[(make-logger 'id parent)]} - @item{@racket[(make-log-receiver ... 'debug)]} - @item{callback list} - @item{procedures @racket[dbg-id], @racket[info-id], - @racket[warn-id], @racket[err-id], @racket[fatal-id]} +@itemlist[#:style 'compact + @item{@racket[dbg-id]} + @item{@racket[info-id]} + @item{@racket[warn-id]} + @item{@racket[err-id]} + @item{@racket[fatal-id]} ] -Starts a thread that @racket[sync]s on the receiver and forwards -messages to callbacks. -} - -@section{Logging functions} - -@defproc[(dbg-id [msg string?] [arg any/c] ...) void?] -@defproc[(info-id [msg string?] [arg any/c] ...) void?] -@defproc[(warn-id [msg string?] [arg any/c] ...) void?] -@defproc[(err-id [msg string?] [arg any/c] ...) void?] -@defproc[(fatal-id [msg string?] [arg any/c] ...) void?] - -Formats with @racket[(apply format (cons msg args))] and calls -@racket[log-message]. - -Attached data: +Each procedure has shape: @racketblock[ -(list (iso-timestamp) 'id) +(proc msg arg ...) ] -@section{Callbacks} +The message is formatted via @racket[format] and emitted with a timestamp +(@litchar{YYYY-MM-DDTHH:MM:SS}) and topic @racket['id]. -@defform[(log-to id name callback)]{ +If @racket[parent] is omitted, the current logger is used. -Registers @racket[callback] under @racket[name]. Existing entry -with same name is replaced. +A background thread is started that receives log events and forwards them +to the registered callbacks. +} -Callback signature: +@defform[(sl-log-to name callback)]{ + +Registers @racket[callback] under the symbolic name derived from +@racket[name]. + +@racket[name] is an identifier (not a runtime value). It is converted at +macro expansion time to a symbol and used as key in the callback registry. + +Invocation shape: @racketblock[ -(λ (topic level dt msg) ...) +(callback topic level timestamp message) +] + +with: + +@itemlist[#:style 'compact + @item{@racket[topic] — logger topic (symbol)} + @item{@racket[level] — level (symbol)} + @item{@racket[timestamp] — @litchar{YYYY-MM-DDTHH:MM:SS}} + @item{@racket[message] — formatted string} +] + +An existing callback with the same name is replaced. +} + +@defproc[(sl-log-to-file [filename path-string?]) void?]{ + +Registers a callback that writes log lines to @racket[filename]. The file +is opened with @racket['replace]. + +Format: + +@racketblock[ +":::" ] } -@section{Output helpers} +@defproc[(sl-log-to-display) void?]{ -@defform[(log-to-display id)]{ +Registers a callback that writes log lines to the current output port +using @racket[displayln]. -Registers @racket['display]. Output: +Format: -@verbatim{topic:level:timestamp:message} +@racketblock[ +":::" +] } -@defform[(log-to-file id filename)]{ +@defproc[(sl-log-to-file&display [filename path-string?]) void?]{ -Registers @racket['file]. File opened with -@racket[#:exists 'replace]. One line per message, flushed. +Equivalent to combining @racket[sl-log-to-display] and +@racket[sl-log-to-file]. } + +@defproc[(sl-set-log-level + [l (or/c 'debug 'dbg + 'info + 'warning 'warn + 'error 'err + 'fatal)]) + symbol?]{ + +Sets the module-wide log level and returns the normalized symbol. + +Aliases: + +@itemlist[#:style 'compact + @item{@racket['dbg] → @racket['debug]} + @item{@racket['warn] → @racket['warning]} + @item{@racket['err] → @racket['error]} +] + +Other values raise an exception. + +Note: this value is stored globally. The receiver installed by +@racket[sl-def-log] itself operates at level @racket['debug]. +} + +@defproc[(sl-log-level) symbol?]{ + +Returns the current module-wide log level (default @racket['debug]). +} + +@section{Generated procedures} + +A call to @racket[sl-def-log] creates five procedures. For example: + +@racketblock[ +(sl-def-log my-module) +] + +creates: + +@defproc[#:link-target? #f + (dbg-my-module [msg string?] [arg any/c] ...) void?]{Debug log.} +@defproc[#:link-target? #f + (info-my-module [msg string?] [arg any/c] ...) void?]{Info log.} +@defproc[#:link-target? #f + (warn-my-module [msg string?] [arg any/c] ...) void?]{Warning log.} +@defproc[#:link-target? #f + (err-my-module [msg string?] [arg any/c] ...) void?]{Error log.} +@defproc[#:link-target? #f + (fatal-my-module [msg string?] [arg any/c] ...) void?]{Fatal log.} + +All use @racket[format] and emit asynchronously. \ No newline at end of file diff --git a/scrbl/simple-log.scrbl~ b/scrbl/simple-log.scrbl~ deleted file mode 100644 index d73b98f..0000000 --- a/scrbl/simple-log.scrbl~ +++ /dev/null @@ -1,109 +0,0 @@ -#lang scribble/manual - -@(require (for-label racket/base - racket/date - racket/logging - racket-sprintf)) - -@title{Logging} - -@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]] - -@section{Overview} - -Small wrapper around @racket[logger] with per-logger callbacks. - -A logger consists of a @racket[logger], a -@racket[log-receiver] (level @racket['debug]), a mutable -callback list, five logging procedures, and a background thread -dispatching messages. - -@section{Definition} - -@defform*[([(def-log id)] - [(def-log id parent)])]{ - -Defines a logger @racket[id]. If @racket[parent] is omitted, -@racket[(current-logger)] is used. - -Creates: - -@itemlist[ - #:style 'ordered - @item{@racket[(make-logger 'id parent)]} - @item{@racket[(make-log-receiver ... 'debug)]} - @item{callback list} - @item{procedures @racket[dbg-id], @racket[info-id], - @racket[warn-id], @racket[err-id], @racket[fatal-id]} -] - -Starts a thread that @racket[sync]s on the receiver and forwards -messages to callbacks. -} - -@section{Logging} - -@defproc[(dbg-id [msg string?] [arg any/c] ...) void?] -@defproc[(info-id [msg string?] [arg any/c] ...) void?] -@defproc[(warn-id [msg string?] [arg any/c] ...) void?] -@defproc[(err-id [msg string?] [arg any/c] ...) void?] -@defproc[(fatal-id [msg string?] [arg any/c] ...) void?] - -Formats with @racket[(apply format (cons msg args))] and calls -@racket[log-message]. - -Attached data: - -@racketblock[ -(list (iso-timestamp) 'id) -] - -@section{Callbacks} - -@defform[(log-to id name callback)]{ - -Registers @racket[callback] under @racket[name]. Existing entry -with same name is replaced. - -Callback signature: - -@racketblock[ -(λ (topic level dt msg) ...) -] -} - -@section{Output helpers} - -@defform[(log-to-display id)]{ - -Registers @racket['display]. Output: - -@verbatim{topic:level:timestamp:message} -} - -@defform[(log-to-file id filename)]{ - -Registers @racket['file]. File opened with -@racket[#:exists 'replace]. One line per message, flushed. -} - -@section{Timestamp} - -@defproc[(iso-timestamp) string?]{ - -Returns @verbatim{YYYY-MM-DDTHH:MM:SS} using -@racket[seconds->date] and @racket[sprintf]. -} - -@section{Execution} - -Per logger thread: - -@itemlist[ - #:style 'ordered - @item{@racket[sync] receiver} - @item{extract level, msg, data} - @item{dispatch callbacks} -] - -Callbacks run sequentially in that thread. \ No newline at end of file