-

info.rkt

@@ -0,0 +1,28 @@
+#lang info
+
+(define pkg-authors '(hnmdijkema))
+(define version "0.1.1")
+(define license 'Apache-2.0)   
+(define collection "simple-log")
+(define pkg-desc "simple-log - A simple wrapper around the racket logging system")
+
+(define scribblings
+  '(
+    ("scrbl/simple-log.scrbl" () (gui-library) "simple-log")
+    )
+  )
+
+(define deps
+ '("racket/base"
+   "racket-sprintf"
+   )
+  )
+
+(define build-deps
+  '("racket-doc"
+    "draw-doc"
+    "rackunit-lib"
+    "scribble-lib"
+    "net-doc"
+    ))
+

main.rkt

@@ -0,0 +1,125 @@
+#lang racket
+
+(require (for-syntax racket/syntax)
+         racket/date
+         racket-sprintf
+         )
+
+(provide def-log
+         log-to
+         log-to-file
+         log-to-display
+         )
+
+(define (iso-timestamp)
+  (let* ([d (seconds->date (current-seconds))])
+    (sprintf "%04d-%02d-%02dT%02d:%02d:%02d"
+            (date-year d)
+            (date-month d)
+            (date-day d)
+            (date-hour d)
+            (date-minute d)
+            (date-second d))))
+
+(define (log-to* receiver log-callbacks)
+  (void
+   (thread
+    (λ () (let loop ()
+            (let* ((v (sync receiver))
+                   (level (vector-ref v 0))
+                   (msg (vector-ref v 1))
+                   (data (vector-ref v 2))
+                   (dt (car data))
+                   (topic (cadr data))
+                   )
+              (for-each (λ (e)
+                          (let ((callback (cdr e)))
+                            (callback topic level dt msg)))
+                        (log-callbacks))
+              )
+            (loop)
+            )
+      )
+    )
+   )
+  )
+
+(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 log-to-display
+  (syntax-rules (display)
+    ((_ id)
+     (log-to id display
+             (λ (topic level dt msg)
+               (displayln (format "~a:~a:~a:~a" topic level dt msg)))
+             )
+     )
+    )
+  )
+
+(define-syntax log-to-file
+  (syntax-rules (file)
+    ((_ id 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))
+             )
+       )
+     )
+    )
+  )
+
+
+(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)))
+       (define (dbgn msg . args) (log 'debug msg args))
+       (define (infon msg . args) (log 'info msg args))
+       (define (warnn msg . args) (log 'warning msg args))
+       (define (errn msg . args) (log 'error msg args))
+       (define (fataln msg . args) (log 'fatal msg args))
+       (log-to* receiver (λ () log-callbacks))
+       )
+     )
+    )
+  )
+
+
+(define-syntax (def-log stx)
+  (syntax-case stx ()
+    ((_ 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)
+       )
+     )
+    ((_ id)
+     #'(def-log id (current-logger))
+     )
+    )
+  )
+

scrbl/.gitignore

@@ -0,0 +1,3 @@
+*.css
+*.html
+*.js

scrbl/simple-log.scrbl

@@ -0,0 +1,90 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/date
+                     racket/logging
+                     racket-sprintf))
+
+@defmodule{simple-log}
+
+@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 '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]}
+]
+
+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:
+
+@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.
+}

scrbl/simple-log.scrbl~

@@ -0,0 +1,109 @@
+#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.