hans/simple-log
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Internal definitions other

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-29 00:17:13 +02:00
parent 2ce843b5be
commit 712fda3af8
1 changed files with 56 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files
main.rkt
+56 -42
View File
@@ -3,6 +3,7 @@
(require (for-syntax racket/syntax)
racket/date
racket-sprintf
racket/async-channel
data/queue
)
@@ -44,7 +45,8 @@
(set! log-level 'debug)
(define max-log-queue-len 1000)
(define log-queue (make-queue))
(define log-queue (make-async-channel))
(define buffer-queue (make-queue))
(define (sl-set-log-level l)
(if (or
@@ -81,52 +83,64 @@
(l (hash-ref log-hash level 6)))
(>= l ll)))
(define logger-thread
(thread
(λ () (let loop ()
(let* ((v (sync log-queue))
(level (vector-ref v 0))
(msg (vector-ref v 1))
(data (vector-ref v 2))
(dt (car data))
(topic (cadr data))
(lc log-callbacks)
)
(when (string=? msg "@@SYNC@@")
(let ((sem (hash-ref sync-sems topic #f)))
(if (eq? sem #f)
(begin
(set! msg (format "Cannot synchronize on topic ~a" topic))
(set! level 'error))
(begin
(semaphore-post sem)
(set! msg (format "Synchronization received on topic ~a" topic))
(set! level 'info)
)
)))
(if (null? lc)
(enqueue! buffer-queue (list topic level dt msg))
(begin
(when (> (queue-length buffer-queue) 0)
(for-each (λ (log-entry)
(when (needs-logging (cadr log-entry))
(for-each (λ (e)
(let ((callback (cdr e)))
(apply callback log-entry)))
lc)))
(queue->list buffer-queue))
(set! buffer-queue (make-queue)))
(when (needs-logging level)
(for-each (λ (e)
(let ((callback (cdr e)))
(callback topic level dt msg)))
lc))
)
)
(loop))))
)
)
(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))
(lc (log-callbacks))
)
(when (string=? msg "@@SYNC@@")
(let ((sem (hash-ref sync-sems topic #f)))
(if (eq? sem #f)
(begin
(set! msg (format "Cannot synchronize on topic ~a" topic))
(set! level 'error))
(begin
(semaphore-post sem)
(set! msg (format "Synchronization received on topic ~a" topic))
(set! level 'info)
)
)))
(enqueue! log-queue (list topic level dt msg))
(unless (null? lc)
(for-each (λ (log-entry)
(when (needs-logging (cadr 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))
)
(let* ((v (sync receiver)))
(async-channel-put log-queue v))
(loop)
)
)
)
)
)
)))
))
(define-syntax sl-log-to
(syntax-rules (log-callbacks)