diff --git a/member2-record.scm b/member2-record.scm index 66b9e61..016dc40 100644 --- a/member2-record.scm +++ b/member2-record.scm @@ -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 + (monthmonth 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