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

Finish the migration.

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

12
src/cards.scm
View file

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

54
src/members-base.scm
View file

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

14
src/members-payments.scm
View file

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

60
src/members-print.scm
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")
""