Finish members base info table.

This commit is contained in:
Dominik Pantůček 2023-03-23 16:56:07 +01:00
parent 8f378d57c9
commit 2969a2833c
5 changed files with 90 additions and 5 deletions

View file

@ -358,11 +358,21 @@ Generic highlight of given text. Defaults to bold blue text.
(ansi-string-length str) (ansi-string-length str)
* ```str``` string that may contain ANSI CSI SGR sequences * ```str``` - string that may contain ANSI CSI SGR sequences
Returns the string length in characters without any ANSI CSI SGR Returns the string length in characters without any ANSI CSI SGR
sequences contained. sequences contained.
(ansi-paragraph-format str width)
* ```str``` - a string that may contain ANSI CSI SGR sequences
* ```width``` - a number representing themaximum number of characters per line
If the string ```str``` is longer than the supplied ```width```,
splits it into multiple lines on word boundaries to wrap it
nicely. The resulting string is free of ANSI CSI SGR sequences and may
contain newline characters.
### Command Line parsing ### Command Line parsing
Generic syntax-based implementation of command-line options parsing Generic syntax-based implementation of command-line options parsing

View file

@ -37,6 +37,7 @@
a:muted a:muted
a:highlight a:highlight
ansi-string-length ansi-string-length
ansi-paragraph-format
ansi-tests! ansi-tests!
) )
@ -109,6 +110,31 @@
(loop (cdr lst) 0 len) (loop (cdr lst) 0 len)
(loop (cdr lst) 2 len)))))))) (loop (cdr lst) 2 len))))))))
;; Removes all ANSI CSI SGR sequences from the string.
(define (ansi-remove str)
(irregex-replace/all (irregex "\x1b\\[[0-9;]*[^0-9;]" 'u) str ""))
;; Formats string as paragraph of maximum given width while removing
;; all ANSI CSI SGR from it.
(define (ansi-paragraph-format str width)
(let loop ((words (string-split
(ansi-remove str)))
(res '("")))
(if (null? words)
(string-intersperse (reverse res) "\n")
(let* ((word (car words))
(wlen (ansi-string-length word))
(llen (ansi-string-length (car res))))
(loop (cdr words)
(if (> (+ llen wlen 1) width)
(cons word res)
(cons (string-append (car res)
(if (eq? (string-length (car res)) 0)
""
" ")
word)
(cdr res))))))))
;; Performs ANSI module self-tests. ;; Performs ANSI module self-tests.
(define (ansi-tests!) (define (ansi-tests!)
(run-tests (run-tests
@ -120,6 +146,14 @@
(test-eq? ansi-string-length (ansi-string-length "\x1b[1mtest") 4) (test-eq? ansi-string-length (ansi-string-length "\x1b[1mtest") 4)
(test-eq? ansi-string-length (ansi-string-length "\x1b[30mtest\x1b[0m") 4) (test-eq? ansi-string-length (ansi-string-length "\x1b[30mtest\x1b[0m") 4)
(test-eq? ansi-string-length (ansi-string-length "\x1b[30mščřž\x1b[0m") 4) (test-eq? ansi-string-length (ansi-string-length "\x1b[30mščřž\x1b[0m") 4)
(test-equal? ansi-remove (ansi-remove "\x1b[1mtest") "test")
(test-equal? ansi-remove (ansi-remove "\x1b[30mščřž\x1b[0m") "ščřž")
(test-equal? ansi-paragraph-format
(ansi-paragraph-format "Formats string as paragraph of maximum given width" 80)
"Formats string as paragraph of maximum given width")
(test-equal? ansi-paragraph-format
(ansi-paragraph-format "Formats string as paragraph of maximum given width" 20)
"Formats string as\nparagraph of maximum\ngiven width")
)) ))
) )

View file

@ -131,9 +131,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(newline) (newline)
(if mr (if mr
(print-member-record-table mr) (print-member-record-table mr)
(let () (print-members-base-table MB))
(print-members-base-info MB)
(print-members-base-table MB)))
(newline)) (newline))
((print-stats) ((print-stats)
(newline) (newline)

View file

@ -32,6 +32,7 @@
*member-file-context* *member-file-context*
*member-file-check-syntax* *member-file-check-syntax*
*member-default-joined* *member-default-joined*
*member-suspend-max-months*
) )
(import scheme (import scheme
@ -60,4 +61,7 @@
;; key is missing in member file. ;; key is missing in member file.
(define *member-default-joined* (make-parameter (make-month 2015 1))) (define *member-default-joined* (make-parameter (make-month 2015 1)))
;; How long the member can be suspended without any action required?
(define *member-suspend-max-months* (make-parameter 24))
) )

View file

@ -334,9 +334,48 @@
(member-records->string (sort invalid-mrs member<?) "~N (~I)") (member-records->string (sort invalid-mrs member<?) "~N (~I)")
a:default))))) a:default)))))
;; Helper function for pretty-formatting the filtered members lists
;; in a table.
(define (members-table-row a:? label mrs fmt)
(list (string-append a:? label)
(length mrs)
(ansi-paragraph-format
(member-records->string
(sort mrs member<?)
fmt)
60)))
;; Prints nicely aligned members base info ;; Prints nicely aligned members base info
(define (print-members-base-table mb) (define (print-members-base-table mb)
(print "TEST")) (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)))
(print "Known members: " (length all-mrs))
(print
(table->string
(filter
identity
(list (list "Type" "Count" "List")
(members-table-row a:success "Active:" active-mrs "~N~E")
(members-table-row a:warning "Suspended:" suspended-mrs "~N~E")
(members-table-row a:warning "Destroyed:" destroyed-mrs "~N~E")
(let ((suspended2 (filter-members-by-predicate
suspended-mrs
(lambda (mr)
(>= (member-suspended-months mr)
(*member-suspend-max-months*))))))
(if (null? suspended2)
#f
(members-table-row (ansi #:magenta) "Suspended (long):" suspended2 "~N (~S)")))
))
#:ansi #t
#:row-border #t
#:col-border #t
))))
;; Prints the stats in format used by gnuplot. ;; Prints the stats in format used by gnuplot.
(define (print-members-base-stats ms) (define (print-members-base-stats ms)