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

Split out mbase-stats into separate query module.

Browse source
This commit is contained in:
Dominik Pantůček 2025-01-02 15:06:32 +01:00
parent e02853edc7
commit b25fbd407d
5 changed files with 117 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

43
src/mbase.scm
View file

@ -50,8 +50,6 @@
mbase-update-by-id
mbase-update
mbase-stats
mbase-add-unpaired
mbase-unpaired
@ -207,47 +205,6 @@
(proc mr)
mr)))))
;; Returns dictionary with statistics about the members base.
(define (mbase-info mb-arg)
(let* ((members (find-members-by-predicate mb-arg brmember-usable?))
(di0 (make-ldict))
(di1 (ldict-set di0 'invalid
(filter (compose not is-4digit-prime? brmember-id) members)))
(di2 (ldict-set di1 'active
(filter brmember-active? members)))
(di3 (ldict-set di2 'suspended
(filter brmember-suspended? members)))
(di4 (ldict-set di3 'students
(filter brmember-student? members)))
(di5 (ldict-set di4 'destroyed
(filter brmember-destroyed? members)))
(di6 (ldict-set di5 'month (*current-month*)))
(di7 (ldict-set di6 'total members))
(di8 (ldict-set di7 'problems
(find-members-by-predicate mb-arg brmember-has-problems?))))
di8))
(define (members-base-oldest-month mb)
(make-cal-month 2015 1))
;; Returns a list two lists: keys, data.
;; Each data record contains values for all keys.
(define (mbase-stats mb)
(let ((keys '(month total active suspended students destroyed invalid)))
(let mloop ((data '())
(month (members-base-oldest-month mb)))
(if (cal-month<=? month (*current-month*))
(let ((bi (with-current-month month
(mbase-info mb))))
(let kloop ((row (list (ldict-ref bi 'month)))
(keys (cdr keys)))
(if (null? keys)
(mloop (cons (reverse row) data)
(cal-month-add month 1))
(kloop (cons (length (ldict-ref bi (car keys))) row)
(cdr keys)))))
(list keys (reverse data))))))
;; Adds unpaired transaction to given members-base
(define (mbase-add-unpaired mb tr)
(ldict-set mb 'unpaired