148 lines
4.4 KiB
Scheme
148 lines
4.4 KiB
Scheme
;;
|
|
;; table.scm
|
|
;;
|
|
;; Simple table formatter.
|
|
;;
|
|
;; 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 table))
|
|
|
|
(module
|
|
table
|
|
(
|
|
table-tests!
|
|
)
|
|
|
|
(import scheme
|
|
(chicken base)
|
|
(chicken string)
|
|
(chicken format)
|
|
ansi
|
|
testing)
|
|
|
|
;; Returns a list of strings representing the rows in the original
|
|
;; string.
|
|
(define (string->rows str)
|
|
(string-split str "\n" #t))
|
|
|
|
;; Creates procedure that ensures a list has given number of elements
|
|
;; filling the missing elements with given filler (defaults to empty
|
|
;; string).
|
|
(define ((make-list-extender ds . ofl) row)
|
|
(let ((fl (if (null? ofl) "" (car ofl))))
|
|
(let ((rs (length row)))
|
|
(if (< rs ds)
|
|
(let loop ((rrow (reverse row))
|
|
(rs rs))
|
|
(if (eq? rs ds)
|
|
(reverse rrow)
|
|
(loop (cons fl rrow)
|
|
(add1 rs))))
|
|
row))))
|
|
|
|
;; Accepts list of lists and makes sure all rows contain the same
|
|
;; number of elements using empty strings as filler.
|
|
(define (table-rectangularize tbl)
|
|
(let ((mrl (apply max (map length tbl))))
|
|
(map (make-list-extender mrl) tbl)))
|
|
|
|
;; Accepts list of lists of anything and returns a list of lists of
|
|
;; strings.
|
|
(define (table-stringify tbl)
|
|
(map
|
|
(lambda (r)
|
|
(map (lambda (c) (sprintf "~A" c)) r))
|
|
tbl))
|
|
|
|
;; Converts a 2D table - list of list of strings - into a table of
|
|
;; cell lists with cell text lines.
|
|
(define (table-prepare-cells tbl)
|
|
(map
|
|
(lambda (r)
|
|
(map string->rows r))
|
|
tbl))
|
|
|
|
;; Accepts a list of cells which are list of strings and returns a
|
|
;; new list with all cells having the same number of text lines.
|
|
(define (table-normalize-row row)
|
|
(let ((ml (apply max (map length row))))
|
|
(map (make-list-extender ml) row)))
|
|
|
|
;; Normalizes the number of text lines in each table row.
|
|
(define (table-normalize-rows tbl)
|
|
(map table-normalize-row tbl))
|
|
|
|
;; Returns the maximum width of each column of the table.
|
|
(define (table-column-widths tbl)
|
|
'())
|
|
|
|
(define (table-row-normalize-cells row cwidths)
|
|
row)
|
|
|
|
;; Normalizes cells in all rows to match the widths of the wides cell
|
|
;; in each column.
|
|
(define (table-normalize-columns tbl)
|
|
(let ((cwidths (table-column-widths tbl)))
|
|
(map (lambda (row)
|
|
(table-row-normalize-cells row cwidths))
|
|
tbl)))
|
|
|
|
;; Ensures the table is rectangular and each cell is a list of strings.
|
|
(define (table-prepare tbl)
|
|
(table-normalize-rows
|
|
(table-prepare-cells
|
|
(table-stringify
|
|
(table-rectangularize tbl)))))
|
|
|
|
(define (table->string tbl . args)
|
|
"")
|
|
|
|
;; Performs module self-tests
|
|
(define (table-tests!)
|
|
(run-tests
|
|
table
|
|
(test-equal? string->rows (string->rows "asdf") '("asdf"))
|
|
(test-equal? string->rows (string->rows "asdf\nqwer") '("asdf" "qwer"))
|
|
(test-equal? string->rows (string->rows "\nasdf\nqwer") '("" "asdf" "qwer"))
|
|
(test-equal? make-list-extender
|
|
((make-list-extender 5) '("test"))
|
|
'("test" "" "" "" ""))
|
|
(test-equal? make-list-extender
|
|
((make-list-extender 5 "x") '("test"))
|
|
'("test" "x" "x" "x" "x"))
|
|
(test-equal? table-rectangularize
|
|
(table-rectangularize '(("x" "y" "z") ("a" "b") ("1" "2" "3" "4")))
|
|
'(("x" "y" "z" "") ("a" "b" "" "") ("1" "2" "3" "4")))
|
|
(test-equal? table-stringify
|
|
(table-stringify '((1 2 3) (a b c) ("d")))
|
|
'(("1" "2" "3") ("a" "b" "c") ("d")))
|
|
(test-equal? table-prepare-cells
|
|
(table-prepare-cells '(("x" "y" "z" "") ("a" "b" "" "") ("1" "2" "3" "4")))
|
|
'((("x") ("y") ("z") ("")) (("a") ("b") ("") ("")) (("1") ("2") ("3") ("4"))))
|
|
(test-equal? table-normalize-row
|
|
(table-normalize-row '(("") ("a" "b")))
|
|
'(("" "") ("a" "b")))
|
|
))
|
|
|
|
)
|
|
|
|
(import table)
|
|
(table-tests!)
|