All member record predicates.

This commit is contained in:
Dominik Pantůček 2023-03-25 20:31:54 +01:00
parent dcbac91f55
commit 4dac92b197

View file

@ -30,12 +30,23 @@
member2-record
(
make-member-record
member-record-input-file
member-record-set
member-record-add-highlight
member-record-sub-ref
member-record-sub-set
member-record-sub-prepend
member-record-info
member-destroyed?
member-suspended?
member-active?
member-student?
member-existing?
member-record-tests!
)
@ -43,7 +54,10 @@
(chicken base)
(chicken keyword)
dictionary
testing)
testing
month
period
configuration)
;; Creates new member record based on the file and symlinks
;; information received from the members directory. Any keyword
@ -109,6 +123,56 @@
(cons val
(member-record-sub-ref mr sec key '()))))
;; Returns member info key value
(define (member-record-info mr key . defaults)
(let ((info (dict-ref mr 'info)))
(if (null? defaults)
(dict-ref info key)
(dict-ref info key (car defaults)))))
;; Returns true if the member record represents destroyed member. The
;; *current-month* is a global parameter from period module.
(define (member-destroyed? mr)
(let ((destroyed (member-record-info mr 'destroyed #f)))
(and destroyed
(month<? (string->month destroyed)
(*current-month*)))))
;; Generic period-based predicate
(define ((member-period-predicate? key) mr)
(let ((periods (member-record-info mr key #f)))
(and periods
(month-in-periods? periods))))
;; Returns true if the member is now suspended
(define member-is-suspended?
(member-period-predicate? 'suspend))
;; Suspended must not be destroyed
(define (member-suspended? mr)
(and (member-is-suspended? mr)
(not (member-destroyed? mr))))
;; True if the member is student
(define member-is-student?
(member-period-predicate? 'student))
;; Only active members can be students.
(define (member-student? mr)
(and (member-active? mr)
(member-is-student? mr)))
;; Returns true if the member is active (not suspended or destroyed).
(define (member-active? mr)
(and (not (member-destroyed? mr))
(not (member-suspended? mr))))
;; Returns true if the member has joined.
(define (member-existing? mr)
(let ((joined (member-record-info mr 'joined)))
(and joined
(month<=? joined (*current-month*)))))
;; Self-tests
(define (member-record-tests!)
(run-tests