;;
;; members-print.scm
;;
;; Procedures working with complete member record (as loaded by the
;; members-base).
;;
;; ISC License
;;
;; Copyright 2023 Brmlab, z.s.
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; Permission to use, copy, modify, and/or distribute this software
;; for any purpose with or without fee is hereby granted, provided
;; that the above copyright notice and this permission notice appear
;; in all copies.
;; 
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;

(declare (unit members-print))

(module
 members-print
 (
  print-member-info
  print-member-table
  print-member-source
  print-members-base-info
  print-members-base-table
  print-members-base-stats
  print-members-ids-stats
  )

 (import scheme
	 (chicken base)
	 (chicken string)
	 (chicken sort)
	 (chicken format)
	 dictionary
	 member-record
	 month
	 utils
	 table
	 listing
	 ansi
	 period
	 primes
	 members-base
	 configuration)

 ;; Prints human-readable information
 (define (print-member-info mr)
   (let* ((id (dict-ref mr 'id))
	  (aliases (dict-ref mr 'symlinks))
	  (info (dict-ref mr 'info))
	  (sinfo (sort info
		       (lambda (a b)
			 (string<?
			  (symbol->string (car a))
			  (symbol->string (car b)))))))
     (print "User " id " alias(es): "
	    (string-intersperse
	     (map symbol->string aliases)
	     ", "))
     (when (member-suspended? mr)
       (print "  Suspended for " (member-suspended-months mr) " months."))
     (newline)
     (let loop ((sinfo sinfo))
       (when (not (null? sinfo))
	 (let* ((kv (car sinfo))
		(k (car kv))
		(v (cdr kv)))
	   (loop (cdr sinfo)))))))

 ;; Prints nicely formatted table
 (define (print-member-table mr)
   (let* ((aliases (dict-ref mr 'symlinks))
	  (mid (member-id mr))
	  (head (list (if (is-4digit-prime? mid)
			  (list "ID:" mid)
			  (list (ansi-string #:red #:bold "ID:")
				(ansi-string #:red #:bold (number->string mid) " (not prime)")))
		      (list (sprintf "Alias~A:" (if (> (length aliases) 1) "es" ""))
			    (string-intersperse (map symbol->string aliases) ", "))
		      (if (member-suspended? mr)
			  (list "Suspended for:"
				(let ((msm (member-suspended-months mr)))
				  (sprintf "~A month~A" msm
					   (if (> msm 1) "s" ""))))
			  #f)))
	  (info (dict-ref mr 'info))
	  (sikeys (sort (dict-keys info)
			(lambda (a b)
			  (string<?
			   (symbol->string a)
			   (symbol->string b)))))
	  (body (map (lambda (k)
		       (let ((v (dict-ref info k)))
			 (case k
			   ((card desfire credit)
			    (list k 
				  (table->string
				   (map
				    (lambda (c)
				      (list (car c) (cdr c)))
				    v)
				   #:col-border #t)))
			   ((suspend student member)
			    (list k
				  (table->string
				   (cons (list "Since" "Until")
					 (map
					  (lambda (p)
					    (list
					     (string-append (month->string (period-since p)) " "
							    (or (period-scomment p) ""))
					     (string-append (month->string (period-before p)) " "
							    (or (period-bcomment p) ""))))
					  v))
				   #:col-border #t)))
			   (else
			    (if v
				(list k v)
				(list (ansi-string #:red #:bold (symbol->string k))
				      (ansi-string #:red #:bold "---")))))))
		     sikeys))
	  (result (filter identity (append head body))))
     (print (table->string result #:table-border #t #:row-border #t #:col-border #t #:ansi #t))))

 ;; Nicely prints the member source with any errors recorded.
 (define (print-member-source mr)
   (let* ((lines (dict-ref mr 'source mr))
	  (file-name (dict-ref mr 'file-name))
	  (hls (dict-ref mr 'highlights '())))
     (print file-name ":")
     (print-source-listing
      lines
      hls
      #: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)
	       ", ")
	      ")"))))

 )