;;
;; members-print.scm
;;
;; Procedures working with complete member record (as loaded by the
;; mbase).
;;
;; 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
 (
  *show-payments-count*
  print-member-table
  print-member-source
  print-member-blame
  member-records->string
  print-members-base-table
  print-members-base-stats
  print-members-ids-stats
  print-members-fees-table
  unpaired-table
  print-unpaired-table
  print-member-balances-table
  )

 (import scheme
	 (chicken base)
	 (chicken string)
	 (chicken sort)
	 (chicken format)
	 srfi-1
	 util-bst-ldict
	 brmember
	 cal-month
	 table
	 listing
	 ansi
	 cal-period
	 primes
	 mbase
	 configuration
	 bank-account
	 members-fees
	 members-payments
	 brmember-format
	 specification
	 cal-format
	 util-git
	 cal-day
	 racket-kwargs
	 tiocgwinsz)

 (define *show-payments-count* (make-parameter 36))

 ;; Returns nicely formatted table
 (define (member-info->table mr)
   (let* ((aliases (ldict-ref mr 'symlinks))
	  (mid (brmember-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 (brmember-suspended? mr)
			  (list "Suspended for:"
				(let ((msm (brmember-suspended-months mr)))
				  (sprintf "~A month~A" msm
					   (if (> msm 1) "s" ""))))
			  #f)))
	  (info (ldict-ref mr 'info))
	  (sikeys (sort (ldict-keys info)
			(lambda (a b)
			  (string<?
			   (symbol->string a)
			   (symbol->string b)))))
	  (body (map (lambda (k)
		       (let ((v (ldict-ref info k)))
			 (case k
			   ((card desfire phone)
			    (list k 
				  (table->string
				   (map
				    (lambda (c)
				      (list (car c) (cdr c)))
				    v)
				   #:border '(((#:right light) ... none) ...))))
			   ((credit)
			    (list k 
				  (table->string
				   (map (lambda (c)
					  (list (format "\t~A" (car c))
						(cal-format (cadr c))
						(caddr c)))
					(brmember-credit mr))
				   #:border '(((#:right light) ... none) ...))))
			   ((suspend student member council chair revision grant)
			    (let* ((pdata (cons (list "Since" "Until")
						(map
						 (lambda (p)
						   (list
						    (string-append (cal-day/month->string
								    (cal-period-since p)) " "
								    (or (cal-period-scomment p) ""))
						    (string-append (cal-day/month->string
								    (cal-period-before p)) " "
								    (or (cal-period-bcomment p) ""))))
						 v)))
				   (ptbl (table->string
					  pdata
					  #:border '(((#:right light) ... none) ...))))
			      ;;(print pdata)
			      ;;(write ptbl)(newline)
			      (list k ptbl)))
			   ((fee)
			    (let* ((pdata
				    (cons
				     (list "Amount" "Since" "Until")
				     (map
				      (lambda (p)
					(list
					 (format "\t~A" (car (cal-period-scomment p)))
					 (string-append (cal-day/month->string
							 (cal-period-since p)) " "
							 (or (cadr (cal-period-scomment p)) ""))
					 (string-append (cal-day/month->string
							 (cal-period-before p)) " "
							 (or (cal-period-bcomment p) ""))))
				      v)))
				   (ptbl (table->string
					  pdata
					  #:border '(((#:right light) ... none) ...))))
			      ;;(print pdata)
			      ;;(write ptbl)(newline)
			      (list k ptbl)))
			   (else
			    (if v
				(list k v)
				(list (ansi-string #:red #:bold (symbol->string k))
				      (ansi-string #:red #:bold "---")))))))
		     sikeys))
	  (mailman (list (list "Mailing Lists"
			       (string-intersperse (brmember-mailman mr) "\n"))))
	  (dokuwiki (if (ldict-contains? mr 'dokuwiki)
			(if (eq? (ldict-ref mr 'dokuwiki) #t)
			    (list #f)
			    (list
			     (list "DokuWiki"
				   (let ((groups (brmember-sub-ref mr 'dokuwiki 'groups))
					 (email (brmember-sub-ref mr 'dokuwiki 'email))
					 (memail (brmember-info mr 'mail #f)))
				   (string-intersperse
				    (list (format (if (brmember-dokuwiki-groups-ok? mr)
						      "Groups: ~A"
						      (ansi-string #:red "Groups: ~A" #:default))
						  groups)
					  (format (if (equal? email memail)
						      "Email: ~A"
						      (ansi-string #:red "Email: ~A" #:default))
						  email))
				    "\n")))))
			(list (list (ansi-string #:red "DokuWiki")
				    (ansi-string #:red "---")))))
	  (result (filter identity (append head body mailman dokuwiki))))
     ;;(write result)(newline)
     (table->string result
		    #:border '(((#:bottom #:right light) ... (#:bottom light))
			       ...
			       ((#:right light) ... none))
		    #:ansi-reset? #t)))

 ;; Prints nicely formatted table
 (define (print-member-table mr)
   (print
    (table->string
     (list (list "Basic Information" "Payments" "Membership Status")
	   (list (member-info->table mr)
		 (member-payments->table mr)
		 (member-calendar->table mr))
	   )
     #:border '(((#:bottom #:right light) ... (#:bottom light))
		((#:right light) ... none)
		...
		)))
   (let* ((balance (member-balance mr))
	  (fees (ldict-ref balance 'fees))
	  (credit (ldict-ref balance 'credit))
	  (payment (ldict-ref balance 'payment))
	  (total (- (+ credit payment) fees)))
     (newline)
     (print "Total fees: " fees)
     (print "Total credit: " credit)
     (print "Total payments: " payment)
     (print "Balance: " total)
     ))

 ;; Nicely prints the member source with any errors recorded.
 (define (print-member-source mr)
   (let* ((lines (brmember-source mr))
	  (file-name (ldict-ref mr 'file-name))
	  (hls (ldict-ref mr 'highlights '())))
     (print file-name ":")
     (print-source-listing
      lines
      hls
      #:context -1
      )))

 ;; Nicely prints the member annotated source with any errors recorded.
 (define (print-member-blame mr)
   (let* ((lines (brmember-source mr))
	  (file-name (ldict-ref mr 'file-name))
	  (hls (ldict-ref mr 'highlights '()))
	  (file-path (brmember-file-path mr))
	  (blame (git-blame (*members-directory*) file-name))
	  )
     (print file-name ":")
     (print-source-listing
      blame
      hls
      #:context -1
      #:keys '(committer-time -- number -- line -- comment)
      )))

 ;; Prints nicely printed payments
 (define* (member-payments->table mr (max-trans (*show-payments-count*)))
   (let* ((payments0 (brmember-payments mr))
	  (payments
	   (if max-trans
	       (let loop ((ps (reverse payments0))
			  (num max-trans)
			  (res '()))
		 (if (or (null? ps)
			 (<= num 0))
		     res
		     (loop (cdr ps)
			   (sub1 num)
			   (cons (car ps) res))))
	       payments0)))
     (table->string (cons
		     (list "Var" "Amount" "Cur" "Date" "TrId")
		     (map (lambda (tr)
			    (list (sprintf "\t~A" (bank-transaction-varsym tr))
				  (sprintf "\t~A" (bank-transaction-amount tr))
				  (bank-transaction-currency tr)
				  (bank-transaction-date tr)
				  (bank-transaction-id tr)))
			  payments))
		    #:border '(((#:bottom #:right light) ... (#:bottom light))
			       ((#:right light) ... none)
			       ...))))

 ;; 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)
	     (brmember-format fmt mr))
	   mrs)
      sep)))

 ;; 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)
	 (member-records->string
	  (sort mrs brmember<?)
	  fmt)))

 ;; Generic table of members attributes
 (define (members-attrs-table mrs fmt hdr row)
   (let loop ((mrs mrs)
	      (tbl (list hdr)))
     (if (null? mrs)
	 (reverse tbl)
	 (loop (cdr mrs)
	       (let ((mr (car mrs)))
		 (cons (map (lambda (cs)
			      (if (procedure? cs)
				  (cs mr)
				  (fmt cs mr)))
			    row)
		       tbl))))))

 ;; Members table row based on predicate
 (define (members-pred-table-row mb label pred? fmt)
   (let ((mrs (sort (find-members-by-predicate mb pred?)
		    brmember<?)))
     (if (null? mrs)
	 #f
	 (list (string-append "\t" label)
	       (length mrs)
	       (member-records->string mrs fmt)
	       ))))

 ;; Prints nicely aligned members base info
 (define (print-members-base-table mb)
   (let-values (((rows columns) (term-size)))
     (let* ((total-count (length
			  (find-members-by-predicate mb brmember-usable?)))
	    (invalid-mrs (find-members-by-predicate
			  mb
			  (compose not is-4digit-prime? brmember-id)))
	    (suspended-mrs (find-members-by-predicate mb brmember-suspended?))
	    (debtor-mrs (sort
			 (members-to-notify mb 3)
			 brmember<?))
	    (soon-expire-mrs (sort
			      (find-members-by-predicate
			       mb
			       (brmember-suspended-for 21 24))
			      brmember<?)))
       (print "Known members: " total-count)
       (newline)
       (print
	(table->string
	 (filter
	  identity
	  (list (list "Type" "Count" "List")
		(members-pred-table-row mb
					(ansi-string #:yellow "Chair:")
					brmember-chair?
					"~N")
		(members-pred-table-row mb
					(ansi-string #:yellow "Council:")
					brmember-council?
					"~N")
		(members-pred-table-row mb
					(ansi-string #:yellow "Revision:")
					brmember-revision?
					"~N")
		(members-pred-table-row mb
					(ansi-string #:yellow "Grant:")
					brmember-grant?
					"~N")
		(members-pred-table-row mb
					(string-append a:success "Active:")
					brmember-active?
					"~N~E")
		(members-pred-table-row mb
					(string-append a:highlight "Students:")
					brmember-student?
					"~N~E")
		(members-table-row a:warning "Suspended:" suspended-mrs "~N~E (~S)")
		(members-pred-table-row mb
					(string-append a:warning "Destroyed:")
					brmember-destroyed?
					"~N~E")
		(let ((suspended2 (filter
				   (lambda (mr)
				     (>= (brmember-suspended-months mr)
					 member-suspend-max-months))
				   suspended-mrs)))
		  (if (null? suspended2)
		      #f
		      (members-table-row (ansi #:magenta) "Suspended (long):" suspended2 "~N (~S)")))
		(if (null? soon-expire-mrs)
		    #f
		    (members-table-row (ansi #:magenta #:bold) "Expire Soon:"
				       soon-expire-mrs "~N (~S)"))
		(members-pred-table-row mb
					(ansi-string #:red #:bold "Prolems:")
					brmember-has-problems?
					"~N~E ~A")
		(if (null? debtor-mrs)
		    #f
		    (list (ansi-string "\t" #:magenta #:bold "Debtors:")
			  (format "~A" (length debtor-mrs))
			  (table->string
			   (append
			    (members-attrs-table debtor-mrs
						 brmember-format
						 (list "Name" "Balance" "Last Payment")
						 (list "~N" "\t~B" "~L"))
			    (list
			     (list
			      "Total"
			      (format
			       "\t~A"
			       (foldr
				(lambda (v a)
				  (+ (member-total-balance v) a))
				0
				debtor-mrs)))))
			   #:border '(((#:bottom #:right light) ... (#:bottom light))
				      ((#:right light) ... none) ...
				      ((#:top #:right light) ... (#:top light)))
			   #:ansi-reset? #t)))
		))
	 #:border '(((#:bottom #:right light) ... (#:bottom light))
		    ...
		    ((#:right light) ... none))
	 #:width (- columns 10)
	 #:ansi-reset? #t))))
   (let ((pmrs (find-members-by-predicate mb brmember-file-has-problems?)))
     (when (not (null? pmrs))
       (newline)
       (print "Member files with errors (" (length pmrs) "): "
	      (string-intersperse
	       (map brmember-file-path pmrs)
	       ", "))))
   (let ((pmrs (find-members-by-predicate mb (lambda (mr)
					       (and (brmember-has-highlights? mr)
						    (not (brmember-file-has-problems? mr)))))))
     (when (not (null? pmrs))
       (newline)
       (print "Member files with issues: "
	      (string-intersperse
	       (map brmember-file-path pmrs)
	       ", "))))
   (let ((dwpu (filter (lambda (dwu)
			 (or (member "member" (list-ref dwu 3))
			     (member "council" (list-ref dwu 3))
			     (member "admin" (list-ref dwu 3))))
		       (ldict-ref mb 'dokuwiki))))
     (when (not (null? dwpu))
       (newline)
       (print "DokuWiki users (non-members) in wrong group(s): "
	      (string-intersperse
	       (map car dwpu)
	       ", "))))
   (let ((dwmu (find-members-by-predicate mb (compose not brmember-dokuwiki-groups-ok?))))
     (when (not (null? dwmu))
       (newline)
       (print "Members in wrong dokuwiki group(s): "
	      (string-intersperse
	       (map brmember-nick dwmu)
	       ", "))))
   )

 ;; 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 (cal-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-mbase-ids MB))
	  "/"
	  (length (gen-all-4digit-primes))
	  " ("
	  (length (mbase-free-ids MB))
	  " free)")
   (let ((iids (filter (compose not is-4digit-prime?) (list-mbase-ids MB))))
     (when (not (null? iids))
       (print "      Invalid: "
	      (length iids)
	      " ("
	      (string-intersperse
	       (map (lambda (id)
		      (let ((mr (find-member-by-id MB id)))
			(brmember-format
			 "~I - ~N"
			 mr)))
		    iids)
	       ", ")
	      ")"))))

 ;; Prints summary table of all fees and credits for all members
 (define (print-members-fees-table MB . dsa)
   (let ((destroyed? (if (null? dsa)
			 #f
			 (car dsa)))
	 (only-active? (if (or (null? dsa)
			       (null? (cdr dsa)))
			   #f
			   (cadr dsa))))
     (let* ((raw-members
	     (sort
	      (if destroyed?
		  (find-members-by-predicate MB (lambda x #t))
		  (if only-active?
		      (find-members-by-predicate MB (lambda (mr)
						      (brmember-active? mr)))
		      (find-members-by-predicate MB (lambda (mr)
						      (not (brmember-destroyed? mr))))))
	      brmember<?))
	    (members ;; Pass 1
	     (map
	      (lambda (mr)
		(let* ((balance (member-balance mr))
		       (fees (ldict-ref balance 'fees))
		       (credit (ldict-ref balance 'credit))
		       (payment (ldict-ref balance 'payment))
		       (total (- (+ credit payment) fees)))
		  (list (brmember-nick mr)
			(if (brmember-suspended? mr)
			    'suspended
			    (if (brmember-student? mr)
				'student
				(if (brmember-destroyed? mr)
				    'destroyed
				    'active)))
			fees
			credit
			payment
			total
			balance
			(let ((spec-fee (brmember-spec-fee mr)))
			  (if spec-fee
			      spec-fee
			      "normal"))
			)))
	      raw-members))
	    (balances (map (lambda (m)
			     (list-ref m 6))
			   members)))
       (print
	(table->string
	 (cons
	  (list (ansi-string #:bgblue #:brightyellow #:bold "Member")
		(ansi-string #:bgblue #:brightyellow #:bold "Status")
		(ansi-string #:bgblue #:brightyellow #:bold "Current")
		(ansi-string #:bgblue #:brightyellow #:bold "Fees")
		(ansi-string #:bgblue #:brightyellow #:bold "Credit")
		(ansi-string #:bgblue #:brightyellow #:bold "Payments")
		(ansi-string #:bgblue #:brightyellow #:bold "Balance"))
	  (append
	   (map ;; Pass 2
	    (lambda (member)
	      (let ((total (list-ref member 5)))
		(list (list-ref member 0)
		      (list-ref member 1)
		      (sprintf "\t~A" (list-ref member 7))
		      (sprintf "\t~A" (list-ref member 2))
		      (sprintf "\t~A" (list-ref member 3))
		      (sprintf "\t~A" (list-ref member 4))
		      (sprintf "\t~A~A~A"
			       (if (< total -500)
				   a:error
				   (if (< total 0)
				       a:warning
				       a:success))
			       (exact->inexact total)
			       a:default)
		      )))
	    members)
	   (let* ((fees (foldl + 0 (map (lambda (b) (ldict-ref b 'fees)) balances)))
		  (credit (foldl + 0 (map (lambda (b) (ldict-ref b 'credit)) balances)))
		  (payment (foldl + 0 (map (lambda (b) (ldict-ref b 'payment)) balances)))
		  (total (- (+ credit payment) fees)))
	     (list (list (ansi-string #:bold "Total")
			 ""
			 ""
			 (ansi-string "\t" #:bold (sprintf "~A" fees))
			 (ansi-string "\t" #:bold (sprintf "~A" credit))
			 (ansi-string "\t" #:bold (sprintf "~A" payment))
			 (ansi-string "\t" #:bold
				      (sprintf "~A~A"
					       (if (< total 0)
						   a:error
						   a:success)
					       total))
			 )))))
	 #:border '(((#:bottom #:right light) ... (#:bottom light))
		    ((#:right light) ... none)
		    ...
		    ((#:right light) ... none))
	 #:ansi-reset? #t))
       (print "Credit: "
	      (foldl + 0
		     (map (lambda (member)
			    (list-ref member 5))
			  members)))
       (print "Advance: "
	      (foldl + 0
		     (map (lambda (member)
			    (max 0 (list-ref member 5)))
			  members)))
       (print "Debt: "
	      (foldl + 0
		     (map (lambda (member)
			    (min 0 (list-ref member 5)))
			  members)))
       (print (get-expected-income-string MB)))))

 (define (unpaired-table mb . args)
   (apply
    table->string-list
    (cons
     (list "Id" "Date" "Amount" "" "VS" "Type" "Message" "Account" "Bank")
     (map
      (lambda (tr)
	(list (bank-transaction-id tr)
	      (bank-transaction-date tr)
	      (sprintf "\t~A" (bank-transaction-amount tr))
	      (bank-transaction-currency tr)
	      (sprintf "\t~A" (bank-transaction-varsym tr))
	      (bank-transaction-type tr)
	      (bank-transaction-message tr)
	      (bank-transaction-account tr)
	      (bank-transaction-bank tr)
	      ))
      (mbase-unpaired mb)))
    #:border '(((#:bottom #:right light) ... (#:bottom light))
	       ((#:right light) ... none)
	       ...)
    args))

 ;; Prints all transactions which the members base considers unpaired.
 (define (print-unpaired-table mb)
   (print
    (string-intersperse
     (unpaired-table mb)
     "\n")))

 ;; Prints fees/payments/balances of one member
 (define (print-member-balances-table mr)
   (let ((data (map (lambda (r)
		      (list (cal-day->string (cadr r))
			    (list-ref r 6)
			    (list-ref r 4)
			    (format "\t~A" (exact->inexact (list-ref r 2)))
			    (list-ref r 3)
			    (format "\t~A" (exact->inexact (list-ref r 5)))
			    (format "\t~A" (exact->inexact (car r)))
			    ))
		    (brmember-balance-history mr))))
     (print-table
      #:border '(((#:bottom #:right light) ... (#:bottom light))
		 ((#:right light) ... none)
		 ...)
      (cons '("\tDate\t" "\tType\t" "\tComment\t"
	      "\tAmount\t" "\tCurrency\t" "\tAmount [CZK]\t" "\tBalance\t")
	    data))))

 )