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

Parsing of amount in fee period specification.

Browse source
This commit is contained in:
Dominik Pantůček 2023-12-18 22:56:23 +01:00
parent 259a2664a0
commit 055f7ba030
2 changed files with 32 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

31
src/brmember-parser.scm
View file

@ -116,7 +116,23 @@
((student suspend member revision chair council grant fee)
(let* ((res (period-markers->cal-periods value))
(ok? (car res))
(periods (cadr res))
(periods0 (cadr res))
(periods
(if (eq? key 'fee)
(let ((ps
(map
(lambda (p)
(let* ((sc (cal-period-scomment p))
(scp (string-first+rest sc))
(amts (car scp))
(amt (string->number amts))
(rc (cdr scp)))
(set-cal-period-scomment
p
(list amt rc))))
periods0)))
ps)
periods0))
(msg (caddr res))
(line-number (cadddr res))
(mr1 (brmember-sub-set mr output key periods)))
@ -125,10 +141,10 @@
(brmember-add-highlight mr1 line-number msg 3 'error))))
((card desfire)
(brmember-sub-set mr output key
(map
(lambda (rec)
(string-first+rest (car rec)))
value)))
(map
(lambda (rec)
(string-first+rest (car rec)))
value)))
((credit)
(let loop ((mr mr)
(src-credits value)
@ -163,10 +179,7 @@
mr0 (cdr value) "Whitespace not allowed in nick" 3 'error)
mr0)))
(else
(brmember-sub-set mr output key (car value))))))
(fee
,(lambda (mr output key value)
mr))))
(brmember-sub-set mr output key (car value))))))))
;; Pass 4: Final checks - add defaults
(define (member-schema-finalize mr)

10
src/cal-period.scm
View file

@ -43,6 +43,8 @@
cal-period-before
cal-period-scomment
cal-period-bcomment
set-cal-period-scomment
period-markers->cal-periods
@ -142,6 +144,14 @@
(define cal-period-scomment cadddr)
(define cal-period-bcomment (compose cadddr cdr))
;; Direct updater
(define (set-cal-period-scomment p c)
(list TAG-CAL-PERIOD
(cal-period-since p)
(cal-period-before p)
c
(cal-period-bcomment p)))
;; Type predicate
(define (cal-period? p)
(and (pair? p)