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

10
src/cal-period.scm
View file

@ -43,6 +43,8 @@
cal-period-before cal-period-before
cal-period-scomment cal-period-scomment
cal-period-bcomment cal-period-bcomment
set-cal-period-scomment
period-markers->cal-periods period-markers->cal-periods
@ -142,6 +144,14 @@
(define cal-period-scomment cadddr) (define cal-period-scomment cadddr)
(define cal-period-bcomment (compose cadddr cdr)) (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 ;; Type predicate
(define (cal-period? p) (define (cal-period? p)
(and (pair? p) (and (pair? p)