guile-grid-printer/grid-printer.scm

;; TODO: remove this load path stuff
(add-to-load-path (dirname (current-filename)))

(define-module (grid-printer)
  #:version (0 2 0)
  #:export (<grid-config>
            make-grid-config))

(use-modules (helpers string-helpers)
             (helpers list-helpers)
             (srfi srfi-9 gnu))

;; =======
;; HELPERS
;; =======
(define-public (find-longest-string-length* lst)
  (find-longest* lst string-length))


(define identity
  (λ (sth) sth))


;; ===
;; LIB
;; ===
(define-immutable-record-type <grid-config>
  ;; define constructor
  (make-grid-config col-sep row-sep intersection empty
                    col-pad row-pad
                    pad-direction)
  ;; define predicate
  grid-config?
  ;; define accessors and functional setters
  (col-sep get-col-sep set-col-sep)
  (row-sep get-row-sep set-row-sep)
  (intersection get-intersection set-intersection)
  (empty get-empty set-empty)
  (col-pad get-col-pad set-col-pad)
  (row-pad get-row-pad set-row-pad)
  (pad-direction get-pad-direction set-pad-direction))

(define-public default-grid-config
  (make-grid-config
   #|col-sep|#
   "|"
   #|row-sep|#
   "-"
   #|intersection|#
   "+"
   #|empty|#
   " "
   #|col-pad|#
   1
   #|row-pad|#
   1
   #|pad-direction|#
   'left))


(define-public print-segmented-line
  (lambda* (seg-count seg-no-borders-width seg-filling seg-border #:optional (port (current-output-port)))
    "Print a line of characters, which is divided into segments. The separators
used to divide the line are given as arguments."
    (let loop ([segs-remaining seg-count])
      (cond [(> segs-remaining 0)
             (display seg-border port)
             (display (string-repeat seg-filling seg-no-borders-width) port)
             (loop (- segs-remaining 1))]
            [else (display seg-border port)
                  (display "\n" port)]))))


(define-public col-content-width
  (lambda (data-part-width grid-config)
    "Calculate the width of a column (or the column including all padding and
other contained content) given a grid configuration and the width of the content
in the column."
    ;; One padding unit could be multiple characters wide, if the string for
    ;; empty or the string for row separator consists of multiple characters.
    (define width-of-one-padding (max (string-length (get-empty grid-config))
                                      (string-length (get-row-sep grid-config))))
    (define padding-one-side (* (get-col-pad grid-config) width-of-one-padding))
    (define padding-total (* 2 padding-one-side))
    (+ padding-total data-part-width)))


(define-public print-empty-line
  (lambda* (fields# data-part-width grid-config #:optional (port (current-output-port)))
    "Print a line of characters, which in terms of the grid's content is
considered empty."
    (print-segmented-line fields#
                          (col-content-width data-part-width grid-config)
                          (get-empty grid-config)
                          (get-col-sep grid-config)
                          port)))


(define-public print-content-line
  (lambda* (min-field-count field-contents data-part-width grid-config
                            #:optional (port (current-output-port)))
    "Print a line of characters, which contains content of the grid."
    (cond
     [(null? field-contents)
      (print-empty-line min-field-count data-part-width grid-config port)]
     [else
      (let loop ([count min-field-count] [contents field-contents])
        (let ([col-content
               (string-join
                (list
                 (string-repeat (get-empty grid-config)
                                (get-col-pad grid-config))
                 (string-padding (if (null? contents)
                                     (get-empty grid-config)
                                     (car contents))
                                 data-part-width
                                 (get-empty grid-config)
                                 #:padding-direction (get-pad-direction grid-config))
                 (string-repeat (get-empty grid-config) (get-col-pad grid-config)))
                "")])
          (display (get-col-sep grid-config) port)
          (display col-content port))
        (if (> count 1)
            (loop (- count 1)
                  (if (null? contents) '() (cdr contents)))
            (display (get-col-sep grid-config) port)))])
    (display "\n" port)))


(define-public print-separating-line
  (lambda* (fields# data-part-width grid-config
                    #:optional (port (current-output-port)))
    "Print a line of characters, which acts as separator between rows."
    (print-segmented-line fields#
                          (col-content-width data-part-width grid-config)
                          (get-row-sep grid-config)
                          (get-intersection grid-config)
                          port)))


;; alias for better readability
(define-public output-padding-line print-empty-line)


(define-public get-nth-cell-parts
  (lambda (cells cell-parts-ref)
    "Get the nth part of each cell in a given list of cells. "
    ;; When cells consist of lists of strings, those strings are supposed to be
    ;; printed on separate lines. When printing to a port, we have to print line
    ;; by line. In consequence we need to first print all first parts, the first
    ;; strings in those lists of strings, then the second parts and so on. For
    ;; that purpose of getting all nth parts of the cells in a single list
    ;; `get-nth-cell-parts` is defined here.
    (map (λ (cell)
           (list-ref cell cell-parts-ref))
         cells)))


(define-public equalize-lines-count
  (lambda (cells fill-elem)
    "Fill cells with parts so that each cell has the same number of lines."
    (let ([desired-len (longest-sublist-length cells)])
      (map (λ (cell-parts)
             (stretch-list cell-parts desired-len fill-elem))
           cells))))


;; A grid row are one or more lines of text which are printed between separation
;; lines.
(define-public print-grid-row
  (lambda* (row-data fields# data-part-width grid-config #:optional port)
    "Print a row of the grid."

    (define content-lines# (longest-sublist-length row-data))

    (define (iter-padding n)
      (cond [(> n 0)
             (output-padding-line fields#
                                  data-part-width
                                  grid-config
                                  port)
             (iter-padding (- n 1))]
            [else (display "" port)]))

    (define (iter-content cells)
      (let loop ([cell-parts-ref 0])
        (cond
         [(= cell-parts-ref content-lines#)
          (display "" port)]
         [else
          (let ([nth-cell-parts (get-nth-cell-parts cells cell-parts-ref)])
            (print-content-line fields#
                                nth-cell-parts
                                data-part-width
                                grid-config port))
          (loop (+ cell-parts-ref 1))])))

    ;; Print the padding above the content.
    (iter-padding (get-row-pad grid-config))
    ;; Print the content in possibly arbitrary number of lines,
    ;; depending on cell-value-split-proc.
    (iter-content (equalize-lines-count row-data (get-empty grid-config)))
    ;; Print the padding below the content.
    (iter-padding (get-row-pad grid-config))))


(define-public print-grid
  (lambda* (data
            #:optional (port (current-output-port))
            #:key (grid-config default-grid-config))
    "Print a grid."

    "The argument data is expected to be a list of rows, of which each is a list
of cells of which each is a list of strings or a simple string."

    "print-grid requires the input to be 2-dimensional or 3-dimensional."

    "print-grid requires the input to be nested list of strings."

    (define fields# (longest-sublist-length data))
    (define longest-string-length (find-longest-string-length* data))
    (define (iter data)
      (cond
       [(null? data) (display "" port)]
       [else
        ;; print initial separating line, outer top border
        (print-separating-line fields# longest-string-length grid-config port)
        ;; Print one row of content.  This could result in multiple
        ;; content containing lines, depending on what
        ;; cell-value-split-proc does.
        (print-grid-row (car data) fields# longest-string-length grid-config port)
        ;; Continue with the next data point.
        (iter (cdr data))]))
    (cond
     [(member (dimendionality data) '(2 3))
      (let ([fields# (longest-sublist-length data)])
        (iter data)
        ;; final separating line, outer bottom border
        (print-separating-line fields# longest-string-length grid-config port))]
     [else
      (error "data dimendionality is not 1 or 2")])))