Credit conversions.

This commit is contained in:
Dominik Pantůček 2023-03-16 21:21:39 +01:00
parent 342797575f
commit 0d20884637
2 changed files with 34 additions and 6 deletions

View file

@ -50,7 +50,7 @@ brmsaptool: $(BRMSAPTOOL-DEPS)
$(CSC) -o $@ $<
brmsaptool-static: $(BRMSAPTOOL-OBJS)
$(CSC) -static -k -o $@ $(BRMSAPTOOL-SOURCES)
$(CSC) -static -o $@ $(BRMSAPTOOL-SOURCES)
.PHONY: clean
clean:

View file

@ -176,10 +176,12 @@
;; Converts given key in member info dictionary from period markers
;; list to periods.
(define (convert-member-key:markers->periods m k)
(dict-set m k
(period-markers->periods
(sort-period-markers
(dict-ref m k '())))))
(if (dict-has-key? m k)
(dict-set m k
(period-markers->periods
(sort-period-markers
(dict-ref m k '()))))
m))
;; Converts all given keys using period-markers->periods.
(define (convert-member-keys:markers->periods m . ks)
@ -190,6 +192,32 @@
(loop (convert-member-key:markers->periods m (car ks))
(cdr ks)))))
;; Credit values contain amount as the first token. Anything after
;; the first whitespace character is added as label of the credit
;; transaction. The result is cons of number and string.
(define (convert-member-value:credit v)
(let* ((va (string-split v))
(v0 (car va))
(vr (substring v (string-length v0))))
(cons (string->number v0)
vr)))
;; If member information dictionary contains 'credit, all elements of
;; the list under this key are converted to cons of number (amount)
;; and string (label / description).
(define (convert-member-key:credit m)
(if (dict-has-key? m 'credit)
(dict-set m 'credit
(reverse
(map convert-member-value:credit
(dict-ref m 'credit))))
m))
;; All conversions in one place
(define (convert-member-keys m)
(convert-member-key:credit
(convert-member-keys:markers->periods m 'suspend 'student)))
;; Fills-in the defaults
(define (make-default-member-info)
(dict-set
@ -204,7 +232,7 @@
(r (make-default-member-info))
(line-number 1))
(if (null? ls)
(convert-member-keys:markers->periods r 'suspend 'student)
(convert-member-keys r)
(let ((p (split-member-line (car ls) file-name lines line-number)))
(loop (cdr ls)
(if p