Move all printing from base to print.

members-print.scm

@@ -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)
+	       ", ")
+	      ")"))))
+
  )