;;
;; mbase-query.scm
;;
;; Queries of various mbase derived attributes.
;;
;; ISC License
;;
;; Copyright 2023-2025 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 mbase-query))

(module
    mbase-query
    (
     mbase-info
     mbase-stats
     )

  (import scheme
	  (chicken base)
	  srfi-1
	  mbase
	  brmember
	  util-bst-ldict
	  primes
	  cal-period
	  cal-month
	  members-fees
	  members-payments)

  (define (members-base-oldest-month mb)
    (make-cal-month 2015 1))

  (define (members-average-age mrs)
    (let* ((ages (map brmember-age mrs))
	   (valid (filter (lambda (x) x) ages))
	   (num (length valid))
	   (sum (foldl + 0 valid)))
      (exact->inexact (/ sum num))))

  ;; Returns dictionary with statistics about the members base.
  (define (mbase-info mb-arg)
    (let* ((members (find-members-by-predicate mb-arg brmember-usable?))
	   (di0 (make-ldict))
	   (di1 (ldict-set di0 'invalid
			   (filter (compose not is-4digit-prime? brmember-id) members)))
	   (active-members (filter brmember-active? members))
	   (di2 (ldict-set di1 'active
			   active-members))
	   (di3 (ldict-set di2 'suspended
			   (filter brmember-suspended? members)))
	   (di4 (ldict-set di3 'students
			   (filter brmember-student? members)))
	   (di5 (ldict-set di4 'destroyed
			   (filter brmember-destroyed? members)))
	   (di6 (ldict-set di5 'month (*current-month*)))
	   (di7 (ldict-set di6 'total members))
	   (di8 (ldict-set di7 'problems
			   (find-members-by-predicate mb-arg brmember-has-problems?)))
	   (di9 (ldict-set di8 'expected
			   (get-expected-income mb-arg)))
	   (mbals (map member-total-balance active-members))
	   (di10 (ldict-set di9 'balance
			    (foldl + 0 mbals)))
	   (di11 (ldict-set di10 'advance
			    (foldl + 0
				   (map (lambda (v)
					  (max 0 v))
					mbals))))
	   (di12 (ldict-set di11 'debt
			    (foldl + 0
				   (map (lambda (v)
					  (min 0 v))
					mbals))))
	   (di13 (ldict-set di12 'age
			    (members-average-age active-members)))
	   )
      di13))

  ;; Returns a list two lists: keys, data.
  ;; Each data record contains values for all keys.
  (define (mbase-stats mb)
    (let ((keys
	   '(month
	     total active suspended students destroyed invalid
	     expected balance advance debt
	     age
	     )))
      (let mloop ((data '())
		  (month (members-base-oldest-month mb)))
	(if (cal-month<=? month (*current-month*))
	    (let ((bi (with-current-month month
					  (mbase-info mb))))
	      (let kloop ((row (list (ldict-ref bi 'month)))
			  (keys (cdr keys)))
		(if (null? keys)
		    (mloop (cons (reverse row) data)
			   (cal-month-add month 1))
		    (kloop (cons (let ((val (ldict-ref bi (car keys))))
				   (if (list? val)
				       (length val)
				       val))
				 row)
			   (cdr keys)))))
	    (list keys (reverse data))))))

  )