Add the print module.

This commit is contained in:
Dominik Pantůček 2023-03-25 21:37:17 +01:00
parent 7ca7f996c4
commit 2d0ff00ffb
4 changed files with 124 additions and 2 deletions

View file

@ -196,7 +196,9 @@ member-parser.so: member-parser.o
member-parser.o: member-parser.import.scm
member-parser.import.scm: $(MEMBER-PARSER-SOURCES)
MEMBER-PRINT-SOURCES=member-print.scm
MEMBER-PRINT-SOURCES=member-print.scm dictionary.import.scm \
member-record.import.scm month.import.scm utils.import.scm \
table.import.scm
member-print.so: member-print.o
member-print.o: member-print.import.scm

View file

@ -131,7 +131,6 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(newline)
(print "Current month: " (month->string (*current-month*)))
(newline)
(print mr)
(if mr
(print-member-table mr)
(print-members-base-table MB))

View file

@ -86,6 +86,8 @@
(if ok?
mr1
(member-record-add-highlight mr1 line-number msg 3 'error))))
((joined)
(member-record-sub-set mr output key (string->month (car value))))
(else
(member-record-sub-set mr output key (car value))))))))

119
member-print.scm Normal file
View file

@ -0,0 +1,119 @@
;;
;; member-print.scm
;;
;; Procedures working with complete member record (as loaded by the
;; members-base).
;;
;; 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 member-print))
(module
member-print
(
print-member-info
print-member-table
)
(import scheme
(chicken base)
(chicken string)
(chicken sort)
(chicken format)
dictionary
member-record
month
utils
table)
;; Prints human-readable information
(define (print-member-info mr)
(let* ((id (dict-ref mr 'id))
(aliases (dict-ref mr 'symlinks))
(info (dict-ref mr 'info))
(sinfo (sort info
(lambda (a b)
(string<?
(symbol->string (car a))
(symbol->string (car b)))))))
(print "User " id " alias(es): "
(string-intersperse
(map symbol->string aliases)
", "))
(when (member-suspended? mr)
(print " Suspended for " (member-suspended-months mr) " months."))
(newline)
(let loop ((sinfo sinfo))
(when (not (null? sinfo))
(let* ((kv (car sinfo))
(k (car kv))
(v (cdr kv)))
(loop (cdr sinfo)))))))
;; Prints nicely formatted table
(define (print-member-table mr)
(let* ((aliases (dict-ref mr 'symlinks))
(head (list (list "ID:" (member-id mr))
(list (sprintf "Alias~A:" (if (> (length aliases) 1) "es" ""))
(string-intersperse (map symbol->string aliases) ", "))
(if (member-suspended? mr)
(list "Suspended for:"
(let ((msm (member-suspended-months mr)))
(sprintf "~A month~A" msm
(if (> msm 1) "s" ""))))
#f)))
(info (dict-ref mr 'info))
(sikeys (sort (dict-keys info)
(lambda (a b)
(string<?
(symbol->string a)
(symbol->string b)))))
(body (map (lambda (k)
(let ((v (dict-ref info k)))
(case k
((joined)
(list k (month->string v)))
((card desfire credit)
(list k "xxx"
#;(table->string
(map
(lambda (c)
(list (car c) (cdr c)))
v)
#:col-border #t)))
((suspend student)
(list k
(table->string
(cons (list "Since" "Until")
(map
(lambda (p)
(list
(month->string (car p))
(month->string (cdr p))))
v))
#:col-border #t)))
(else
(list k v)))))
sikeys))
(result (filter identity (append head body))))
(print (table->string result #:table-border #t #:row-border #t #:col-border #t))))
)