135 lines
4 KiB
Scheme
135 lines
4 KiB
Scheme
;;
|
|
;; 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)
|
|
|
|
;; 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)))
|
|
(list (format "Expected income: ~A" 0)
|
|
(format " ~A full members" full)
|
|
(format " ~A students" students)
|
|
)))
|
|
|
|
;; 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)))
|
|
|
|
)
|