;;
;; 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!)