Stream line highlights queries.

This commit is contained in:
Dominik Pantůček 2023-03-28 11:55:14 +02:00
parent 68c2d2e11b
commit bb970b6eb9
3 changed files with 20 additions and 16 deletions

View file

@ -44,7 +44,7 @@
member-record-info
member-missing-keys
member-highlights?
member-valid?
member-has-issues?
member-destroyed?
member-suspended?
@ -203,10 +203,23 @@
(define (member-highlights? mr)
(dict-has-key? mr 'highlights))
;; Returns true if there is at least one highlight of given type
(define (member-highlights-has-type? mr type)
(let loop ((hls (dict-ref mr 'highlights '())))
(if (null? hls)
#f
(if (eq? (cadddr (car hls)) type)
#t
(loop (cdr hls))))))
;; Returns true if there is at least one highlight with error type
(define (member-has-errors? mr)
(member-highlights-has-type? mr 'error))
;; True if member record is OK
(define (member-valid? mr)
(and (not (member-highlights? mr))
(is-4digit-prime? (member-id mr))))
(define (member-has-issues? mr)
(or (member-has-errors? mr)
(not (is-4digit-prime? (member-id mr)))))
;; Returns true if the member record represents destroyed member. The
;; *current-month* is a global parameter from period module.