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

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