Move all printing from base to print.
This commit is contained in:
parent
8e0ac4cc25
commit
362abf4a48
3 changed files with 151 additions and 152 deletions
3
Makefile
3
Makefile
|
|
@ -203,7 +203,8 @@ member-parser.import.scm: $(MEMBER-PARSER-SOURCES)
|
|||
MEMBERS-PRINT-SOURCES=members-print.scm dictionary.import.scm \
|
||||
member-record.import.scm month.import.scm utils.import.scm \
|
||||
table.import.scm listing.import.scm ansi.import.scm \
|
||||
period.import.scm primes.import.scm
|
||||
period.import.scm primes.import.scm members-base.import.scm \
|
||||
configuration.import.scm
|
||||
|
||||
members-print.so: members-print.o
|
||||
members-print.o: members-print.import.scm
|
||||
|
|
|
|||
151
members-base.scm
151
members-base.scm
|
|
@ -34,18 +34,14 @@
|
|||
list-members-ids
|
||||
filter-members-by-predicate
|
||||
list-members-nicks
|
||||
members-base-info
|
||||
members-base-stats
|
||||
print-members-base-info
|
||||
print-members-base-table
|
||||
print-members-base-stats
|
||||
get-free-members-ids
|
||||
print-members-ids-stats
|
||||
gen-member-id
|
||||
)
|
||||
|
||||
(import scheme
|
||||
(chicken base)
|
||||
(chicken sort)
|
||||
(chicken string)
|
||||
(chicken random)
|
||||
testing
|
||||
|
|
@ -58,7 +54,6 @@
|
|||
month
|
||||
configuration
|
||||
progress
|
||||
table
|
||||
members-dir)
|
||||
|
||||
|
||||
|
|
@ -137,20 +132,6 @@
|
|||
(define (list-members-nicks mb)
|
||||
(map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) mb))
|
||||
|
||||
;; Converts member records to string, optional arguments are format
|
||||
;; and separator. Format defaults to "~N" and separator to ", ".
|
||||
(define (member-records->string mrs . args)
|
||||
(let ((fmt (if (null? args) "~N" (car args)))
|
||||
(sep (if (or (null? args)
|
||||
(null? (cdr args)))
|
||||
", "
|
||||
(cadr args))))
|
||||
(string-intersperse
|
||||
(map (lambda (mr)
|
||||
(member-format fmt mr))
|
||||
mrs)
|
||||
sep)))
|
||||
|
||||
;; Returns dictionary with statistics about the members base.
|
||||
(define (members-base-info mb)
|
||||
(let* ((di0 (make-dict))
|
||||
|
|
@ -187,112 +168,6 @@
|
|||
(cdr keys)))))
|
||||
(list keys (reverse data))))))
|
||||
|
||||
;; Basic information about members-base in human-readable form.
|
||||
(define (print-members-base-info mb)
|
||||
(let ((nicks (list-members-nicks mb))
|
||||
(ids (list-members-ids mb)))
|
||||
(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)))
|
||||
(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
|
||||
(member-records->string (sort suspended-mrs member<?) "~N~E"))
|
||||
(print a:warning " Destroyed (" (length destroyed-mrs) "): " a:default
|
||||
(member-records->string (sort destroyed-mrs member<?) "~N~E"))
|
||||
(print a:highlight " Students (" (length student-mrs) "): " a:default
|
||||
(member-records->string (sort student-mrs member<?)))
|
||||
(let ((suspended2 (filter-members-by-predicate
|
||||
suspended-mrs
|
||||
(lambda (mr)
|
||||
(>= (member-suspended-months mr) 24)))))
|
||||
(when (not (null? suspended2))
|
||||
(print (ansi #:magenta) " Suspended for at least 24 months ("
|
||||
(length suspended2) "): " a:default
|
||||
(member-records->string (sort suspended2 member<?) "~N (~S)"))))
|
||||
(when (not (null? invalid-mrs))
|
||||
(print a:error " Invalid Id (" (length invalid-mrs) "): "
|
||||
(member-records->string (sort invalid-mrs member<?) "~N (~I)")
|
||||
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 "\t" a:? label)
|
||||
(length mrs)
|
||||
(ansi-paragraph-format
|
||||
(member-records->string
|
||||
(sort mrs member<?)
|
||||
fmt)
|
||||
60)))
|
||||
|
||||
;; 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)))
|
||||
(print "Known members: " (length all-mrs))
|
||||
(newline)
|
||||
(print
|
||||
(table->string
|
||||
(filter
|
||||
identity
|
||||
(list (list "Type" "Count" "List")
|
||||
(members-table-row a:success "Active:" active-mrs "~N~E")
|
||||
(members-table-row a:highlight "Students:" student-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
|
||||
)))
|
||||
(let ((pmrs (filter-members-by-predicate mb member-has-problems?)))
|
||||
(when (not (null? pmrs))
|
||||
(newline)
|
||||
(print "Member files with errors (" (length pmrs) "): "
|
||||
(string-intersperse
|
||||
(map member-file-path pmrs)
|
||||
", "))))
|
||||
(let ((pmrs (filter-members-by-predicate mb (lambda (mr)
|
||||
(and (member-has-highlights? mr)
|
||||
(not (member-has-problems? mr)))))))
|
||||
(when (not (null? pmrs))
|
||||
(newline)
|
||||
(print "Member files with issues: "
|
||||
(string-intersperse
|
||||
(map member-file-path pmrs)
|
||||
", ")))))
|
||||
|
||||
;; Prints the stats in format used by gnuplot.
|
||||
(define (print-members-base-stats ms)
|
||||
(let ((keys (car ms))
|
||||
(data (cadr ms)))
|
||||
(print "# " (string-intersperse (map symbol->string keys) " "))
|
||||
(let loop ((rows data))
|
||||
(when (not (null? rows))
|
||||
(let* ((row (car rows))
|
||||
(month (month->string (car row)))
|
||||
(vals (cdr row)))
|
||||
(print month " " (string-intersperse (map number->string vals) " "))
|
||||
(loop (cdr rows)))))))
|
||||
|
||||
;; Returns all free ids
|
||||
(define (get-free-members-ids mb)
|
||||
|
|
@ -302,30 +177,6 @@
|
|||
(not (member id ids)))
|
||||
(gen-all-4digit-primes))))
|
||||
|
||||
;; Prints statistics about allocated and unused valid/invalid IDs.
|
||||
(define (print-members-ids-stats MB)
|
||||
(print "Allocated IDs: "
|
||||
(length (list-members-ids MB))
|
||||
"/"
|
||||
(length (gen-all-4digit-primes))
|
||||
" ("
|
||||
(length (get-free-members-ids MB))
|
||||
" free)")
|
||||
(let ((iids (filter (compose not is-4digit-prime?) (list-members-ids MB))))
|
||||
(when (not (null? iids))
|
||||
(print " Invalid: "
|
||||
(length iids)
|
||||
" ("
|
||||
(string-intersperse
|
||||
(map (lambda (id)
|
||||
(let ((mr (find-member-by-id MB id)))
|
||||
(member-format
|
||||
"~I - ~N"
|
||||
mr)))
|
||||
iids)
|
||||
", ")
|
||||
")"))))
|
||||
|
||||
;; Generates random vector id.
|
||||
(define (gen-member-id mb)
|
||||
(let* ((fids (get-free-members-ids mb))
|
||||
|
|
|
|||
|
|
@ -47,7 +47,9 @@
|
|||
listing
|
||||
ansi
|
||||
period
|
||||
primes)
|
||||
primes
|
||||
members-base
|
||||
configuration)
|
||||
|
||||
;; Prints human-readable information
|
||||
(define (print-member-info mr)
|
||||
|
|
@ -140,4 +142,149 @@
|
|||
#:context -1
|
||||
)))
|
||||
|
||||
;; Converts member records to string, optional arguments are format
|
||||
;; and separator. Format defaults to "~N" and separator to ", ".
|
||||
(define (member-records->string mrs . args)
|
||||
(let ((fmt (if (null? args) "~N" (car args)))
|
||||
(sep (if (or (null? args)
|
||||
(null? (cdr args)))
|
||||
", "
|
||||
(cadr args))))
|
||||
(string-intersperse
|
||||
(map (lambda (mr)
|
||||
(member-format fmt mr))
|
||||
mrs)
|
||||
sep)))
|
||||
|
||||
;; Basic information about members-base in human-readable form.
|
||||
(define (print-members-base-info mb)
|
||||
(let ((nicks (list-members-nicks mb))
|
||||
(ids (list-members-ids mb)))
|
||||
(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)))
|
||||
(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
|
||||
(member-records->string (sort suspended-mrs member<?) "~N~E"))
|
||||
(print a:warning " Destroyed (" (length destroyed-mrs) "): " a:default
|
||||
(member-records->string (sort destroyed-mrs member<?) "~N~E"))
|
||||
(print a:highlight " Students (" (length student-mrs) "): " a:default
|
||||
(member-records->string (sort student-mrs member<?)))
|
||||
(let ((suspended2 (filter-members-by-predicate
|
||||
suspended-mrs
|
||||
(lambda (mr)
|
||||
(>= (member-suspended-months mr) 24)))))
|
||||
(when (not (null? suspended2))
|
||||
(print (ansi #:magenta) " Suspended for at least 24 months ("
|
||||
(length suspended2) "): " a:default
|
||||
(member-records->string (sort suspended2 member<?) "~N (~S)"))))
|
||||
(when (not (null? invalid-mrs))
|
||||
(print a:error " Invalid Id (" (length invalid-mrs) "): "
|
||||
(member-records->string (sort invalid-mrs member<?) "~N (~I)")
|
||||
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 "\t" a:? label)
|
||||
(length mrs)
|
||||
(ansi-paragraph-format
|
||||
(member-records->string
|
||||
(sort mrs member<?)
|
||||
fmt)
|
||||
60)))
|
||||
|
||||
;; 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)))
|
||||
(print "Known members: " (length all-mrs))
|
||||
(newline)
|
||||
(print
|
||||
(table->string
|
||||
(filter
|
||||
identity
|
||||
(list (list "Type" "Count" "List")
|
||||
(members-table-row a:success "Active:" active-mrs "~N~E")
|
||||
(members-table-row a:highlight "Students:" student-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
|
||||
)))
|
||||
(let ((pmrs (filter-members-by-predicate mb member-has-problems?)))
|
||||
(when (not (null? pmrs))
|
||||
(newline)
|
||||
(print "Member files with errors (" (length pmrs) "): "
|
||||
(string-intersperse
|
||||
(map member-file-path pmrs)
|
||||
", "))))
|
||||
(let ((pmrs (filter-members-by-predicate mb (lambda (mr)
|
||||
(and (member-has-highlights? mr)
|
||||
(not (member-has-problems? mr)))))))
|
||||
(when (not (null? pmrs))
|
||||
(newline)
|
||||
(print "Member files with issues: "
|
||||
(string-intersperse
|
||||
(map member-file-path pmrs)
|
||||
", ")))))
|
||||
|
||||
;; Prints the stats in format used by gnuplot.
|
||||
(define (print-members-base-stats ms)
|
||||
(let ((keys (car ms))
|
||||
(data (cadr ms)))
|
||||
(print "# " (string-intersperse (map symbol->string keys) " "))
|
||||
(let loop ((rows data))
|
||||
(when (not (null? rows))
|
||||
(let* ((row (car rows))
|
||||
(month (month->string (car row)))
|
||||
(vals (cdr row)))
|
||||
(print month " " (string-intersperse (map number->string vals) " "))
|
||||
(loop (cdr rows)))))))
|
||||
|
||||
;; Prints statistics about allocated and unused valid/invalid IDs.
|
||||
(define (print-members-ids-stats MB)
|
||||
(print "Allocated IDs: "
|
||||
(length (list-members-ids MB))
|
||||
"/"
|
||||
(length (gen-all-4digit-primes))
|
||||
" ("
|
||||
(length (get-free-members-ids MB))
|
||||
" free)")
|
||||
(let ((iids (filter (compose not is-4digit-prime?) (list-members-ids MB))))
|
||||
(when (not (null? iids))
|
||||
(print " Invalid: "
|
||||
(length iids)
|
||||
" ("
|
||||
(string-intersperse
|
||||
(map (lambda (id)
|
||||
(let ((mr (find-member-by-id MB id)))
|
||||
(member-format
|
||||
"~I - ~N"
|
||||
mr)))
|
||||
iids)
|
||||
", ")
|
||||
")"))))
|
||||
|
||||
)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue