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

Finish mbase renaming.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-13 20:19:11 +02:00
parent 8321c741dc
commit 0052dd0b75
4 changed files with 42 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

56
src/mbase.scm
View file

@ -53,9 +53,9 @@
mbase-add-unpaired
mbase-unpaired
members-base-active-emails
mbase-active-emails
members-base-merge-mailman
mbase-merge-mailman
)
(import scheme
@ -97,13 +97,13 @@
symlinks))
fss))
(mb1 (ldict-reduce (make-ldict)
(lambda (acc symfn mr)
(ldict-set acc (ldict-ref mr 'id) mr))
mb0))
(lambda (acc symfn mr)
(ldict-set acc (ldict-ref mr 'id) mr))
mb0))
(mb (ldict-reduce '()
(lambda (acc id mr)
(cons mr acc))
mb1)))
(lambda (acc id mr)
(cons mr acc))
mb1)))
mb)))))))
;; Returns the internal members list
@ -185,27 +185,27 @@
;; 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))))
'members
(map (lambda (mr)
(if (pred? mr)
(proc mr)
mr))
(mbase-members mb))))
;; 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)))
(filter (compose not is-4digit-prime? brmember-id) members)))
(di2 (ldict-set di1 'active
(filter brmember-active? members)))
(filter brmember-active? members)))
(di3 (ldict-set di2 'suspended
(filter brmember-suspended? members)))
(filter brmember-suspended? members)))
(di4 (ldict-set di3 'students
(filter brmember-student? members)))
(filter brmember-student? members)))
(di5 (ldict-set di4 'destroyed
(filter brmember-destroyed? members)))
(filter brmember-destroyed? members)))
(di6 (ldict-set di5 'month (*current-month*)))
(di7 (ldict-set di6 'total members)))
di7))
@ -234,8 +234,8 @@
;; Adds unpaired transaction to given members-base
(define (mbase-add-unpaired mb tr)
(ldict-set mb 'unpaired
(cons tr
(ldict-ref mb 'unpaired '()))))
(cons tr
(ldict-ref mb 'unpaired '()))))
;; Returns known unpaired transactions
(define (mbase-unpaired mb)
@ -243,7 +243,7 @@
;; Returns the list of emails of all active members sorted
;; alphabetically
(define (members-base-active-emails mb)
(define (mbase-active-emails mb)
(sort
(filter
string?
@ -255,16 +255,16 @@
string-ci<?))
;; Merges given ML members into members base
(define (members-base-merge-mailman mb ml)
(define (mbase-merge-mailman mb ml)
(let ((listname (car ml))
(emails (cdr ml)))
(foldl (lambda (mb email)
(mbase-update mb
(lambda (mr)
(equal? (brmember-info mr 'mail #f)
email))
(lambda (mr)
(brmember-add-mailman mr listname))))
(lambda (mr)
(equal? (brmember-info mr 'mail #f)
email))
(lambda (mr)
(brmember-add-mailman mr listname))))
mb
emails)))