Preliminary work on table rendering.

table.scm

@@ -0,0 +1,119 @@
+;;
+;; 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 row has given number of elements
+ ;; filling the missing elements with given filler (defaults to empty
+ ;; string).
+ (define ((make-row-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-row-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))
+
+ ;; Ensures the table is rectangular and each cell is a list of strings.
+ (define (table-prepare tbl)
+   (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-row-extender
+		 ((make-row-extender 5) '("test"))
+		 '("test" "" "" "" ""))
+    (test-equal? make-row-extender
+		 ((make-row-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"))))
+    ))
+
+ )
+
+(import table)
+(table-tests!)