Id extraction and filtering.

This commit is contained in:
Dominik Pantůček 2023-03-19 08:00:42 +01:00
parent faf18b928e
commit 2c96707029
2 changed files with 21 additions and 7 deletions

View file

@ -46,6 +46,7 @@
(chicken irregex)
(chicken sort)
(chicken string)
(chicken format)
testing
utils
dictionary
@ -247,16 +248,26 @@
(string-intersperse
(map member-nick mrs) s)))
;; To aid in printing lists of records
(define (member-records->ids+nicks-string mrs . sl)
(let ((s (if (null? sl)
", "
(car sl))))
(string-intersperse
(map (lambda (mr)
(sprintf "~A (~A)"
(member-id mr)
(member-nick mr)))
mrs))))
;; Basic information about members-base in human-readable form.
(define (print-members-base-info mb)
(let ((nicks (list-members-nicks mb))
(ids (list-members-ids mb)))
(print "Known members: "
(length nicks))
(print "Total IDs: "
(length ids)
" (" (length (filter is-4digit-prime? ids)) " valid)")
(let ((invalid-ids (filter (compose not is-4digit-prime?) ids))
(invalid-mrs (filter-members-by-predicate mb (compose not is-4digit-prime? member-id)))
(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-destroyed?))
@ -270,10 +281,8 @@
(print a:highlight " Students (" (length student-mrs) "): " a:default
(member-records->nicks-string student-mrs))
(when (not (null? invalid-ids))
(print a:error " Invalid (" (length invalid-ids) "): "
(string-intersperse
(map number->string invalid-ids)
", ")
(print a:error " Invalid Id (" (length invalid-mrs) "): "
(member-records->ids+nicks-string invalid-mrs)
a:default)))))
;; Performs self-tests of this module.