;;
;; notifications.scm
;;
;; Email notifications and reminders.
;;
;; 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 notifications))

(module
 notifications
 (
  make+print-reminder-email
  make+send-reminder-email

  make+print-summary-email
  )

 (import scheme
	 (chicken base)
	 (chicken format)
	 brmember
	 util-mail
	 util-dict-list
	 members-payments
	 util-format
	 brmember-format
	 configuration
	 util-time
	 members-fees
	 mbase
	 members-print
	 table)

 ;; Prints email to the console
 (define (print-notification-email em)
   (print "### From: " (ldict-ref em 'from "-"))
   (print "### To: " (ldict-ref em 'to))
   (print "### Subject: " (ldict-ref em 'subject))
   (let loop ((lines (ldict-ref em 'body)))
     (when (not (null? lines))
       (print (car lines))
       (loop (cdr lines)))))

 ;; Sends notification email - the dictionary representation
 (define (send-notification-email em)
   (print "Sending " (ldict-ref em 'subject) " originally to " (ldict-ref em 'to))
   (send-mail (ldict-ref em 'body)
	      #:from (*email-from*)
	      #:to (ldict-ref em 'to)
	      #:subject (ldict-ref em 'subject)))

 ;; Creates reminder email body
 (define (reminder-email-body mr)
   (let ((C identity)
	 (M (lambda (s)
	      (brmember-format s mr)))
	 (F format)
	 (absdebt (format-amount (- (member-total-balance mr))))
	 (macc "2500079551/2010"))
     (list
      (M "Ahoj ~N,")
      (C "podle evidence členů a bankovního účtu to vypadá, že máš nedoplatek")
      (F "ve výši ~A Kč." absdebt)
      (C "Zkontroluj, prosím, zda tvé platby členských příspěvků")
      (M "s variabilním symbolem ~I byly zaslány na")
      (F "správný účet ~A." macc)
      ""
      ""
      (M "Dear ~N,")
      (C "according to the members database and bank account statements, it appears")
      (F "your payment of ~A CZK is missing." absdebt)
      (C "Please, check whether your membership fees were transfered")
      (M "correctly with the variable symbol (identification) ~I to")
      (F "the correct bank account ~A." macc)
      ""
      "--"
      "Brmlab Hackerspace Members Database"
      )))

 ;; Creates reminder email dictionary
 (define (make-reminder-email mr)
   (make-ldict
    `((to . ,(brmember-info mr 'mail))
      (subject . "Připomínka členských příspěvků / Membership fees reminder")
      (body . ,(reminder-email-body mr)))))

 ;; Creates and prints reminder email for given member record
 (define (make+print-reminder-email mr)
   (print-notification-email
    (make-reminder-email mr)))

 ;; Actually send emails
 (define (make+send-reminder-email mr)
   (let ((em (make-reminder-email mr)))
     (send-notification-email em)))

 ;; Summary email of membership fees payments
 (define (summary-email-body mb)
   (let* ((mbs (members-summary mb))
	  (students (car mbs))
	  (full (cdr mbs))
	  (income (+ (* (lookup-member-fee 'normal) full)
		     (* (lookup-member-fee 'student) students)))
	  (income-lst
	   (list (format "Expected income: ~A CZK" income)
		 (format "  ~A full members" full)
		 (format "  ~A students" students)))
	  (unpaired (mbase-unpaired mb))
	  (unpaired-lst
	   (if (null? unpaired)
	       '()
	       (append
		(list ""
		      "Unpaired transactions:")
		(unpaired-table mb #:border-style 'ascii)))))
     (append income-lst
	     unpaired-lst)))

 ;; Creates the summary email structure
 (define (make-summary-email mb)
   (make-ldict
    `((to . ,(*summary-mailto*))
      (subject . ,(format "Členské příspěvky ~A"
			  (today/iso)))
      (body . ,(summary-email-body mb)))))

 (define (make+print-summary-email mb)
   (let ((em (make-summary-email mb)))
     (print-notification-email em)))

 )