From 362abf4a481055df2f3a2348c7862b2a50a756fa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Wed, 29 Mar 2023 22:32:06 +0200
Subject: [PATCH] Move all printing from base to print.

---
 Makefile          |   3 +-
 members-base.scm  | 151 +---------------------------------------------
 members-print.scm | 149 ++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 151 insertions(+), 152 deletions(-)

diff --git a/Makefile b/Makefile
index d1d3089..2abdb40 100644
--- a/Makefile
+++ b/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
diff --git a/members-base.scm b/members-base.scm
index 7b66f92..a6a0415 100644
--- a/members-base.scm
+++ b/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))
diff --git a/members-print.scm b/members-print.scm
index 03f6b51..3b92770 100644
--- a/members-print.scm
+++ b/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)
+	       ", ")
+	      ")"))))
+
  )