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

Use new current month/day forms.

Browse source
This commit is contained in:
Dominik Pantůček 2023-06-22 21:51:08 +02:00
parent 03520fc63b
commit fc0d87cbdd
4 changed files with 51 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

82
src/brmember.scm
View file

@ -451,19 +451,21 @@
(make-ldict (make-ldict
'((highlights . ((123 "Interesting..." 0 info))))))) '((highlights . ((123 "Interesting..." 0 info)))))))
(test-true brmember-destroyed? (test-true brmember-destroyed?
(parameterize ((*current-month* (make-cal-month 2023 2))) (with-current-month
(make-cal-month 2023 2)
(brmember-destroyed?
(make-ldict `((info . ,(make-ldict
`((member . (,(make-cal-period
(make-cal-month 2010 1)
(make-cal-month 2010 5))))))))))))
(test-false brmember-destroyed?
(with-current-month
(make-cal-month 2009 2)
(brmember-destroyed? (brmember-destroyed?
(make-ldict `((info . ,(make-ldict (make-ldict `((info . ,(make-ldict
`((member . (,(make-cal-period `((member . (,(make-cal-period
(make-cal-month 2010 1) (make-cal-month 2001 1)
(make-cal-month 2010 5)))))))))))) (make-cal-month 2010 5))))))))))))
(test-false brmember-destroyed?
(parameterize ((*current-month* (make-cal-month 2009 2)))
(brmember-destroyed?
(make-ldict `((info . ,(make-ldict
`((member . (,(make-cal-period
(make-cal-month 2001 1)
(make-cal-month 2010 5))))))))))))
(test-false brmember-suspended? (test-false brmember-suspended?
(brmember-suspended? (brmember-suspended?
(make-ldict `((info . ,(make-ldict (make-ldict `((info . ,(make-ldict
@ -471,27 +473,30 @@
(make-cal-month 2015 1) (make-cal-month 2015 1)
#f)))))))))) #f))))))))))
(test-true brmember-suspended? (test-true brmember-suspended?
(parameterize ((*current-month* (make-cal-month 2015 2))) (with-current-month
(brmember-suspended? (make-cal-month 2015 2)
(make-ldict `((info . ,(make-ldict (brmember-suspended?
`((member . (,(make-cal-period (make-ldict `((info . ,(make-ldict
(make-cal-month 2015 1) `((member . (,(make-cal-period
#f))) (make-cal-month 2015 1)
(suspend ,(make-cal-period #f)))
(make-cal-month 2010 1) (suspend ,(make-cal-period
(make-cal-month 2022 4) #f #f))))))))))
(test-true brmember-suspended?
(parameterize ((*current-month* (make-cal-month 2015 2)))
(brmember-suspended?
(make-ldict `((info . ,(make-ldict
`((member . (,(make-cal-period
(make-cal-month 2015 1)
#f)))
(suspend (make-cal-period
(make-cal-month 2010 1) (make-cal-month 2010 1)
#f #f #f)))))))))) (make-cal-month 2022 4) #f #f))))))))))
(test-true brmember-suspended?
(with-current-month
(make-cal-month 2015 2)
(brmember-suspended?
(make-ldict `((info . ,(make-ldict
`((member . (,(make-cal-period
(make-cal-month 2015 1)
#f)))
(suspend (make-cal-period
(make-cal-month 2010 1)
#f #f #f))))))))))
(test-false brmember-suspended? (test-false brmember-suspended?
(parameterize ((*current-month* (make-cal-month 2023 2))) (with-current-month
(make-cal-month 2023 2)
(brmember-suspended? (brmember-suspended?
(make-ldict `((info . ,(make-ldict (make-ldict `((info . ,(make-ldict
`((member . (,(make-cal-period `((member . (,(make-cal-period
@ -501,16 +506,17 @@
(make-cal-month 2022 4) (make-cal-month 2022 4)
#f #f)))))))))) #f #f))))))))))
(test-true brmember-active? (test-true brmember-active?
(parameterize ((*current-month* (make-cal-month 2023 2))) (with-current-month
(brmember-active? (make-cal-month 2023 2)
(make-ldict `((info . ,(make-ldict (brmember-active?
`((member . (,(make-cal-period (make-ldict `((info . ,(make-ldict
(make-cal-month 2015 1) `((member . (,(make-cal-period
#f))) (make-cal-month 2015 1)
(suspend ,(make-cal-period #f)))
(make-cal-month 2010 1) (suspend ,(make-cal-period
(make-cal-month 2022 4) (make-cal-month 2010 1)
#f #f)))))))))) (make-cal-month 2022 4)
#f #f))))))))))
)) ))
) )

4
src/mbase.scm
View file

@ -236,8 +236,8 @@
(let mloop ((data '()) (let mloop ((data '())
(month (members-base-oldest-month mb))) (month (members-base-oldest-month mb)))
(if (cal-month<? month (*current-month*)) (if (cal-month<? month (*current-month*))
(let ((bi (parameterize ((*current-month* month)) (let ((bi (with-current-month month
(mbase-info mb)))) (mbase-info mb))))
(let kloop ((row (list (ldict-ref bi 'month))) (let kloop ((row (list (ldict-ref bi 'month)))
(keys (cdr keys))) (keys (cdr keys)))
(if (null? keys) (if (null? keys)

6
src/members-fees.scm
View file

@ -83,9 +83,9 @@
(reverse cal) (reverse cal)
(loop (cal-month-add cm) (loop (cal-month-add cm)
(cons (list cm (cons (list cm
(parameterize ((*current-month* cm) (with-current-month
(*current-day* (cal-ensure-day cm))) cm
(brmember-flags mr))) (brmember-flags mr)))
cal)))))) cal))))))
;; Returns the first month of the calendar ;; Returns the first month of the calendar

4
src/members-payments.scm
View file

@ -268,8 +268,8 @@
(bank-transaction-message bt) (bank-transaction-message bt)
(if (eq? curr 'CZK) (if (eq? curr 'CZK)
amt amt
(parameterize ((*current-month* (cal-ensure-month day))) (with-current-day day
(* amt (lookup-eur-rate)))) (* amt (lookup-eur-rate))))
"Payment"))) "Payment")))
bts)) bts))