Finish the migration.

This commit is contained in:
Dominik Pantůček 2023-04-09 20:39:59 +02:00
parent ced789ca06
commit 0d649c2fd0
4 changed files with 70 additions and 70 deletions

View file

@ -36,7 +36,7 @@
(chicken sort) (chicken sort)
(chicken format) (chicken format)
(chicken irregex) (chicken irregex)
dictionary util-dict-list
members-base members-base
member-record) member-record)
@ -46,12 +46,12 @@
mb mb
(lambda (mr) (lambda (mr)
(and (member-active? mr) (and (member-active? mr)
(dict-has-key? (dict-ref mr 'info) type) (ldict-contains? (ldict-ref mr 'info) type)
(not (null? (dict-ref (dict-ref mr 'info) type))))))) (not (null? (ldict-ref (ldict-ref mr 'info) type)))))))
(recs (map (lambda (mr) (recs (map (lambda (mr)
(let ((mi (dict-ref mr 'info))) (let ((mi (ldict-ref mr 'info)))
(cons (dict-ref mi 'nick) (cons (ldict-ref mi 'nick)
(dict-ref mi type)))) (ldict-ref mi type))))
rmb)) rmb))
(srecs (sort recs (srecs (sort recs
(lambda (a b) (lambda (a b)

View file

@ -54,7 +54,7 @@
(chicken sort) (chicken sort)
testing testing
util-list util-list
dictionary util-dict-list
primes primes
member-record member-record
ansi ansi
@ -71,25 +71,25 @@
(define (load-members dn . opts) (define (load-members dn . opts)
(let ((progress? (and (not (null? opts)) (let ((progress? (and (not (null? opts))
(car opts)))) (car opts))))
(make-dict (make-ldict
`((members `((members
. .
,(with-progress% ,(with-progress%
progress? "members" progress? "members"
(let* ((fss (load-members-dir dn)) (let* ((fss (load-members-dir dn))
(tot (sub1 (length (dict-keys fss)))) (tot (sub1 (length (ldict-keys fss))))
(mb0 (dict-map (mb0 (ldict-map
(lambda (symfn symlinks prg) (lambda (symfn symlinks prg)
(progress%-advance (/ prg tot)) (progress%-advance (/ prg tot))
(members-dir-load-member dn (members-dir-load-member dn
symfn symfn
symlinks)) symlinks))
fss)) fss))
(mb1 (dict-reduce (make-dict) (mb1 (ldict-reduce (make-ldict)
(lambda (acc symfn mr) (lambda (acc symfn mr)
(dict-set acc (dict-ref mr 'id) mr)) (ldict-set acc (ldict-ref mr 'id) mr))
mb0)) mb0))
(mb (dict-reduce '() (mb (ldict-reduce '()
(lambda (acc id mr) (lambda (acc id mr)
(cons mr acc)) (cons mr acc))
mb1))) mb1)))
@ -97,7 +97,7 @@
;; Returns the internal members list ;; Returns the internal members list
(define (members-base-members mb) (define (members-base-members mb)
(dict-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)
@ -114,7 +114,7 @@
(find-member-by-predicate (find-member-by-predicate
mb mb
(lambda (mr) (lambda (mr)
(eq? (dict-ref mr 'id) id)))) (eq? (ldict-ref mr 'id) id))))
;; Returns member record found by id ;; Returns member record found by id
(define (find-member-by-nick mb nick) (define (find-member-by-nick mb nick)
@ -122,8 +122,8 @@
mb mb
(lambda (mr) (lambda (mr)
(string-ci=? (string-ci=?
(dict-ref (ldict-ref
(dict-ref mr 'info) (ldict-ref mr 'info)
'nick) 'nick)
nick)))) nick))))
@ -136,7 +136,7 @@
;; 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) (dict-ref mr 'id)) (map (lambda (mr) (ldict-ref mr 'id))
(members-base-members mb))) (members-base-members mb)))
;; Returns a list of members which match given predicate. ;; Returns a list of members which match given predicate.
@ -153,25 +153,25 @@
;; Returns all nicks found in the database ;; Returns all nicks found in the database
(define (list-members-nicks mb) (define (list-members-nicks mb)
(map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) (map (lambda (mr) (ldict-ref (ldict-ref mr 'info) 'nick))
(members-base-members mb))) (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 member-record-usable?)) (let* ((members (filter-members-by-predicate mb-arg member-record-usable?))
(di0 (make-dict)) (di0 (make-ldict))
(di1 (dict-set di0 'invalid (di1 (ldict-set di0 'invalid
(filter (compose not is-4digit-prime? member-id) members))) (filter (compose not is-4digit-prime? member-id) members)))
(di2 (dict-set di1 'active (di2 (ldict-set di1 'active
(filter member-active? members))) (filter member-active? members)))
(di3 (dict-set di2 'suspended (di3 (ldict-set di2 'suspended
(filter member-suspended? members))) (filter member-suspended? members)))
(di4 (dict-set di3 'students (di4 (ldict-set di3 'students
(filter member-student? members))) (filter member-student? members)))
(di5 (dict-set di4 'destroyed (di5 (ldict-set di4 'destroyed
(filter member-destroyed? members))) (filter member-destroyed? members)))
(di6 (dict-set di5 'month (*current-month*))) (di6 (ldict-set di5 'month (*current-month*)))
(di7 (dict-set di6 'total members))) (di7 (ldict-set di6 'total members)))
di7)) di7))
(define (members-base-oldest-month mb) (define (members-base-oldest-month mb)
@ -186,12 +186,12 @@
(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))))
(let kloop ((row (list (dict-ref bi 'month))) (let kloop ((row (list (ldict-ref bi 'month)))
(keys (cdr keys))) (keys (cdr keys)))
(if (null? keys) (if (null? keys)
(mloop (cons (reverse row) data) (mloop (cons (reverse row) data)
(month-add month 1)) (month-add month 1))
(kloop (cons (length (dict-ref bi (car keys))) row) (kloop (cons (length (ldict-ref bi (car keys))) row)
(cdr keys))))) (cdr keys)))))
(list keys (reverse data)))))) (list keys (reverse data))))))
@ -213,7 +213,7 @@
;; Returns new members base with member records matching the ;; Returns new members base with member records matching the
;; predicate processed by proc. ;; predicate processed by proc.
(define (members-base-update mb pred? proc) (define (members-base-update mb pred? proc)
(dict-set mb (ldict-set mb
'members 'members
(map (lambda (mr) (map (lambda (mr)
(if (pred? mr) (if (pred? mr)
@ -223,13 +223,13 @@
;; 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)
(dict-set mb 'unpaired (ldict-set mb 'unpaired
(cons tr (cons tr
(dict-ref mb 'unpaired '())))) (ldict-ref mb 'unpaired '()))))
;; Returns known unpaired transactions ;; Returns known unpaired transactions
(define (members-base-unpaired mb) (define (members-base-unpaired mb)
(dict-ref mb 'unpaired '())) (ldict-ref mb 'unpaired '()))
;; Returns the list of emails of all active members sorted ;; Returns the list of emails of all active members sorted
;; alphabetically ;; alphabetically

View file

@ -48,7 +48,7 @@
member-record member-record
members-base members-base
bank-fio bank-fio
dictionary util-dict-list
member-fees member-fees
period period
configuration configuration
@ -178,16 +178,16 @@
;; Adds all balances - payments are converted to CZK in member-payments-total ;; Adds all balances - payments are converted to CZK in member-payments-total
(define (member-sort-payments mr) (define (member-sort-payments mr)
(dict-set mr (ldict-set mr
'payments 'payments
(sort (dict-ref mr 'payments '()) (sort (ldict-ref mr 'payments '())
(lambda (a b) (lambda (a b)
(string<? (bank-transaction-date a) (string<? (bank-transaction-date a)
(bank-transaction-date b)))))) (bank-transaction-date b))))))
;; Balances totals ;; Balances totals
(define (member-balance mr) (define (member-balance mr)
(make-dict `((fees . ,(member-fees-total mr)) (make-ldict `((fees . ,(member-fees-total mr))
(credit . ,(member-credit-total mr)) (credit . ,(member-credit-total mr))
(payment . ,(member-payments-total mr))))) (payment . ,(member-payments-total mr)))))
@ -195,9 +195,9 @@
;; information ;; information
(define (member-total-balance mr) (define (member-total-balance mr)
(let* ((bal (member-balance mr)) (let* ((bal (member-balance mr))
(fees (dict-ref bal 'fees 0)) (fees (ldict-ref bal 'fees 0))
(credit (dict-ref bal 'credit 0)) (credit (ldict-ref bal 'credit 0))
(payment (dict-ref bal 'payment))) (payment (ldict-ref bal 'payment)))
(- (+ credit payment) fees))) (- (+ credit payment) fees)))
;; Total amount paid - calculated from payments ;; Total amount paid - calculated from payments

View file

@ -46,7 +46,7 @@
(chicken string) (chicken string)
(chicken sort) (chicken sort)
(chicken format) (chicken format)
dictionary util-dict-list
member-record member-record
month month
util-list util-list
@ -63,9 +63,9 @@
;; Prints human-readable information ;; Prints human-readable information
(define (print-member-info mr) (define (print-member-info mr)
(let* ((id (dict-ref mr 'id)) (let* ((id (ldict-ref mr 'id))
(aliases (dict-ref mr 'symlinks)) (aliases (ldict-ref mr 'symlinks))
(info (dict-ref mr 'info)) (info (ldict-ref mr 'info))
(sinfo (sort info (sinfo (sort info
(lambda (a b) (lambda (a b)
(string<? (string<?
@ -87,7 +87,7 @@
;; Returns nicely formatted table ;; Returns nicely formatted table
(define (member-info->table mr) (define (member-info->table mr)
(let* ((aliases (dict-ref mr 'symlinks)) (let* ((aliases (ldict-ref mr 'symlinks))
(mid (member-id mr)) (mid (member-id mr))
(head (list (if (is-4digit-prime? mid) (head (list (if (is-4digit-prime? mid)
(list "ID:" mid) (list "ID:" mid)
@ -101,14 +101,14 @@
(sprintf "~A month~A" msm (sprintf "~A month~A" msm
(if (> msm 1) "s" "")))) (if (> msm 1) "s" ""))))
#f))) #f)))
(info (dict-ref mr 'info)) (info (ldict-ref mr 'info))
(sikeys (sort (dict-keys info) (sikeys (sort (ldict-keys info)
(lambda (a b) (lambda (a b)
(string<? (string<?
(symbol->string a) (symbol->string a)
(symbol->string b))))) (symbol->string b)))))
(body (map (lambda (k) (body (map (lambda (k)
(let ((v (dict-ref info k))) (let ((v (ldict-ref info k)))
(case k (case k
((card desfire credit) ((card desfire credit)
(list k (list k
@ -154,9 +154,9 @@
#:row0-border #t #:row0-border #t
#:col-border #t)) #:col-border #t))
(let* ((balance (member-balance mr)) (let* ((balance (member-balance mr))
(fees (dict-ref balance 'fees)) (fees (ldict-ref balance 'fees))
(credit (dict-ref balance 'credit)) (credit (ldict-ref balance 'credit))
(payment (dict-ref balance 'payment)) (payment (ldict-ref balance 'payment))
(total (- (+ credit payment) fees))) (total (- (+ credit payment) fees)))
(print "Total fees: " fees) (print "Total fees: " fees)
(print "Total credit: " credit) (print "Total credit: " credit)
@ -167,8 +167,8 @@
;; Nicely prints the member source with any errors recorded. ;; Nicely prints the member source with any errors recorded.
(define (print-member-source mr) (define (print-member-source mr)
(let* ((lines (member-source mr)) (let* ((lines (member-source mr))
(file-name (dict-ref mr 'file-name)) (file-name (ldict-ref mr 'file-name))
(hls (dict-ref mr 'highlights '()))) (hls (ldict-ref mr 'highlights '())))
(print file-name ":") (print file-name ":")
(print-source-listing (print-source-listing
lines lines
@ -212,11 +212,11 @@
(print "Known members: " (print "Known members: "
(length nicks)) (length nicks))
(let* ((bi (members-base-info mb)) (let* ((bi (members-base-info mb))
(invalid-mrs (dict-ref bi 'invalid)) (invalid-mrs (ldict-ref bi 'invalid))
(active-mrs (dict-ref bi 'active)) (active-mrs (ldict-ref bi 'active))
(suspended-mrs (dict-ref bi 'suspended)) (suspended-mrs (ldict-ref bi 'suspended))
(destroyed-mrs (dict-ref bi 'destroyed)) (destroyed-mrs (ldict-ref bi 'destroyed))
(student-mrs (dict-ref bi 'students))) (student-mrs (ldict-ref bi 'students)))
(print a:success " Active (" (length active-mrs) "): " a:default (print a:success " Active (" (length active-mrs) "): " a:default
(member-records->string (sort active-mrs member<?) "~N~E")) (member-records->string (sort active-mrs member<?) "~N~E"))
(print a:warning " Suspended (" (length suspended-mrs) "): " a:default (print a:warning " Suspended (" (length suspended-mrs) "): " a:default
@ -252,12 +252,12 @@
;; Prints nicely aligned members base info ;; Prints nicely aligned members base info
(define (print-members-base-table mb) (define (print-members-base-table mb)
(let* ((bi (members-base-info mb)) (let* ((bi (members-base-info mb))
(all-mrs (dict-ref bi 'total)) (all-mrs (ldict-ref bi 'total))
(invalid-mrs (dict-ref bi 'invalid)) (invalid-mrs (ldict-ref bi 'invalid))
(active-mrs (dict-ref bi 'active)) (active-mrs (ldict-ref bi 'active))
(suspended-mrs (dict-ref bi 'suspended)) (suspended-mrs (ldict-ref bi 'suspended))
(destroyed-mrs (dict-ref bi 'destroyed)) (destroyed-mrs (ldict-ref bi 'destroyed))
(student-mrs (dict-ref bi 'students))) (student-mrs (ldict-ref bi 'students)))
(print "Known members: " (length all-mrs)) (print "Known members: " (length all-mrs))
(newline) (newline)
(print (print
@ -345,9 +345,9 @@
(map (map
(lambda (mr) (lambda (mr)
(let* ((balance (member-balance mr)) (let* ((balance (member-balance mr))
(fees (dict-ref balance 'fees)) (fees (ldict-ref balance 'fees))
(credit (dict-ref balance 'credit)) (credit (ldict-ref balance 'credit))
(payment (dict-ref balance 'payment)) (payment (ldict-ref balance 'payment))
(total (- (+ credit payment) fees))) (total (- (+ credit payment) fees)))
(list (member-nick mr) (list (member-nick mr)
(if (member-suspended? mr) (if (member-suspended? mr)
@ -401,9 +401,9 @@
a:default) a:default)
))) )))
members) members)
(let* ((fees (foldl + 0 (map (lambda (b) (dict-ref b 'fees)) balances))) (let* ((fees (foldl + 0 (map (lambda (b) (ldict-ref b 'fees)) balances)))
(credit (foldl + 0 (map (lambda (b) (dict-ref b 'credit)) balances))) (credit (foldl + 0 (map (lambda (b) (ldict-ref b 'credit)) balances)))
(payment (foldl + 0 (map (lambda (b) (dict-ref b 'payment)) balances))) (payment (foldl + 0 (map (lambda (b) (ldict-ref b 'payment)) balances)))
(total (- (+ credit payment) fees))) (total (- (+ credit payment) fees)))
(list (list (ansi-string #:bold "Total") (list (list (ansi-string #:bold "Total")
"" ""