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

grep -v added.

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-03 13:01:07 +02:00
parent 318620c854
commit 58da0a3d79
4 changed files with 83 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/store.rkt
+56 -30
View File
@@ -43,6 +43,29 @@
(define (level? l)
(memq l levels))
(define (invert-predicate pred invert?)
(if invert?
(lambda (item) (not (pred item)))
pred))
(define (topic-filter? value)
(or (symbol? value)
(regexp? value)
(and (list? value)
(andmap (lambda (item)
(or (symbol? item) (regexp? item)))
value))))
(define (topic-matches? topic filter)
(cond
((symbol? filter)
(eq? filter topic))
((regexp? filter)
(regexp-match? filter (symbol->string topic)))
((list? filter)
(ormap (lambda (item) (topic-matches? topic item)) filter))
(else #f)))
(define (copy-queue q pred)
(let ((nq (make-queue)))
(sequence-for-each
@@ -121,50 +144,53 @@
nq))))
(define/contract (sl-store-grep-topic store regexp)
(-> sl-store? (or/c symbol? regexp?) sl-store?)
(let ((nq (copy-queue (sl-store-queue store)
(λ (item)
(let ((topic (sl-store-item-topic item)))
(if (symbol? regexp)
(eq? regexp topic)
(regexp-match? regexp (symbol->string topic))))))))
(define/contract (sl-store-grep-topic store filter #:invert? [invert? #f])
(->* (sl-store? topic-filter?) (#:invert? boolean?) sl-store?)
(let ((nq (copy-queue
(sl-store-queue store)
(invert-predicate
(lambda (item)
(topic-matches? (sl-store-item-topic item) filter))
invert?))))
(make-sl-store* (sl-store-max-length store)
(queue-length nq)
nq)))
(define/contract (sl-store-grep-message store regexp)
(define/contract (sl-store-grep-message store regexp #:invert? [invert? #f])
(-> sl-store? regexp? sl-store?)
(let ((nq (copy-queue (sl-store-queue store)
(λ (item)
(let ((msg (sl-store-item-message item)))
(regexp-match? regexp msg))))))
(invert-predicate
(λ (item)
(let ((msg (sl-store-item-message item)))
(regexp-match? regexp msg)))
invert?))))
(make-sl-store* (sl-store-max-length store)
(queue-length nq)
nq)))
(define/contract (sl-store-grep store regexp)
(-> sl-store? (or/c symbol? regexp?) sl-store?)
(define/contract (sl-store-grep store value #:invert? [invert? #f])
(->* (sl-store? (or/c symbol? regexp?)) (#:invert? boolean?) sl-store?)
(let ((lvl (hash-ref log-hash
(if (regexp? regexp)
(level-regexp->level regexp #f)
(level-regexp->level (pregexp (symbol->string regexp)) #f))
(if (regexp? value)
(level-regexp->level value #f)
(level-regexp->level (pregexp (symbol->string value)) #f))
0)))
(define (matches? item)
(let ((topic (sl-store-item-topic item))
(level (hash-ref log-hash (sl-store-item-level item) 0))
(msg (sl-store-item-message item)))
(and (>= level lvl)
(or (if (symbol? value)
(if (level? value)
(or (>= level lvl) (eq? value topic))
(eq? value topic))
(regexp-match? value (symbol->string topic)))
(if (symbol? value)
#f
(regexp-match? value msg))))))
(let ((nq (copy-queue (sl-store-queue store)
(λ (item)
(let ((topic (sl-store-item-topic item))
(level (hash-ref log-hash (sl-store-item-level item) 0))
(msg (sl-store-item-message item)))
(and (>= level lvl)
(or (if (symbol? regexp)
(if (level? regexp)
(or (>= level lvl) (eq? regexp topic))
(eq? regexp topic))
(regexp-match? regexp (symbol->string topic)))
(if (symbol? regexp)
#f
(regexp-match? regexp msg)))))))))
(invert-predicate matches? invert?))))
(make-sl-store* (sl-store-max-length store)
(queue-length nq)
nq))))