brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Porting to new calendar modules.

Browse source
This commit is contained in:
Dominik Pantůček 2023-05-09 22:56:50 +02:00
parent 21a58e9536
commit cc463991c1
10 changed files with 57 additions and 545 deletions
Download patch file Download diff file Expand all files Collapse all files

22
src/brmember.scm
View file

@ -84,8 +84,8 @@
(chicken format)
util-dict-list
testing
month
period
cal-month
cal-period
configuration
primes
util-list
@ -273,14 +273,14 @@
(let ((member (brmember-info mr 'member)))
(if (null? member)
#f
(month>=? (*current-month*)
(period-since (car member)))))))
(cal-month>=? (*current-month*)
(cal-period-since (car member)))))))
;; Generic period-based predicate
(define ((member-period-predicate? key) mr)
(let ((periods (brmember-info mr key #f)))
(and periods
(month-in-periods? periods))))
(cal-month-in-periods? periods))))
;; Returns true if the member is now suspended
(define member-is-suspended?
@ -302,12 +302,12 @@
;; Returns true if the member is active (not suspended or destroyed).
(define (brmember-active? mr)
(and (month-in-periods? (brmember-info mr 'member))
(and (cal-month-in-periods? (brmember-info mr 'member))
(not (brmember-suspended? mr))))
;; Returns true if the member is currently a member
(define (brmember-existing? mr)
(month-in-periods?
(cal-month-in-periods?
(brmember-info mr 'member)))
;; Returns a list of flags of given member record.
@ -331,9 +331,9 @@
;; suspended.
(define (brmember-suspended-months mr)
(if (brmember-suspended? mr)
(let ((period (periods-match (brmember-info mr 'suspend))))
(let ((period (cal-periods-match (brmember-info mr 'suspend))))
(if period
(month-diff (car period) (*current-month*))
(cal-month-diff (cal-period-since period) (*current-month*))
0))
0))
@ -352,8 +352,8 @@
(define (brmember-payments mr)
(filter (lambda (tr)
(let* ((isodate (bank-transaction-date tr))
(month (iso-date->month isodate)))
(month<=? month (*current-month*))))
(month (iso-date->cal-month isodate)))
(cal-month<=? month (*current-month*))))
(ldict-ref mr 'payments '())))
;; Returns a list of MLs this member is subscribed to