Finish total debit milestone.

This commit is contained in:
Dominik Pantůček 2023-03-29 23:16:45 +02:00
parent d9d37daf1d
commit cf4652084f
5 changed files with 20 additions and 11 deletions

View file

@ -45,7 +45,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
members-dir) members-dir)
;; Print banner ;; Print banner
(print "bbstool 0.5 (c) 2023 Brmlab, z.s.") (print "bbstool 0.6 (c) 2023 Brmlab, z.s.")
(newline) (newline)
;; Command-line options and configurable parameters ;; Command-line options and configurable parameters

View file

@ -30,7 +30,6 @@
( (
*current-month* *current-month*
*member-file-context* *member-file-context*
*member-default-joined*
*member-suspend-max-months* *member-suspend-max-months*
) )
@ -50,10 +49,6 @@
;; Configuration of error reporting ;; Configuration of error reporting
(define *member-file-context* (make-parameter 3)) (define *member-file-context* (make-parameter 3))
;; Default as specified by the original implementation if the 'joined
;; key is missing in member file.
(define *member-default-joined* (make-parameter (make-month 2015 1)))
;; How long the member can be suspended without any action required? ;; How long the member can be suspended without any action required?
(define *member-suspend-max-months* (make-parameter 24)) (define *member-suspend-max-months* (make-parameter 24))

View file

@ -132,7 +132,6 @@
(apply (apply
member-record-sub-ensure member-record-sub-ensure
mr 'info mr 'info
'member (list (make-period (*member-default-joined*) #f))
(join (map (lambda (mk) (list mk #f)) mandatory-keys)))) (join (map (lambda (mk) (list mk #f)) mandatory-keys))))
;; Pass 0: Removes any comments and removes any leading and trailing ;; Pass 0: Removes any comments and removes any leading and trailing

View file

@ -45,6 +45,7 @@
member-record-info member-record-info
member-missing-keys member-missing-keys
member-has-highlights? member-has-highlights?
member-record-usable?
member-has-problems? member-has-problems?
member-destroyed? member-destroyed?
@ -221,16 +222,26 @@
(define (member-has-errors? mr) (define (member-has-errors? mr)
(member-highlights-has-type? mr 'error)) (member-highlights-has-type? mr 'error))
;; Absolutely required
(define (member-record-usable? mr)
(dict-has-key? (dict-ref mr 'info) 'member))
;; True if member record is OK ;; True if member record is OK
(define (member-has-problems? mr) (define (member-has-problems? mr)
(or (member-has-errors? mr) (or (member-has-errors? mr)
(not (member-record-usable? mr))
(not (is-4digit-prime? (member-id mr))))) (not (is-4digit-prime? (member-id mr)))))
;; Returns true if the member record represents non-existing ;; Returns true if the member record represents non-existing
;; member. The *current-month* is a global parameter from period ;; member. The *current-month* is a global parameter from period
;; module. ;; module.
(define (member-destroyed? mr) (define (member-destroyed? mr)
(not (member-existing? mr))) (and (not (member-existing? mr))
(let ((member (member-record-info mr 'member)))
(if (null? member)
#f
(month>=? (*current-month*)
(period-since (car member)))))))
;; Generic period-based predicate ;; Generic period-based predicate
(define ((member-period-predicate? key) mr) (define ((member-period-predicate? key) mr)

View file

@ -133,8 +133,9 @@
(map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) mb)) (map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) mb))
;; Returns dictionary with statistics about the members base. ;; Returns dictionary with statistics about the members base.
(define (members-base-info mb) (define (members-base-info mb-arg)
(let* ((di0 (make-dict)) (let* ((mb (filter-members-by-predicate mb-arg member-record-usable?))
(di0 (make-dict))
(di1 (dict-set di0 'invalid (di1 (dict-set di0 'invalid
(filter-members-by-predicate mb (filter-members-by-predicate mb
(compose not is-4digit-prime? member-id)))) (compose not is-4digit-prime? member-id))))
@ -150,12 +151,15 @@
(di7 (dict-set di6 'total mb))) (di7 (dict-set di6 'total mb)))
di7)) di7))
(define (members-base-oldest-month mb)
(make-month 2015 1))
;; Returns a list two lists: keys, data. ;; Returns a list two lists: keys, data.
;; Each data record contains values for all keys. ;; Each data record contains values for all keys.
(define (members-base-stats mb) (define (members-base-stats mb)
(let ((keys '(month total active suspended students destroyed invalid))) (let ((keys '(month total active suspended students destroyed invalid)))
(let mloop ((data '()) (let mloop ((data '())
(month (*member-default-joined*))) (month (members-base-oldest-month mb)))
(if (month<? month (*current-month*)) (if (month<? month (*current-month*))
(let ((bi (parameterize ((*current-month* month)) (let ((bi (parameterize ((*current-month* month))
(members-base-info mb)))) (members-base-info mb))))