Unify finders naming.
This commit is contained in:
parent
25d0a806ce
commit
4893d1e7d5
6 changed files with 29 additions and 24 deletions
|
@ -42,7 +42,7 @@
|
||||||
|
|
||||||
;; Prints single card type records.
|
;; Prints single card type records.
|
||||||
(define (cards-print/type mb type)
|
(define (cards-print/type mb type)
|
||||||
(let* ((rmb (filter-members-by-predicate
|
(let* ((rmb (find-members-by-predicate
|
||||||
mb
|
mb
|
||||||
(lambda (mr)
|
(lambda (mr)
|
||||||
(and (brmember-active? mr)
|
(and (brmember-active? mr)
|
||||||
|
|
|
@ -276,7 +276,7 @@
|
||||||
(apply cards-export MB (-fname-))
|
(apply cards-export MB (-fname-))
|
||||||
(print "Cards export disabled with manually specified current month.")))
|
(print "Cards export disabled with manually specified current month.")))
|
||||||
((problems)
|
((problems)
|
||||||
(let ((num (let loop ((mb (members-base-members MB))
|
(let ((num (let loop ((mb (mbase-members MB))
|
||||||
(num 0))
|
(num 0))
|
||||||
(if (null? mb)
|
(if (null? mb)
|
||||||
num
|
num
|
||||||
|
|
|
@ -30,13 +30,18 @@
|
||||||
(
|
(
|
||||||
load-mbase
|
load-mbase
|
||||||
|
|
||||||
members-base-members
|
mbase-members
|
||||||
|
|
||||||
|
find-member-by-predicate
|
||||||
find-member-by-id
|
find-member-by-id
|
||||||
find-member-by-nick
|
find-member-by-nick
|
||||||
|
|
||||||
|
find-members-by-predicate
|
||||||
find-members-by-nick
|
find-members-by-nick
|
||||||
|
|
||||||
list-members-ids
|
list-members-ids
|
||||||
filter-members-by-predicate
|
|
||||||
list-members-nicks
|
list-members-nicks
|
||||||
|
|
||||||
members-base-info
|
members-base-info
|
||||||
members-base-stats
|
members-base-stats
|
||||||
get-free-members-ids
|
get-free-members-ids
|
||||||
|
@ -97,12 +102,12 @@
|
||||||
mb)))))))
|
mb)))))))
|
||||||
|
|
||||||
;; Returns the internal members list
|
;; Returns the internal members list
|
||||||
(define (members-base-members mb)
|
(define (mbase-members mb)
|
||||||
(ldict-ref mb 'members))
|
(ldict-ref mb 'members))
|
||||||
|
|
||||||
;; Gets member based by generic predicate
|
;; Gets member based by generic predicate
|
||||||
(define (find-member-by-predicate mb pred)
|
(define (find-member-by-predicate mb pred)
|
||||||
(let loop ((mdb (members-base-members mb)))
|
(let loop ((mdb (mbase-members mb)))
|
||||||
(if (null? mdb)
|
(if (null? mdb)
|
||||||
#f
|
#f
|
||||||
(let ((mr (car mdb)))
|
(let ((mr (car mdb)))
|
||||||
|
@ -130,7 +135,7 @@
|
||||||
|
|
||||||
;; Returns a list of members whose nick contains pat
|
;; Returns a list of members whose nick contains pat
|
||||||
(define (find-members-by-nick mb pat)
|
(define (find-members-by-nick mb pat)
|
||||||
(filter-members-by-predicate
|
(find-members-by-predicate
|
||||||
mb
|
mb
|
||||||
(lambda (mr)
|
(lambda (mr)
|
||||||
(substring-index pat (brmember-nick mr)))))
|
(substring-index pat (brmember-nick mr)))))
|
||||||
|
@ -138,11 +143,16 @@
|
||||||
;; Returns all ids found in the database
|
;; Returns all ids found in the database
|
||||||
(define (list-members-ids mb)
|
(define (list-members-ids mb)
|
||||||
(map (lambda (mr) (ldict-ref mr 'id))
|
(map (lambda (mr) (ldict-ref mr 'id))
|
||||||
(members-base-members mb)))
|
(mbase-members mb)))
|
||||||
|
|
||||||
|
;; Returns all nicks found in the database
|
||||||
|
(define (list-members-nicks mb)
|
||||||
|
(map (lambda (mr) (ldict-ref (ldict-ref mr 'info) 'nick))
|
||||||
|
(mbase-members mb)))
|
||||||
|
|
||||||
;; Returns a list of members which match given predicate.
|
;; Returns a list of members which match given predicate.
|
||||||
(define (filter-members-by-predicate mb pred)
|
(define (find-members-by-predicate mb pred)
|
||||||
(let loop ((mb (members-base-members mb))
|
(let loop ((mb (mbase-members mb))
|
||||||
(res '()))
|
(res '()))
|
||||||
(if (null? mb)
|
(if (null? mb)
|
||||||
res
|
res
|
||||||
|
@ -152,14 +162,9 @@
|
||||||
(cons mr res)
|
(cons mr res)
|
||||||
res))))))
|
res))))))
|
||||||
|
|
||||||
;; Returns all nicks found in the database
|
|
||||||
(define (list-members-nicks mb)
|
|
||||||
(map (lambda (mr) (ldict-ref (ldict-ref mr 'info) 'nick))
|
|
||||||
(members-base-members mb)))
|
|
||||||
|
|
||||||
;; Returns dictionary with statistics about the members base.
|
;; Returns dictionary with statistics about the members base.
|
||||||
(define (members-base-info mb-arg)
|
(define (members-base-info mb-arg)
|
||||||
(let* ((members (filter-members-by-predicate mb-arg brmember-usable?))
|
(let* ((members (find-members-by-predicate mb-arg brmember-usable?))
|
||||||
(di0 (make-ldict))
|
(di0 (make-ldict))
|
||||||
(di1 (ldict-set di0 'invalid
|
(di1 (ldict-set di0 'invalid
|
||||||
(filter (compose not is-4digit-prime? brmember-id) members)))
|
(filter (compose not is-4digit-prime? brmember-id) members)))
|
||||||
|
@ -220,7 +225,7 @@
|
||||||
(if (pred? mr)
|
(if (pred? mr)
|
||||||
(proc mr)
|
(proc mr)
|
||||||
mr))
|
mr))
|
||||||
(members-base-members mb))))
|
(mbase-members mb))))
|
||||||
|
|
||||||
;; Adds unpaired transaction to given members-base
|
;; Adds unpaired transaction to given members-base
|
||||||
(define (members-base-add-unpaired mb tr)
|
(define (members-base-add-unpaired mb tr)
|
||||||
|
@ -242,7 +247,7 @@
|
||||||
(lambda (mr)
|
(lambda (mr)
|
||||||
(brmember-info mr 'mail))
|
(brmember-info mr 'mail))
|
||||||
(filter brmember-active?
|
(filter brmember-active?
|
||||||
(members-base-members mb))))
|
(mbase-members mb))))
|
||||||
string-ci<?))
|
string-ci<?))
|
||||||
|
|
||||||
;; Merges given ML members into members base
|
;; Merges given ML members into members base
|
||||||
|
|
|
@ -216,7 +216,7 @@
|
||||||
;; Return members to notify because of late payments for more than
|
;; Return members to notify because of late payments for more than
|
||||||
;; given number of months
|
;; given number of months
|
||||||
(define (members-to-notify mb months)
|
(define (members-to-notify mb months)
|
||||||
(filter-members-by-predicate
|
(find-members-by-predicate
|
||||||
mb
|
mb
|
||||||
(lambda (mr)
|
(lambda (mr)
|
||||||
(let ((total (member-total-balance mr))
|
(let ((total (member-total-balance mr))
|
||||||
|
|
|
@ -225,14 +225,14 @@
|
||||||
#:row-border #t
|
#:row-border #t
|
||||||
#:col-border #t
|
#:col-border #t
|
||||||
)))
|
)))
|
||||||
(let ((pmrs (filter-members-by-predicate mb brmember-has-problems?)))
|
(let ((pmrs (find-members-by-predicate mb brmember-has-problems?)))
|
||||||
(when (not (null? pmrs))
|
(when (not (null? pmrs))
|
||||||
(newline)
|
(newline)
|
||||||
(print "Member files with errors (" (length pmrs) "): "
|
(print "Member files with errors (" (length pmrs) "): "
|
||||||
(string-intersperse
|
(string-intersperse
|
||||||
(map brmember-file-path pmrs)
|
(map brmember-file-path pmrs)
|
||||||
", "))))
|
", "))))
|
||||||
(let ((pmrs (filter-members-by-predicate mb (lambda (mr)
|
(let ((pmrs (find-members-by-predicate mb (lambda (mr)
|
||||||
(and (brmember-has-highlights? mr)
|
(and (brmember-has-highlights? mr)
|
||||||
(not (brmember-has-problems? mr)))))))
|
(not (brmember-has-problems? mr)))))))
|
||||||
(when (not (null? pmrs))
|
(when (not (null? pmrs))
|
||||||
|
@ -308,10 +308,10 @@
|
||||||
)))
|
)))
|
||||||
(sort
|
(sort
|
||||||
(if destroyed?
|
(if destroyed?
|
||||||
(members-base-members MB)
|
(mbase-members MB)
|
||||||
(filter (lambda (mr)
|
(filter (lambda (mr)
|
||||||
(not (brmember-destroyed? mr)))
|
(not (brmember-destroyed? mr)))
|
||||||
(members-base-members MB)))
|
(mbase-members MB)))
|
||||||
brmember<?)))
|
brmember<?)))
|
||||||
(balances (map (lambda (m)
|
(balances (map (lambda (m)
|
||||||
(list-ref m 6))
|
(list-ref m 6))
|
||||||
|
|
|
@ -88,7 +88,7 @@
|
||||||
(error 'gen-web-static "Directory is a file:" dir))
|
(error 'gen-web-static "Directory is a file:" dir))
|
||||||
(when (not (directory-exists? dir))
|
(when (not (directory-exists? dir))
|
||||||
(create-directory dir))
|
(create-directory dir))
|
||||||
(let* ((members-list (members-base-members mb))
|
(let* ((members-list (mbase-members mb))
|
||||||
(mlen0 (length members-list))
|
(mlen0 (length members-list))
|
||||||
(mlen (if (> mlen0 0)
|
(mlen (if (> mlen0 0)
|
||||||
mlen0
|
mlen0
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue