Rename info and stats.

This commit is contained in:
Dominik Pantůček 2023-04-13 20:15:43 +02:00
parent e4ad273b06
commit e54e4bd016
4 changed files with 26 additions and 22 deletions

View file

@ -256,7 +256,7 @@
(newline)
(parameterize ((current-output-port (open-output-file (-fname-))))
(print-members-base-stats
(members-base-stats MB))))
(mbase-stats MB))))
((print-member-file)
(cond (mr
(newline)

View file

@ -45,12 +45,16 @@
mbase-free-ids
mbase-gen-id
members-base-info
members-base-stats
members-base-update
mbase-update
mbase-info
mbase-stats
members-base-add-unpaired
members-base-unpaired
members-base-active-emails
members-base-merge-mailman
)
@ -177,8 +181,19 @@
(vfids (list->vector fids)))
(vector-ref vfids (pseudo-random-integer (vector-length vfids)))))
;; Returns new members base with member records matching the
;; predicate processed by proc.
(define (mbase-update mb pred? proc)
(ldict-set mb
'members
(map (lambda (mr)
(if (pred? mr)
(proc mr)
mr))
(mbase-members mb))))
;; Returns dictionary with statistics about the members base.
(define (members-base-info mb-arg)
(define (mbase-info mb-arg)
(let* ((members (find-members-by-predicate mb-arg brmember-usable?))
(di0 (make-ldict))
(di1 (ldict-set di0 'invalid
@ -200,13 +215,13 @@
;; Returns a list two lists: keys, data.
;; Each data record contains values for all keys.
(define (members-base-stats mb)
(define (mbase-stats mb)
(let ((keys '(month total active suspended students destroyed invalid)))
(let mloop ((data '())
(month (members-base-oldest-month mb)))
(if (month<? month (*current-month*))
(let ((bi (parameterize ((*current-month* month))
(members-base-info mb))))
(mbase-info mb))))
(let kloop ((row (list (ldict-ref bi 'month)))
(keys (cdr keys)))
(if (null? keys)
@ -216,17 +231,6 @@
(cdr keys)))))
(list keys (reverse data))))))
;; Returns new members base with member records matching the
;; predicate processed by proc.
(define (members-base-update mb pred? proc)
(ldict-set mb
'members
(map (lambda (mr)
(if (pred? mr)
(proc mr)
mr))
(mbase-members mb))))
;; Adds unpaired transaction to given members-base
(define (members-base-add-unpaired mb tr)
(ldict-set mb 'unpaired
@ -255,7 +259,7 @@
(let ((listname (car ml))
(emails (cdr ml)))
(foldl (lambda (mb email)
(members-base-update mb
(mbase-update mb
(lambda (mr)
(equal? (brmember-info mr 'mail #f)
email))

View file

@ -96,7 +96,7 @@
(varsym-id (transaction-extract-member-id transaction))
(bmember (find-member-by-id mb varsym-id)))
(loop (if bmember
(members-base-update
(mbase-update
mb
(lambda (mr)
(compare-member-id (brmember-id mr) varsym-id))
@ -162,7 +162,7 @@
(idx 0)
(accounts all-accounts))
(if (null? accounts)
(let ((mb (members-base-update mb identity member-sort-payments)))
(let ((mb (mbase-update mb identity member-sort-payments)))
(progress%-advance 1)
mb)
(let ()

View file

@ -194,7 +194,7 @@
;; Prints nicely aligned members base info
(define (print-members-base-table mb)
(let* ((bi (members-base-info mb))
(let* ((bi (mbase-info mb))
(all-mrs (ldict-ref bi 'total))
(invalid-mrs (ldict-ref bi 'invalid))
(active-mrs (ldict-ref bi 'active))