;; ;; brmember-format.scm ;; ;; "Simple" formatting function that gathers information from other ;; modules. ;; ;; ISC License ;; ;; Copyright 2023 Brmlab, z.s. ;; Dominik Pantůček ;; ;; 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 brmember-format)) (module brmember-format ( brmember-format ) (import scheme (chicken string) (chicken format) util-dict-list brmember bank-account members-fees members-payments) ;; Member formatting function for general use. (define (brmember-format fmt mr) (let loop ((fmtl (string->list fmt)) (resl '())) (if (null? fmtl) (string-intersperse (reverse resl) "") (let ((ch (car fmtl))) (if (eq? ch #\~) (loop (cddr fmtl) (cons (case (cadr fmtl) ((#\N) ; Nickname (brmember-nick mr)) ((#\I) ; Member id (number->string (brmember-id mr))) ((#\S) ; Number of months this member is ; currently suspended for (0 for ; non-suspended) (number->string (brmember-suspended-months mr))) ((#\E) ; Number of errors/warnings (let ((n (length (ldict-ref mr 'highlights '())))) (if (eq? n 0) "" (sprintf "[~A]" n)))) ((#\L) ; Date of last payment (let ((payments (brmember-payments mr))) (if (null? payments) "-" (sprintf "~A" (bank-transaction-date (car (reverse payments))))))) ((#\F) ; Fees to be paid (total over all ; membership periods) (sprintf "~A" (member-fees-total mr))) ((#\C) ; Total credit manually written (sprintf "~A" (member-credit-total mr))) ((#\P) ; Total payments made (sprintf "~A" (member-payments-total mr))) ((#\B) ; Current balance (sprintf "~A" (member-total-balance mr))) ((#\A) ; Flags (attributes) list (sprintf "~A" (brmember-flags mr))) ((#\~) "~")) resl)) (loop (cdr fmtl) (cons (make-string 1 (car fmtl)) resl))))))) )