Record filtering and basic property retrieval.

This commit is contained in:
Dominik Pantůček 2023-03-18 16:36:09 +01:00
parent 9e12a43307
commit 637128ae92
2 changed files with 25 additions and 1 deletions

View file

@ -33,6 +33,7 @@
member-destroyed? member-destroyed?
member-suspended? member-suspended?
member-active? member-active?
member-nick
member-record-tests! member-record-tests!
) )
@ -100,6 +101,10 @@
(and (not (member-destroyed? mr)) (and (not (member-destroyed? mr))
(not (member-suspended? mr)))) (not (member-suspended? mr))))
;; Nickname as string
(define (member-nick mr)
(mr-ref mr 'nick))
;; Performs module self-tests. ;; Performs module self-tests.
(define (member-record-tests!) (define (member-record-tests!)
(run-tests (run-tests

View file

@ -222,6 +222,18 @@
(define (list-members-ids mb) (define (list-members-ids mb)
(map (lambda (mr) (dict-ref mr 'id)) mb)) (map (lambda (mr) (dict-ref mr 'id)) mb))
;; Returns a list of members which match given predicate.
(define (filter-members-by-predicate mb pred)
(let loop ((mb mb)
(res '()))
(if (null? mb)
res
(let ((mr (car mb)))
(loop (cdr mb)
(if (pred mr)
(cons mr res)
res))))))
;; Returns all nicks found in the database ;; Returns all nicks found in the database
(define (list-members-nicks mb) (define (list-members-nicks mb)
(map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) mb)) (map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) mb))
@ -241,7 +253,14 @@
(print "Total IDs: " (print "Total IDs: "
(length ids) (length ids)
" (" (length (filter is-4digit-prime? ids)) " valid)") " (" (length (filter is-4digit-prime? ids)) " valid)")
(let ((invalid-ids (filter (compose not is-4digit-prime?) ids))) (let ((invalid-ids (filter (compose not is-4digit-prime?) ids))
(active-mrs (filter-members-by-predicate mb member-active?))
(suspended-mrs (filter-members-by-predicate mb member-suspended?))
(destroyed-mrs (filter-members-by-predicate mb member-suspended?)))
(print " Active (" (length active-mrs) "): "
(string-intersperse
(map member-nick active-mrs)
", "))
(when (not (null? invalid-ids)) (when (not (null? invalid-ids))
(print " Invalid (" (length invalid-ids) "): " (print " Invalid (" (length invalid-ids) "): "
(string-intersperse (string-intersperse