All member record predicates.
This commit is contained in:
parent
dcbac91f55
commit
4dac92b197
1 changed files with 65 additions and 1 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue