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

Advanced accessors.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-11 22:38:22 +02:00
parent 4bd6837e08
commit 12a911bbff
7 changed files with 25 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/brmember-format.scm
View file

@ -48,9 +48,9 @@
(if (eq? ch #\~)
(loop (cddr fmtl)
(cons (case (cadr fmtl)
((#\N) (member-nick mr))
((#\I) (number->string (member-id mr)))
((#\S) (number->string (member-suspended-months mr)))
((#\N) (brmember-nick mr))
((#\I) (number->string (brmember-id mr)))
((#\S) (number->string (brmember-suspended-months mr)))
((#\E)
(let ((n (length (ldict-ref mr 'highlights '()))))
(if (eq? n 0)

18
src/brmember.scm
View file

@ -57,9 +57,9 @@
brmember-existing?
brmember-flags
member-nick
member-id
member-suspended-months
brmember-nick
brmember-id
brmember-suspended-months
member<?
@ -245,7 +245,7 @@
(define (brmember-has-problems? mr)
(or (member-has-errors? mr)
(not (brmember-usable? mr))
(not (is-4digit-prime? (member-id mr)))))
(not (is-4digit-prime? (brmember-id mr)))))
;; Returns true if the member record represents non-existing
;; member. The *current-month* is a global parameter from period
@ -302,16 +302,16 @@
(if (brmember-existing? mr) 'existing #f))))
;; Nickname as string
(define (member-nick mr)
(define (brmember-nick mr)
(brmember-info mr 'nick))
;; Returns member id
(define (member-id mr)
(define (brmember-id mr)
(ldict-ref mr 'id))
;; Returns the number of months the user is suspended. Zero if not
;; suspended.
(define (member-suspended-months mr)
(define (brmember-suspended-months mr)
(if (brmember-suspended? mr)
(let ((period (periods-match (brmember-info mr 'suspend))))
(if period
@ -321,8 +321,8 @@
;; Comparator of member records based on nickname.
(define (member<? a b)
(string-ci<? (member-nick a)
(member-nick b)))
(string-ci<? (brmember-nick a)
(brmember-nick b)))
;; Prepends new payment to given member record payments
(define (member-record-add-payment mr pt)

4
src/hackerbase.scm
View file

@ -330,8 +330,8 @@
(let loop ((lst nmembers))
(when (and (not (null? lst))
(or (not mr)
(eq? (member-id mr)
(member-id (car lst)))))
(eq? (brmember-id mr)
(brmember-id (car lst)))))
(if (-send-emails-)
(make+send-reminder-email (car lst))
(make+print-reminder-email (car lst)))

4
src/members-base.scm
View file

@ -132,7 +132,7 @@
(filter-members-by-predicate
mb
(lambda (mr)
(substring-index pat (member-nick mr)))))
(substring-index pat (brmember-nick mr)))))
;; Returns all ids found in the database
(define (list-members-ids mb)
@ -161,7 +161,7 @@
(let* ((members (filter-members-by-predicate mb-arg brmember-usable?))
(di0 (make-ldict))
(di1 (ldict-set di0 'invalid
(filter (compose not is-4digit-prime? member-id) members)))
(filter (compose not is-4digit-prime? brmember-id) members)))
(di2 (ldict-set di1 'active
(filter brmember-active? members)))
(di3 (ldict-set di2 'suspended

2
src/members-payments.scm
View file

@ -99,7 +99,7 @@
(members-base-update
mb
(lambda (mr)
(compare-member-id (member-id mr) varsym-id))
(compare-member-id (brmember-id mr) varsym-id))
(lambda (mr)
(member-record-add-payment mr transaction)))
(if (and (or (not last-checked)

12
src/members-print.scm
View file

@ -77,7 +77,7 @@
(map symbol->string aliases)
", "))
(when (brmember-suspended? mr)
(print " Suspended for " (member-suspended-months mr) " months."))
(print " Suspended for " (brmember-suspended-months mr) " months."))
(newline)
(let loop ((sinfo sinfo))
(when (not (null? sinfo))
@ -89,7 +89,7 @@
;; Returns nicely formatted table
(define (member-info->table mr)
(let* ((aliases (ldict-ref mr 'symlinks))
(mid (member-id mr))
(mid (brmember-id mr))
(head (list (if (is-4digit-prime? mid)
(list "ID:" mid)
(list (ansi-string #:red #:bold "ID:")
@ -98,7 +98,7 @@
(string-intersperse (map symbol->string aliases) ", "))
(if (brmember-suspended? mr)
(list "Suspended for:"
(let ((msm (member-suspended-months mr)))
(let ((msm (brmember-suspended-months mr)))
(sprintf "~A month~A" msm
(if (> msm 1) "s" ""))))
#f)))
@ -228,7 +228,7 @@
(member-records->string (sort student-mrs member<?)))
(let ((suspended2 (filter
(lambda (mr)
(>= (member-suspended-months mr) 24))
(>= (brmember-suspended-months mr) 24))
suspended-mrs)))
(when (not (null? suspended2))
(print (ansi #:magenta) " Suspended for at least 24 months ("
@ -272,7 +272,7 @@
(members-table-row a:warning "Destroyed:" destroyed-mrs "~N~E")
(let ((suspended2 (filter
(lambda (mr)
(>= (member-suspended-months mr)
(>= (brmember-suspended-months mr)
(*member-suspend-max-months*)))
suspended-mrs)))
(if (null? suspended2)
@ -350,7 +350,7 @@
(credit (ldict-ref balance 'credit))
(payment (ldict-ref balance 'payment))
(total (- (+ credit payment) fees)))
(list (member-nick mr)
(list (brmember-nick mr)
(if (brmember-suspended? mr)
'suspended
(if (brmember-student? mr)

4
src/web-static.scm
View file

@ -50,8 +50,8 @@
;; Generate all the files in specified (default current) directory.
(define (gen-web-static-member mr . dirs)
(let ((nick (member-nick mr))
(id (member-id mr))
(let ((nick (brmember-nick mr))
(id (brmember-id mr))
(dir (if (null? dirs)
(current-directory)
(car dirs))))