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

Port last bits of member-record.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-25 21:09:09 +01:00
parent 350353608e
commit 16a2d85abd
2 changed files with 60 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

2
member-parser.scm
View file

@ -246,4 +246,4 @@
(import member-parser)
(member-parser-tests!)
(print (load-member-file (make-member-record "joe" "members/joe" '(2803))))
(print (load-member-file (make-member-record '|joe| "members/joe" '(|2803|))))

59
member2-record.scm
View file

@ -49,6 +49,9 @@
member-nick
member-id
member-suspended-months
member-format
member-record-tests!
)
@ -57,6 +60,8 @@
(chicken base)
(chicken keyword)
(chicken irregex)
(chicken string)
(chicken format)
dictionary
testing
month
@ -208,6 +213,38 @@
(define (member-id mr)
(dict-ref mr 'id))
;; Returns the number of months the user is suspended. Zero if not
;; suspended.
(define (member-suspended-months mr)
(if (member-suspended? mr)
(let ((period (periods-match (member-record-info mr 'suspend))))
(if period
(month-diff (car period) (*current-month*))
0))
0))
;; Member formatting function for general use.
(define (member-format fmt mr)
(let loop ((fmtl (string->list fmt))
(resl '()))
(if (null? fmtl)
(string-intersperse (reverse resl) "")
(let ((ch (car fmtl)))
(if (eq? ch #\~)
(loop (cddr fmtl)
(cons (case (cadr fmtl)
((#\N) (member-record-info mr 'nick))
((#\I) (number->string (member-record-info mr 'id)))
((#\S) (number->string (member-suspended-months mr)))
((#\E)
(let ((n (length (member-record-info mr 'highlights '()))))
(if (<= n 2)
""
(sprintf "[~A]" (- n 2)))))
((#\~) "~"))
resl))
(loop (cdr fmtl)
(cons (make-string 1 (car fmtl)) resl)))))))
;; Self-tests
(define (member-record-tests!)
(run-tests
@ -231,6 +268,28 @@
(test-equal? member-record-add-highlight
(member-record-add-highlight '() 123 "Interesting..." 0 'info)
'((highlights . ((123 "Interesting..." 0 info)))))
(test-true member-destroyed?
(parameterize ((*current-month* (list 2023 2)))
(member-destroyed? '((info . ((destroyed . "2010-05")))))))
(test-false member-destroyed?
(parameterize ((*current-month* (list 2009 2)))
(member-destroyed? '((info . ((destroyed . "2010-05")))))))
(test-false member-destroyed?
(member-destroyed? '((info . ()))))
(test-false member-suspended?
(member-suspended? '((info . ()))))
(test-true member-suspended?
(parameterize ((*current-month* (list 2015 2)))
(member-suspended? '((info . ((suspend ((2010 1) 2022 4))))))))
(test-true member-suspended?
(parameterize ((*current-month* (list 2015 2)))
(member-suspended? '((info . ((suspend ((2010 1) . #f))))))))
(test-false member-suspended?
(parameterize ((*current-month* (list 2023 2)))
(member-suspended? '((info . ((suspend ((2010 1) 2022 4))))))))
(test-true member-active?
(parameterize ((*current-month* (list 2023 2)))
(member-active? '((info . ((suspend ((2010 1) 2022 4))))))))
))
)