├── .gitignore ├── LICENSE-APACHE ├── LICENSE-MIT ├── README.md ├── info.rkt ├── main.rkt ├── scribblings └── text-table.scrbl ├── tests ├── table.rkt └── utils.rkt └── utils.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | \#* 3 | .\#* 4 | .DS_Store 5 | compiled/ 6 | /doc/ 7 | -------------------------------------------------------------------------------- /LICENSE-APACHE: -------------------------------------------------------------------------------- 1 | Copyright 2022 laurent 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | -------------------------------------------------------------------------------- /LICENSE-MIT: -------------------------------------------------------------------------------- 1 | safe-case 2 | 3 | MIT License 4 | 5 | Copyright (c) 2022 laurent 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in all 15 | copies or substantial portions of the Software. 16 | 17 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 18 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 19 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 20 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 21 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 23 | SOFTWARE. 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | text-table 2 | ========== 3 | A simple package to display utf-8 textual tables. 4 | Check out the [docs](https://docs.racket-lang.org/text-table/index.html). 5 | 6 | To install: 7 | ``` 8 | raco pkg install text-table 9 | ``` 10 | 11 | See the example in the main submodule of the `main.rkt` file. 12 | You can observe the results by running: 13 | ``` 14 | racket -l text-table 15 | ``` 16 | 17 | A minimalistic example: 18 | ```scheme 19 | #lang racket 20 | (require text-table) 21 | 22 | (print-simple-table 23 | '((a b c d e f gggg h) 24 | (12 "a\nbcde" 77 54 1 5646547987 41 1) 25 | (111 222 3333 44 5 6 7 8888))) 26 | ``` 27 | Output: 28 | ``` 29 | a b c d e f gggg h 30 | 12 a 77 54 1 5646547987 41 1 31 | bcde 32 | 111 222 3333 44 5 6 7 8888 33 | ``` 34 | A less minimalistic example: 35 | ```scheme 36 | (print-table 37 | '((a b c d e f gggg h) 38 | (12 "a\nbcde" 77 54 1 5646547987 41 1) 39 | (111 222 3333 44 5 6 7 8888))) 40 | ``` 41 | ``` 42 | ┌───┬────┬────┬──┬─┬──────────┬────┬────┐ 43 | │a │b │c │d │e│f │gggg│h │ 44 | ├───┼────┼────┼──┼─┼──────────┼────┼────┤ 45 | │12 │a │77 │54│1│5646547987│41 │1 │ 46 | │ │bcde│ │ │ │ │ │ │ 47 | ├───┼────┼────┼──┼─┼──────────┼────┼────┤ 48 | │111│222 │3333│44│5│6 │7 │8888│ 49 | └───┴────┴────┴──┴─┴──────────┴────┴────┘ 50 | ``` 51 | An example with some more bells and whistles: 52 | ```scheme 53 | (print-table 54 | '((a b c d e f gggg h) 55 | (12 "a\nbcde" 77 54 1 5646547987 41 1) 56 | (111 222 3333 44 5 6 7 8888)) 57 | #:border-style 'double 58 | #:framed? #f 59 | #:row-sep? #t 60 | #:align '(left center center center center center center right)) 61 | ``` 62 | ``` 63 | a ║ b ║ c ║d ║e║ f ║gggg║ h 64 | ═══╬════╬════╬══╬═╬══════════╬════╬════ 65 | 12 ║ a ║ 77 ║54║1║5646547987║ 41 ║ 1 66 | ║bcde║ ║ ║ ║ ║ ║ 67 | ═══╬════╬════╬══╬═╬══════════╬════╬════ 68 | 111║222 ║3333║44║5║ 6 ║ 7 ║8888 69 | ``` 70 | 71 | 72 | 73 | 74 | 75 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | (define collection "text-table") 3 | (define deps '("base")) 4 | (define build-deps '("sandbox-lib" 5 | "scribble-lib" "racket-doc" "rackunit-lib")) 6 | (define scribblings '(("scribblings/text-table.scrbl" ()))) 7 | (define pkg-desc "A simple package to print tables in utf-8/ascii format") 8 | (define version "0.0") 9 | (define pkg-authors '(laurent.orseau@gmail.com)) 10 | (define license '(Apache-2.0 OR MIT)) 11 | -------------------------------------------------------------------------------- /main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/format 3 | racket/list 4 | racket/dict 5 | racket/string 6 | racket/match 7 | racket/contract 8 | "utils.rkt") 9 | 10 | (provide 11 | string-length=/c 12 | (rename-out [border-styles named-border-styles]) 13 | border-style/c 14 | border-style1/c 15 | border-style2/c 16 | border-style-frame/c 17 | (contract-out 18 | (table->string table->string/c) 19 | (simple-table->string table->string/c)) 20 | print-table 21 | print-simple-table) 22 | 23 | (define ((string-length=/c n) x) 24 | (and (string? x) 25 | (= n (string-length x)))) 26 | 27 | ;==============; 28 | ;=== Frames ===; 29 | ;==============; 30 | 31 | ;; "Window" style frames. 32 | ;; Easier to specify, and more flexible since col seps may be different for top, middle and bottom. 33 | (define table-frames 34 | '((space 35 | " " 36 | " " 37 | " " 38 | " ") 39 | (single 40 | "┌─┬┐" 41 | "│ ││" 42 | "├─┼┤" 43 | "└─┴┘") 44 | (space-single 45 | "┌──┐" 46 | "│ │" 47 | "├──┤" 48 | "└──┘") 49 | (rounded 50 | "╭─┬╮" 51 | "│ ││" 52 | "├─┼┤" 53 | "╰─┴╯") 54 | (double 55 | "╔═╦╗" 56 | "║ ║║" 57 | "╠═╬╣" 58 | "╚═╩╝") 59 | (heavy 60 | "┏━┳┓" 61 | "┃ ┃┃" 62 | "┣━╋┫" 63 | "┗━┻┛"))) 64 | 65 | (define border-style-frame/c 66 | (list/c (string-length=/c 4) 67 | (string-length=/c 4) 68 | (string-length=/c 4) 69 | (string-length=/c 4))) 70 | 71 | (define (frame->border2 frame) 72 | (map (λ (s) (map string (string->list s))) frame)) 73 | 74 | ;; See 75 | ;; https://en.wikipedia.org/wiki/Box-drawing_character 76 | ;; http://www.utf8-chartable.de/unicode-utf8-table.pl?start=9472&unicodeinhtml=dec 77 | ;; old border styles 78 | (define table-borders 79 | (cons 80 | '(empty ("" " " "" "") ("" " " "" "") ("" " " "" "") ("" " " "" "")) 81 | (for/list ([(name frame) (in-dict table-frames)]) 82 | (cons name (frame->border2 frame)))) 83 | #; ; equivalent to 84 | '((space . (#\space (" " " " " ") (" " " " " ") (" " " " " ") (" " " " " "))) 85 | (space-single . (#\─ ("│" " " "│") ("┌" "─" "┐") ("├" "─" "┤") ("└" "─" "┘"))) 86 | (single . (#\─ ("│" "│" "│") ("┌" "┬" "┐") ("├" "┼" "┤") ("└" "┴" "┘"))) 87 | (rounded . (#\─ ("│" "│" "│") ("╭" "┬" "╮") ("├" "┼" "┤") ("╰" "┴" "╯"))) 88 | (double . (#\═ ("║" "║" "║") ("╔" "╦" "╗") ("╠" "╬" "╣") ("╚" "╩" "╝"))) 89 | (heavy . (#\━ ("┃" "┃" "┃") ("┏" "┳" "┓") ("┣" "╋" "┫") ("┗" "┻" "┛"))))) 90 | 91 | (define border-style1/c 92 | (list/c char? 93 | (list/c string? string? string?) 94 | (list/c string? string? string?) 95 | (list/c string? string? string?) 96 | (list/c string? string? string?))) 97 | 98 | (define border-style2/c 99 | (list/c (list/c string? string? string? string?) 100 | (list/c string? string? string? string?) 101 | (list/c string? string? string? string?) 102 | (list/c string? string? string? string?))) 103 | 104 | (define (border1->border2 border) 105 | (match border 106 | [(list sep-char (list rowl rowm rowr) (list tl tm tr) (list ml mm mr) (list bl bm br)) 107 | (define sep (string sep-char)) 108 | ; default pad-char is " " 109 | (list (list tl sep tm tr) 110 | (list rowl " " rowm rowr) 111 | (list ml sep mm mr) 112 | (list bl sep bm br))])) 113 | 114 | (define border-styles 115 | (cons 'latex (dict-keys table-borders))) 116 | 117 | (define border-style/c 118 | (apply or/c 119 | ; custom (old) style, kept for backward compatibility 120 | border-style1/c 121 | ; new style, with one row separator per row type 122 | border-style2/c 123 | ; custom "window" style 124 | border-style-frame/c 125 | ; default styles 126 | border-styles)) 127 | 128 | (define (make-latex-border-style align framed? col-sep?s) 129 | (define (align-ref al sep?) 130 | (string-append (if sep? "|" "") 131 | (case al [(left) "l"] [(right) "r"] [(center) "c"]))) 132 | (define als (string-append 133 | "\\begin{tabular}{" 134 | (if framed? "|" "") 135 | (string-append* 136 | (align-ref (first align) #f) 137 | (map align-ref (rest align) col-sep?s)) 138 | (if framed? "|}\n\\hline" "}"))) 139 | `((,als "" "" "") 140 | ("" " " " & " " \\\\") 141 | ("\\hline" "" "" "") 142 | (,(if framed? "\\hline\n\\end{tabular}" "\\end{tabular}") "" "" ""))) 143 | 144 | ;==================; 145 | ;=== Alignments ===; 146 | ;==================; 147 | 148 | ;; col: (listof string?) 149 | ;; align: (or/c 'left 'center 'right) 150 | (define (align-column col align pad-string) 151 | (define width (apply max (map string-length col))) 152 | (map (λ (str) 153 | (~a str #:min-width width #:align align #:pad-string pad-string)) 154 | col)) 155 | 156 | ;; mrow: 2d-list? 157 | ;; align: (or/c 'top 'center 'bottom) 158 | (define (align-row mrow align pad-string) 159 | (define height (apply max (map length mrow))) 160 | (map (λ (mcell) 161 | (define n (- height (length mcell))) 162 | (define str-len (string-length (first mcell))) 163 | (define pad (string-repeat pad-string str-len)) 164 | (case align 165 | [(top) (append mcell (make-list n pad))] 166 | [(bottom) (append (make-list n pad) mcell)] 167 | [(center) 168 | (define h (length mcell)) 169 | (define ntop (quotient (- height h) 2)) 170 | (append (make-list ntop pad) mcell (make-list (- height h ntop) pad))] 171 | [else (error "Unknown align-row align:" align)])) 172 | mrow)) 173 | 174 | (define numeric-rx #px"^\\s*([-+]?)\\s*(\\d*)(\\.?)(\\d*)(e?)([-+]?)(\\d*)\\s*$") 175 | 176 | (define (align-column-numeric col align pad-string) 177 | (define cols 178 | (transpose 179 | (map 180 | (λ (str) 181 | (define m (regexp-match numeric-rx str)) 182 | (if m 183 | (cons #f (rest m)) 184 | (cons str (make-list 7 "")))) 185 | col))) 186 | (define rows 187 | (transpose 188 | (cons (first cols) 189 | (map (λ (col align pad) (align-column col align pad)) 190 | (rest cols) 191 | '(right right left left left left right) 192 | (list pad-string pad-string "." "0" "e" "+" "0"))))) 193 | (align-column 194 | (for/list ([row (in-list rows)]) 195 | (or (first row) 196 | (string-append* (rest row)))) 197 | align 198 | pad-string)) 199 | 200 | ;=====================; 201 | ;=== table->string ===; 202 | ;=====================; 203 | 204 | (define table->string/c 205 | (->* ((listof list?)) 206 | (#:->string (pattern-list-of (procedure-arity-includes/c 1)) 207 | #:border-style border-style/c 208 | #:framed? boolean? 209 | #:row-sep? (pattern-list-of boolean?) 210 | #:col-sep? (pattern-list-of boolean?) 211 | #:align (pattern-list-of (or/c 'left 'center 'right)) 212 | #:row-align (pattern-list-of (or/c 'top 'center 'bottom))) 213 | string?)) 214 | 215 | (define print-table 216 | (make-keyword-procedure 217 | (λ (kws kw-args . rst) 218 | (displayln (keyword-apply table->string kws kw-args rst))))) 219 | 220 | (define print-simple-table 221 | (make-keyword-procedure 222 | (λ (kws kw-args . rst) 223 | (displayln (keyword-apply simple-table->string kws kw-args rst))))) 224 | 225 | 226 | ;; If only I could use `define2`… :-/ 227 | (define (simple-table->string ll 228 | #:border-style [border-style 'space] 229 | #:framed? [framed? #false] 230 | #:row-sep? [row-sep? #false] 231 | #:col-sep? [col-sep? #false] 232 | #:->string [->string ~a] 233 | #:align [align 'left] 234 | #:row-align [row-align 'top]) 235 | (table->string ll 236 | #:border-style border-style 237 | #:framed? framed? 238 | #:->string ->string 239 | #:row-sep? row-sep? 240 | #:align align 241 | #:row-align row-align)) 242 | 243 | (define (table->string ll 244 | #:border-style [border-style 'single] 245 | #:framed? [framed? #true] 246 | #:row-sep? [row-sep? #true] 247 | #:col-sep? [col-sep? #true] 248 | #:->string [->string ~a] 249 | #:align [align 'left] 250 | #:row-align [row-align 'top]) 251 | ;::::::::::::::::::; 252 | ;:: Check inputs ::; 253 | ;::::::::::::::::::; 254 | 255 | (unless (and (list? ll) (not (empty? ll)) (andmap list? ll)) 256 | (raise-argument-error 'table->string 257 | "nonempty list of lists of the same lengths" 258 | 0 ll)) 259 | (define lens (map length ll)) 260 | (define n-rows (length ll)) 261 | (define n-columns (first lens)) 262 | (unless (andmap (λ (len) (= len n-columns)) (rest lens)) 263 | (error "All rows must have the same length")) 264 | 265 | ;::::::::::::::::::::::::::; 266 | ;:: Expand pattern lists ::; 267 | ;::::::::::::::::::::::::::; 268 | 269 | (define ->string-list (pattern-list->list ->string n-columns #:truncate-ok? #t)) 270 | (define align-list (pattern-list->list align n-columns #:truncate-ok? #t)) 271 | (define row-align-list (pattern-list->list row-align n-rows #:truncate-ok? #t)) 272 | (define col-sep?s (pattern-list->list col-sep? (- n-columns 1) #:truncate-ok? #t)) 273 | (define row-sep?s (pattern-list->list row-sep? (- n-rows 1) #:truncate-ok? #t)) 274 | 275 | ;:::::::::::::::::::; 276 | ;:: Prepare style ::; 277 | ;:::::::::::::::::::; 278 | 279 | (define style 280 | (cond [(eq? border-style 'latex) 281 | (define new-style (make-latex-border-style align-list framed? col-sep?s)) 282 | ; force borders 283 | (set! framed? #t) 284 | (set! col-sep?s (make-list (- n-columns 1) #t)) 285 | new-style] 286 | [(symbol? border-style) 287 | (dict-ref table-borders border-style)] 288 | [(border-style2/c border-style) 289 | border-style] 290 | [(border-style1/c border-style) ; old style 291 | (border1->border2 border-style)] 292 | [(border-style-frame/c border-style) 293 | (frame->border2 border-style)] 294 | [else 295 | (error "Unrecognized style" border-style)])) 296 | 297 | (define-values (top-row-corners col-seps mid-row-corners bottom-row-corners) 298 | (apply values style)) 299 | (define pad-string (list-ref col-seps 1)) 300 | 301 | ;:::::::::::::::::::::::::; 302 | ;:: Transform the table ::; 303 | ;:::::::::::::::::::::::::; 304 | 305 | ;; ll: 2d-list of any/c 306 | 307 | ;; 0. Each cell initially contains a string, possibly with newlines, turn 308 | ; them into lists of strings without newline. 309 | ;; TODO: We can't consider that a list in a cell is a multiline, 310 | ;; but we could have a `cell` struct that can contains multiple elements 311 | ;; to be displayed on several lines 312 | (define ll1 313 | (map (λ (row) (map (λ (cell ->string) 314 | (define res (string-split (if (string? cell) cell (->string cell)) 315 | "\n")) 316 | (if (empty? res) '("") res)) 317 | row 318 | ->string-list)) 319 | ll)) 320 | 321 | #;(writeln ll1) 322 | 323 | ;; ll1: 3d-list of string 324 | ;; (cells are list of strings) 325 | 326 | ;; 1. transpose table, 327 | ;; align-column, so that all lines in a cell of all cells of the column have the same width 328 | ;; transpose table back 329 | (define ll2 330 | (transpose 331 | (map (λ (mcol align) (apply/2d-list-as-list align-column mcol align pad-string)) 332 | (transpose ll1) 333 | align-list))) 334 | 335 | #;(writeln ll2) 336 | 337 | ;; 2. align-row, to create the missing lines in the cell, so all cells in the same 338 | ;; row have the same number of lines (same height) 339 | (define ll3 (map (λ (mrow align) (align-row mrow align pad-string)) 340 | ll2 341 | row-align-list)) 342 | 343 | #;(writeln ll3) 344 | 345 | (define cell-widths (map (λ (mcell) (string-length (first mcell))) 346 | (first ll3))) 347 | 348 | (define (make-row-line strs row-corners) 349 | (define (@ n) (list-ref row-corners n)) 350 | (define row-sep (@ 2)) 351 | ; Special case for latex 352 | (define no-sep (@ 1)) 353 | (string-append 354 | (if framed? (@ 0) "") 355 | (first strs) 356 | (string-append* 357 | (append-map (λ (str sep?) (if sep? (list row-sep str) (list no-sep str))) 358 | (rest strs) 359 | col-sep?s)) 360 | (if framed? (@ 3) "")) 361 | #; 362 | (string-join strs 363 | (@ 2) 364 | #:before-first (if framed? (@ 0) "") 365 | #:after-last (if framed? (@ 3) ""))) 366 | 367 | ;; 3. For each mrow, transpose the mrow, then string-join the lines of a rows 368 | ;; to obtain a simple list of strings, one per line, but without the frame rows. 369 | (define ll4 370 | (map (λ (mrow) 371 | (string-join 372 | (map (λ (strs) (make-row-line strs col-seps)) 373 | (transpose mrow)) 374 | "\n")) 375 | ll3)) 376 | 377 | #;(writeln ll4) 378 | 379 | (define (make-sep-line row-corners) 380 | (define row-sep (list-ref row-corners 1)) 381 | (define row-sep-len (string-length row-sep)) 382 | (make-row-line 383 | (if (= row-sep-len 0) 384 | (make-list n-columns "") 385 | (for/list ([len (in-list cell-widths)]) 386 | (string-repeat row-sep len))) 387 | row-corners 388 | #;(string-repeat make-string (string-length pad-string) row-sep))) 389 | 390 | (define mid-sep-line (make-sep-line mid-row-corners)) 391 | 392 | ;; 4. Finally, append all the lines together, adding the frame lines if applicable. 393 | (string-join 394 | #:before-first 395 | (if framed? 396 | (string-append (make-sep-line top-row-corners) "\n") 397 | "") 398 | (if row-sep? 399 | (cons (first ll4) 400 | (append-map (λ (row sep?) (if sep? (list mid-sep-line row) (list row))) 401 | (rest ll4) 402 | row-sep?s)) 403 | ll4) 404 | "\n" 405 | #:after-last 406 | (if framed? 407 | (string-append "\n" (make-sep-line bottom-row-corners)) 408 | ""))) 409 | 410 | ;============; 411 | ;=== Main ===; 412 | ;============; 413 | 414 | ;; Usage example. To see the output, run: 415 | ;; racket -l text-table 416 | (module+ main 417 | 418 | (define table 419 | '((a b c d e f gggg h) 420 | (123 456 77 54 1 5646547987 41 1) 421 | (111 22 3333 44 5 6 7 8888))) 422 | 423 | (define aligns 424 | '(left center center center center center center right)) ; one alignment per column 425 | 426 | (for* ([align (in-list (list 'left 'center 'right aligns))]) 427 | (newline) 428 | (newline) 429 | ; Print values 430 | (displayln 431 | (table->string 432 | (list (list '#:align align)))) 433 | ; Example 434 | (displayln 435 | (table->string 436 | table 437 | #:align align))) 438 | 439 | (for* ([border-style (in-list border-styles)] 440 | [framed? (in-list '(#t #f))] 441 | [row-sep? (in-list '(#t #f))]) 442 | (newline) 443 | (newline) 444 | ; Print values 445 | (displayln 446 | (table->string 447 | (list (list '#:border-style border-style) 448 | (list '#:framed? framed?) 449 | (list '#:row-sep? row-sep?)))) 450 | ; Example 451 | (displayln 452 | (table->string 453 | table 454 | #:align aligns 455 | #:border-style border-style 456 | #:row-sep? row-sep? 457 | #:framed? framed?))) 458 | 459 | (newline) 460 | (newline) 461 | (displayln "Multiline") 462 | (newline) 463 | (displayln 464 | (table->string 465 | `(["hello\nworld" "1\n2\n3" "3" ""] 466 | ["" "" "" ""] 467 | ["a\nbb\nccc\ndddd" "1" "22\n22" ""])))) 468 | 469 | 470 | (module+ drracket 471 | 472 | (for ([col (list 473 | (map ~a '(1 100 1000)) 474 | (map ~a '(1 100 1e3)) 475 | (map ~a '(1 100 1000 -12)) 476 | (map ~a '(1 100 1000 1.12)) 477 | (map ~a '(1 100 1000 3e25)) 478 | (map ~a '(1 100 1000 3e25 2.12e31)) 479 | '("hello" "1.2e34" "+inf.0" "12e34" 480 | "12345" "12.34" "1.234e-3" "2.322e+03" "-nan.0" "-13.3"))]) 481 | (displayln (string-join (align-column-numeric col 'center "_") "\n")) 482 | (newline)) 483 | 484 | (define mcol 485 | '(("hello") ("1.2e34") ("+inf.0" "12e34") 486 | ("12345" "12.34" "1.234e-3" "2.322e+03") ("-nan.0") ("-13.3"))) 487 | 488 | (apply/2d-list-as-list align-column-numeric mcol 'right "_") 489 | (flatten (apply/2d-list-as-list align-column-numeric mcol 'right "_"))) 490 | -------------------------------------------------------------------------------- /scribblings/text-table.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require racket/sandbox 3 | scribble/example 4 | text-table 5 | (for-label text-table 6 | text-table/utils 7 | racket/contract 8 | racket/base 9 | racket/format 10 | racket/string)) 11 | 12 | @title{Text Table} 13 | @author{Laurent Orseau} 14 | 15 | @(define my-eval 16 | (parameterize ([sandbox-output 'string] 17 | [sandbox-error-output 'string] 18 | [sandbox-memory-limit 50]) 19 | (make-evaluator 'racket/base '(require text-table 20 | text-table/utils 21 | racket/format 22 | racket/list)))) 23 | 24 | @defmodule[text-table]{ 25 | A simple package to display utf-8 textual tables.} 26 | 27 | License: APACHE2+MIT 28 | 29 | To install: 30 | 31 | @verbatim{raco pkg install text-table} 32 | 33 | See the example in the main submodule of the @filepath{main.rkt} file. 34 | You can observe the results by running: 35 | 36 | @verbatim{racket -l text-table} 37 | 38 | @examples[ 39 | #:eval my-eval 40 | (code:comment "Minimalistic example:") 41 | (print-table 42 | '((a b c d e f gggg h) 43 | (123 456 77 54 1 5646547987 41 1) 44 | (111 22 3333 44 5 6 7 8888))) 45 | 46 | (code:comment "With more bells and whistles") 47 | (print-table 48 | '((a b c d e f gggg h) 49 | (123 456 77 54 1 5646547987 41 1) 50 | (111 22 3333 44 5 6 7 8888)) 51 | #:border-style 'double 52 | #:framed? #f 53 | #:row-sep? #t 54 | #:align '(left center right)) 55 | 56 | (code:comment "Custom border style using border-style-frame/c") 57 | (print-table '((abc abc abc) 58 | (abcdef ab abcdef) 59 | (a abcdef abc)) 60 | #:border-style 61 | '("╭─┬╮" 62 | "│.││" 63 | "├─┼┤" 64 | "╰─┴╯") 65 | #:align '(center) 66 | #:framed? #t 67 | #:row-sep? #t) 68 | 69 | (code:comment "Custom border style using border-style2/c") 70 | (print-table '((abc abc abc) 71 | (abcdef ab abcdef) 72 | (a abcdef abc)) 73 | #:border-style 74 | '(("" "" "" "") 75 | ("") 76 | ("" "" "" "") 77 | ("
" " " " " "
" "" "" "")) 78 | #:framed? #t 79 | #:row-sep? #f) 80 | 81 | (code:comment "LaTeX style") 82 | (print-table '((abc abc abc) 83 | (abcdef ab abcdef) 84 | (a abcdef abc)) 85 | #:border-style 'latex) 86 | 87 | (code:comment "Aligning numbers (incorrectly then well)") 88 | (print-table 89 | #:row-sep? '(#t #f ...) 90 | #:col-sep? '(#t #f ...) 91 | #:align '(left right ... center) 92 | #:->string 93 | (list 94 | ~a (code:comment "Name") 95 | ~a (~r*) (~r* #:precision '(= 2)) (~r* #:notation 'exponential) (code:comment "Speed") 96 | ~a) (code:comment "Unit") 97 | (code:comment "The table:") 98 | (map (λ (l) (pattern-list->list l 6)) 99 | `((Name Speed ... Unit) 100 | (Alice 10 ... "km/h") 101 | (Bob ,(sqrt 2) ... "m/s") 102 | (Charlie +inf.0 +nan.0 ... ... n/a) 103 | (light ,(* 299792458 (expt 10 3)) ... "mm/s")))) 104 | 105 | (code:comment "Empty style and doubly repeating alignments") 106 | (print-simple-table 107 | #:border-style 'empty 108 | #:align '(right left ... ...) 109 | (list (make-list 10 '*) 110 | (make-list 10 '**) 111 | (make-list 10 '***) 112 | (make-list 10 '****) 113 | (make-list 10 '*****) 114 | (make-list 10 "|"))) 115 | 116 | (code:comment "Multiple separators") 117 | (print-table (for/list ((i 6)) (for/list ((j 10)) (* (+ i 1) (+ j 1)))) 118 | #:row-sep? '(#t #f ... ...) 119 | #:col-sep? '(#t #f ... ...)) 120 | ] 121 | 122 | @section{Tables} 123 | 124 | @defproc[(table->string 125 | [table (listof list?)] 126 | [#:->string to-string (pattern-list-of (procedure-arity-includes/c 1)) ~a] 127 | [#:border-style border-style border-style/c 'single] 128 | [#:framed? framed? boolean? #t] 129 | [#:row-sep? row-sep? (pattern-list-of boolean?) #t] 130 | [#:col-sep? col-sep? (pattern-list-of boolean?) #t] 131 | [#:align align 132 | (pattern-list-of (or/c 'left 'center 'right)) 133 | 'left] 134 | [#:row-align row-align 135 | (pattern-list-of (or/c 'top 'center 'bottom)) 136 | 'top]) 137 | string?]{ 138 | Accepts a table specified as a list of lists, and returns a string 139 | representing the table. The lists must all be of the same lengths. 140 | 141 | The @racket[to-string] procedure is used to convert cell values to 142 | strings, or a pattern-list of such procedures. Note that strings are 143 | not converted. 144 | 145 | The @racket[border-style] specifies the style of lines to be used 146 | in drawing the table. 147 | 148 | When @racket[framed?] is @racket[#true], a frame is drawn around the 149 | outside of the table. 150 | 151 | The @racket[row-sep?] and @racket[col-sep?] arguments 152 | specify whether separators are added between rows or columns. 153 | 154 | The @racket[align] specification indicates how the contents of the 155 | cells are to be aligned within their cells. A single-symbol specification 156 | applies to all cells, or a list of symbols of the same length as the 157 | rows can be applied in order to specify the alignment of each column 158 | independently. When @racket[align] is a list, it is trimmed to the length 159 | of the columns if it is too long, or the last element of the list is used 160 | for the remaining columns if it is too short. 161 | 162 | The @racket[row-align] specification indicates how the contents of the cells 163 | are aligned in a row, when cells are strings with multiple lines. 164 | 165 | The @racket[to-string], @racket[align] and @racket[row-align], @racket[row-sep?] and 166 | @racket[col-sep?] arguments accept pattern lists. 167 | } 168 | 169 | @defproc[(simple-table->string 170 | [table (listof list?)] 171 | [#:->string to-string (pattern-list-of (procedure-arity-includes/c 1)) ~a] 172 | [#:border-style border-style border-style/c 'single] 173 | [#:framed? framed? boolean? #f] 174 | [#:row-sep? row-sep? (pattern-list-of boolean?) #f] 175 | [#:col-sep? col-sep? (pattern-list-of boolean?) #f] 176 | [#:align align 177 | (pattern-list-of (or/c 'left 'center 'right)) 178 | 'left] 179 | [#:row-align row-align 180 | (pattern-list-of (or/c 'top 'center 'bottom)) 181 | 'top]) 182 | string?]{ 183 | Like @racket[table->string], but with different default arguments to output a minimalistic table. 184 | } 185 | @examples[#:eval my-eval 186 | (displayln 187 | (simple-table->string 188 | #:align '(left right) 189 | '((a b c d e f gggg h) 190 | (123 456 77 54 1 5646547987 41 1) 191 | (111 22 3333 44 5 6 7 8888))))] 192 | 193 | @defproc[(print-table 194 | [table (listof list?)] 195 | [#:->string to-string (pattern-list-of (procedure-arity-includes/c 1)) ~a] 196 | [#:border-style border-style border-style/c 'single] 197 | [#:framed? framed? boolean? #t] 198 | [#:row-sep? row-sep? (pattern-list-of boolean?) #t] 199 | [#:col-sep? col-sep? (pattern-list-of boolean?) #t] 200 | [#:align align 201 | (pattern-list-of (or/c 'left 'center 'right)) 202 | 'left] 203 | [#:row-align row-align 204 | (pattern-list-of (or/c 'top 'center 'bottom)) 205 | 'top]) 206 | void?]{ 207 | Shorthand form for @racket[(displayln (table->string args ...))]. 208 | Takes the same arguments as @racket[table->string]. 209 | } 210 | 211 | @defproc[(print-simple-table 212 | [table (listof list?)] 213 | [#:->string to-string (pattern-list-of (procedure-arity-includes/c 1)) ~a] 214 | [#:border-style border-style border-style/c 'single] 215 | [#:framed? framed? boolean? #f] 216 | [#:row-sep? row-sep? (pattern-list-of boolean?) #f] 217 | [#:col-sep? col-sep? (pattern-list-of boolean?) #f] 218 | [#:align align 219 | (pattern-list-of (or/c 'left 'center 'right)) 220 | 'left] 221 | [#:row-align row-align 222 | (pattern-list-of (or/c 'top 'center 'bottom)) 223 | 'top]) 224 | void?]{ 225 | Shorthand form for @racket[(displayln (simple-table->string args ...))]. 226 | Takes the same arguments as @racket[simple-table->string]. 227 | } 228 | 229 | @; I tried this, but doesn't format well. #,@ doesn't work (because of @-reader?) 230 | @; #,named-border-styles 231 | @defthing[border-style/c contract? 232 | #:value 233 | (or/c 234 | 'empty 'latex 'space 'space-single 'single 'rounded 'double 'heavy 235 | border-style1/c 236 | border-style2/c 237 | border-style-frame/c 238 | )]{ 239 | Border style contract. 240 | The list element is for custom border styles. 241 | See the example at the top of this document. 242 | } 243 | 244 | @defthing[border-style1/c contract? 245 | #:value 246 | (list/c char? (code:comment "row sep") 247 | (list/c string? string? string?) (code:comment "text line") 248 | (list/c string? string? string?) (code:comment "top line") 249 | (list/c string? string? string?) (code:comment "middle line") 250 | (list/c string? string? string?) (code:comment "bottom line"))]{ 251 | The old border style. Obsolete but kept for backward compatibility. 252 | See @racket[border-style2/c] instead. 253 | Note that, compared to @racket[border-style2/c], 254 | the first an second lists are in reverse order, 255 | the row separator is the same for all lines, 256 | and the space filler is always @racket[" "]. 257 | } 258 | 259 | @defthing[border-style2/c contract? 260 | #:value 261 | (list/c (list/c string? string? string? string?) (code:comment "top line") 262 | (list/c string? string? string? string?) (code:comment "text line") 263 | (list/c string? string? string? string?) (code:comment "middle line") 264 | (list/c string? string? string? string?) (code:comment "bottom line"))]{ 265 | Each string specifies one of the elements of the frame of the table. 266 | The strings can be of arbitrary length 267 | @examples[#:eval my-eval 268 | #:label #f 269 | (print-table 270 | '((_ _ ____ _) 271 | (_ _ _ _) 272 | (__ "_\n__" _ _)) 273 | #:border-style 274 | '(("╭" "^" "┬" "╮") 275 | ("{" "." "│" "}") 276 | ("├" "─" "+" "┤") 277 | ("╰" "v" "┴" "╯")))] 278 | The element @racket["."] is a space filler. 279 | Note that each element can be a multi-character string rather than a single char. 280 | See also @racket[border-style-frame/c]. 281 | } 282 | 283 | @defthing[border-style-frame/c contract? 284 | #:value 285 | (list/c (string-length=/c 5) (code:comment "top line") 286 | (string-length=/c 5) (code:comment "text line") 287 | (string-length=/c 5) (code:comment "middle line") 288 | (string-length=/c 5) (code:comment "bottom line"))]{ 289 | A simplification of @racket[border-style2/c] where each element of the frame is a single 290 | character, so they can all be specified in a single string per line. 291 | @examples[#:eval my-eval 292 | #:label #f 293 | (print-table '((abc abc abc) 294 | (abcdef ab abcdef) 295 | (a abcdef abc)) 296 | #:border-style 297 | '("╭─┬╮" 298 | "│.││" 299 | "├─┼┤" 300 | "╰─┴╯") 301 | #:align '(center))] 302 | Note that the @racket["."] is the space filler.} 303 | 304 | 305 | @defproc[((string-length=/c [n integer?]) [x any/c]) boolean?]{ 306 | Returns @racket[#true] if @racket[x] is a string of length @racket[n], 307 | @racket[#false] otherwise.} 308 | 309 | @section{Utilities} 310 | 311 | @defmodule[text-table/utils]{Utilities used to build text tables.} 312 | 313 | @subsection{Lists} 314 | 315 | @defproc[((pattern-list-of [pred? (procedure-arity-includes/c 1)]) [x any/c]) boolean?]{ 316 | Returns @racket[#true] if either @racket[x] is not a list and @racket[(pred? x)] is @racket[#true], 317 | or @racket[x] is a list @racket[(head ... dots ... tail ...)] 318 | satisfying @racket[(andmap pred? (head ... tail ...))] 319 | and @racket[(dots ...)] is a list of @racket['...] not longer than @racket[(head ...)]. 320 | } 321 | 322 | @defproc[(pattern-list->list [pat (pattern-list-of any/c)] 323 | [#:truncate-ok? truncate-ok? any/c #f] 324 | [result-length exact-nonnegative-integer?]) 325 | list?]{ 326 | @examples[#:eval my-eval 327 | (pattern-list->list 'a 3) 328 | (pattern-list->list '(a) 3) 329 | (pattern-list->list '(a b) 5) 330 | (pattern-list->list '(a b ...) 5) 331 | (pattern-list->list '(a b c ... ...) 10) 332 | (pattern-list->list '(a b c d ... ... ... e f) 10) 333 | (eval:error (pattern-list->list '(a b c d ... ... ... e f) 2)) 334 | (pattern-list->list '(a b c d ... ... ... e f) 2 #:truncate-ok? #t)] 335 | } 336 | 337 | @defproc[(transpose [l (listof list?)]) (listof list?)]{ 338 | Returns a new list where the columns and rows of @racket[l] are swapped. 339 | @examples[#:eval my-eval 340 | (transpose '((a b c) (1 2 3)))] 341 | } 342 | 343 | 344 | @defproc[(group-by-lengths [l list?] [lengths (listof exact-nonnegative-integer?)]) 345 | (listof list?)]{ 346 | Returns a list with the same elements as @racket[l] but grouped in sublists 347 | of lengths given by @racket[lengths]. 348 | @examples[#:eval my-eval 349 | (group-by-lengths '(a b c d e f g) 350 | '(1 0 2 3 0 1))] 351 | } 352 | 353 | @;@defproc[(apply/2d-list-as-list [proc procedure?] [ll (listof list?)] [args any/c] ...) 354 | @; (listof (list))]{TODO} 355 | 356 | @subsection{Strings} 357 | 358 | @defproc[(string-repeat [str string?] [len exact-nonnegative-integer?]) string?]{ 359 | Returns a string of length @racket[len] by repeating @racket[str]. 360 | @examples[#:eval my-eval 361 | (string-repeat "abc" 5) 362 | (string-repeat "abc" 2)]} 363 | 364 | @defproc[(~r* [#:sign sign 365 | (or/c #f '+ '++ 'parens 366 | (let ([ind (or/c string? (list/c string? string?))]) 367 | (list/c ind ind ind))) 368 | #f] 369 | [#:base base 370 | (or/c (integer-in 2 36) (list/c 'up (integer-in 2 36))) 371 | 10] 372 | [#:precision precision 373 | (or/c exact-nonnegative-integer? 374 | (list/c '= exact-nonnegative-integer?)) 375 | 6] 376 | [#:notation notation 377 | (or/c 'positional 'exponential 378 | (-> rational? (or/c 'positional 'exponential))) 379 | 'positional] 380 | [#:format-exponent format-exponent 381 | (or/c #f string? (-> exact-integer? string?)) 382 | #f] 383 | [#:min-width min-width exact-positive-integer? 1] 384 | [#:pad-string pad-string non-empty-string? " "] 385 | [#:groups groups (non-empty-listof exact-positive-integer?) '(3)] 386 | [#:group-sep group-sep string? ""] 387 | [#:decimal-sep decimal-sep string? "."]) 388 | (any/c . -> . string?)]{ 389 | Like @racket[~r] but curried, and also accepts non-rationals, 390 | which are printed with @racket[~a] instead. 391 | @examples[#:eval my-eval 392 | (print-table 393 | #:->string (list ~a (code:comment "1") 394 | (~r*) (code:comment "2") 395 | (~r* #:notation 'exponential) (code:comment "3") 396 | (~r* #:precision '(= 2)) (code:comment "4 (good)") 397 | (~r* #:notation 'exponential #:precision '(= 2)) (code:comment "5 (good)") 398 | (~r* #:min-width 10 #:pad-string ".")) (code:comment "6") 399 | #:align '(right ... ) 400 | #:row-sep? '(#f #t #f ...) 401 | (cons 402 | '("1" "2" "3" "4 (good)" "5 (good)" "6") 403 | (transpose 404 | (make-list 6 `(header 1111.11 22.222 33.33e5 4.44e12 ,(sqrt 2))))))] 405 | } 406 | @;'("1" "2" "3" "4👍\u200B" "5👍\u200B" "6") 407 | @; cheat because 👍 is double-width. \u200B is a zero-width space 408 | 409 | -------------------------------------------------------------------------------- /tests/table.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require text-table 3 | rackunit) 4 | 5 | ; to write/try test easily: 6 | (define-syntax-rule (tbcheck expr) 7 | (let ([res expr]) 8 | (displayln res) 9 | `(check-equal? expr ,res))) 10 | ; Ex: 11 | #;(tbcheck (simple-table->string '((aaa bbb ccc) 12 | (1 2 3)))) 13 | 14 | (check-exn exn:fail? (λ () (table->string '()))) 15 | 16 | (check-exn exn:fail? (λ () (table->string '(a)))) 17 | 18 | (check-exn exn:fail? (λ () (table->string '([a b] [c])))) 19 | 20 | (check-equal? (table->string '([a "b\nbbb"] [c 3])) 21 | (string-join '("┌─┬───┐" 22 | "│a│b │" 23 | "│ │bbb│" 24 | "├─┼───┤" 25 | "│c│3 │" 26 | "└─┴───┘") 27 | "\n")) 28 | ; Check border-style1/c still works 29 | (check-equal? (table->string '([a "b\nbbb"] [c 3]) 30 | #:border-style 31 | '(#\─ ("│" "│" "│") ("┌" "┬" "┐") ("├" "┼" "┤") ("└" "┴" "┘")) 32 | ) 33 | (string-join '("┌─┬───┐" 34 | "│a│b │" 35 | "│ │bbb│" 36 | "├─┼───┤" 37 | "│c│3 │" 38 | "└─┴───┘") 39 | "\n")) 40 | 41 | (check-equal? 42 | (table->string 43 | '((a b c d e f gggg h) 44 | (123 456 77 54 "a\nbbbb\nc" 5646547987 41 1) 45 | (111 22 3333 44 5 6 7 8888)) 46 | #:border-style 47 | 'latex 48 | #:framed? 49 | #t 50 | #:row-sep? 51 | '(#t ...) 52 | #:align 53 | '(left center right center)) 54 | "\\begin{tabular}{|l|c|r|c|c|c|c|c|}\n\\hline\na & b & c & d & e & f & gggg & h \\\\\n\\hline\n123 & 456 & 77 & 54 & a & 5646547987 & 41 & 1 \\\\\n & & & & bbbb & & & \\\\\n & & & & c & & & \\\\\n\\hline\n111 & 22 & 3333 & 44 & 5 & 6 & 7 & 8888 \\\\\n\\hline\n\\end{tabular}") 55 | 56 | (check-equal? 57 | (table->string 58 | (for/list ((i 5)) (for/list ((j 6)) (* (+ i 1) (+ j 1)))) 59 | #:align 60 | 'right 61 | #:border-style 62 | 'latex) 63 | "\\begin{tabular}{|r|r|r|r|r|r|}\n\\hline\n1 & 2 & 3 & 4 & 5 & 6 \\\\\n\\hline\n2 & 4 & 6 & 8 & 10 & 12 \\\\\n\\hline\n3 & 6 & 9 & 12 & 15 & 18 \\\\\n\\hline\n4 & 8 & 12 & 16 & 20 & 24 \\\\\n\\hline\n5 & 10 & 15 & 20 & 25 & 30 \\\\\n\\hline\n\\end{tabular}") 64 | 65 | ;; border-style-frame/c 66 | (check-equal? 67 | (table->string '((a b c d e f gggg h) 68 | (123 456 77 54 "a\nbbb\nc" 123456 41 1) 69 | (111 22 3333 44 5 6 7 8888)) 70 | #:border-style 71 | '("<-+>" 72 | "(.│)" 73 | "[-+]" 74 | "{-+}") 75 | #:framed? #t 76 | #:row-sep? #t 77 | #:align '(left center right center)) 78 | "\ 79 | <---+---+----+--+---+------+----+----> 80 | (a..│.b.│...c│d.│.e.│..f...│gggg│.h..) 81 | [---+---+----+--+---+------+----+----] 82 | (123│456│..77│54│.a.│123456│.41.│.1..) 83 | (...│...│....│..│bbb│......│....│....) 84 | (...│...│....│..│.c.│......│....│....) 85 | [---+---+----+--+---+------+----+----] 86 | (111│22.│3333│44│.5.│..6...│.7..│8888) 87 | {---+---+----+--+---+------+----+----}") 88 | 89 | (check-equal? 90 | (simple-table->string '((aaa bbb ccc))) 91 | "aaa bbb ccc") 92 | 93 | (check-equal? (simple-table->string '((aaa bbb ccc) (1 2 3))) 94 | "aaa bbb ccc\n1 2 3 ") 95 | (check-equal? 96 | (simple-table->string '((aaa bbb ccc "") (1 2 3 ""))) 97 | "aaa bbb ccc \n1 2 3 ") 98 | 99 | (check-equal? (simple-table->string '((""))) "") 100 | (check-equal? 101 | (simple-table->string #:border-style 'empty '((a bb c d) (1 2 33 44))) 102 | "abbc d \n12 3344") 103 | 104 | (check-equal? (table->string '(("" "") ("" ""))) "┌┬┐\n│││\n├┼┤\n│││\n└┴┘") 105 | (check-equal? (table->string '((b "") ("" a))) "┌─┬─┐\n│b│ │\n├─┼─┤\n│ │a│\n└─┴─┘") 106 | 107 | ;;; Check alignment 108 | 109 | (check-equal? 110 | (table->string '((aaa bbb cccc dddd) (1 22 3 33)) #:align 'right) 111 | "┌───┬───┬────┬────┐\n│aaa│bbb│cccc│dddd│\n├───┼───┼────┼────┤\n│ 1│ 22│ 3│ 33│\n└───┴───┴────┴────┘") 112 | (check-equal? 113 | (table->string '((aaa bbb cccc dddd) (1 22 3 33)) #:align 'left) 114 | "┌───┬───┬────┬────┐\n│aaa│bbb│cccc│dddd│\n├───┼───┼────┼────┤\n│1 │22 │3 │33 │\n└───┴───┴────┴────┘") 115 | 116 | (check-equal? 117 | (table->string '((aaa bbb cccc dddd) (1 22 3 33)) #:align 'center) 118 | "┌───┬───┬────┬────┐\n│aaa│bbb│cccc│dddd│\n├───┼───┼────┼────┤\n│ 1 │22 │ 3 │ 33 │\n└───┴───┴────┴────┘") 119 | 120 | (check-equal? 121 | (table->string '((aaa bbb cccc dddd) (1 22 3 33)) #:align '(left right)) 122 | "┌───┬───┬────┬────┐\n│aaa│bbb│cccc│dddd│\n├───┼───┼────┼────┤\n│1 │ 22│ 3│ 33│\n└───┴───┴────┴────┘") 123 | 124 | (check-equal? 125 | (table->string '((aaa bbb cccc dddd) (1 22 3 33)) #:align '(left ... right)) 126 | "┌───┬───┬────┬────┐\n│aaa│bbb│cccc│dddd│\n├───┼───┼────┼────┤\n│1 │22 │3 │ 33│\n└───┴───┴────┴────┘") 127 | 128 | (check-equal? 129 | (table->string '((aaa bbbb cccc dddd) (1 22 3 33)) #:align '(left center ... right)) 130 | "┌───┬────┬────┬────┐\n│aaa│bbbb│cccc│dddd│\n├───┼────┼────┼────┤\n│1 │ 22 │ 3 │ 33│\n└───┴────┴────┴────┘") 131 | 132 | (check-equal? 133 | (table->string 134 | '((aaa bbbb cccc dddd eeee) (1 22 3 33 4)) 135 | #:align 136 | '(left center ... ... right)) 137 | "┌───┬────┬────┬────┬────┐\n│aaa│bbbb│cccc│dddd│eeee│\n├───┼────┼────┼────┼────┤\n│1 │ 22 │3 │ 33 │ 4│\n└───┴────┴────┴────┴────┘") 138 | 139 | (check-equal? 140 | (table->string (for/list ((i 6)) (for/list ((j 5)) (* i j))) #:row-sep? '(#t #f ... ...)) 141 | "┌─┬─┬──┬──┬──┐\n│0│0│0 │0 │0 │\n├─┼─┼──┼──┼──┤\n│0│1│2 │3 │4 │\n│0│2│4 │6 │8 │\n├─┼─┼──┼──┼──┤\n│0│3│6 │9 │12│\n│0│4│8 │12│16│\n├─┼─┼──┼──┼──┤\n│0│5│10│15│20│\n└─┴─┴──┴──┴──┘") 142 | 143 | (check-equal? 144 | (table->string 145 | (for/list ((i 5)) (for/list ((j 6)) (* (+ i 1) (+ j 1)))) 146 | #:align 147 | 'right 148 | #:framed? 149 | #f 150 | #:row-sep? 151 | '(#t #f) 152 | #:col-sep? 153 | '(#t #f) 154 | #:border-style 155 | 'single) 156 | "1│ 2 3 4 5 6\n─┼──────────────\n2│ 4 6 8 10 12\n3│ 6 9 12 15 18\n4│ 8 12 16 20 24\n5│10 15 20 25 30") 157 | 158 | (check-equal? 159 | (table->string 160 | (for/list ((i 5)) (for/list ((j 6)) (* (+ i 1) (+ j 1)))) 161 | #:align 162 | 'right 163 | #:framed? 164 | #f 165 | #:row-sep? 166 | '(#t #f) 167 | #:col-sep? 168 | '(#t #f) 169 | #:border-style 170 | 'latex) 171 | "\\begin{tabular}{r|rrrrr}\n1 & 2 & 3 & 4 & 5 & 6 \\\\\n\\hline\n2 & 4 & 6 & 8 & 10 & 12 \\\\\n3 & 6 & 9 & 12 & 15 & 18 \\\\\n4 & 8 & 12 & 16 & 20 & 24 \\\\\n5 & 10 & 15 & 20 & 25 & 30 \\\\\n\\end{tabular}") 172 | 173 | 174 | (check-equal? (table->string #:->string (λ _ "") '((1))) "┌┐\n││\n└┘") 175 | (check-equal? 176 | (table->string #:->string (list (λ (x) "a") (λ (x) "b")) '((1 2))) 177 | "┌─┬─┐\n│a│b│\n└─┴─┘") 178 | 179 | (check-equal? 180 | (table->string #:->string (list (λ (x) "a") (λ (x) "b") '... (λ (x) "c")) '((1 2 3 4))) 181 | "┌─┬─┬─┬─┐\n│a│b│b│c│\n└─┴─┴─┴─┘") 182 | 183 | (check-equal? 184 | (table->string '(("a\nb\nc" "a" "b\nc" "d"))) 185 | "┌─┬─┬─┬─┐\n│a│a│b│d│\n│b│ │c│ │\n│c│ │ │ │\n└─┴─┴─┴─┘") 186 | 187 | (check-equal? 188 | (table->string '(("a\nb\nc" "a" "b\nc" "d")) #:row-align 'bottom) 189 | "┌─┬─┬─┬─┐\n│a│ │ │ │\n│b│ │b│ │\n│c│a│c│d│\n└─┴─┴─┴─┘") 190 | 191 | (check-equal? 192 | (table->string '(("a\nb\nc" "a" "b\nc" "d")) #:row-align 'center) 193 | "┌─┬─┬─┬─┐\n│a│ │b│ │\n│b│a│c│d│\n│c│ │ │ │\n└─┴─┴─┴─┘") 194 | 195 | (check-equal? 196 | (table->string '(("a\nb\nc\nd" "a" "b\nc" "d")) #:row-align 'center) 197 | "┌─┬─┬─┬─┐\n│a│ │ │ │\n│b│a│b│d│\n│c│ │c│ │\n│d│ │ │ │\n└─┴─┴─┴─┘") 198 | 199 | 200 | (check-equal? 201 | (table->string #:row-sep? '(#t #f ...) '(("header") ("first row") ("second row"))) 202 | "┌──────────┐\n│header │\n├──────────┤\n│first row │\n│second row│\n└──────────┘") 203 | 204 | (check-equal? 205 | (table->string #:row-sep? '(#t #f ...) '(("header") ("first row"))) 206 | "┌─────────┐\n│header │\n├─────────┤\n│first row│\n└─────────┘") 207 | 208 | (check-equal? 209 | (table->string #:row-sep? '(#t) '(("header"))) 210 | "┌──────┐\n│header│\n└──────┘") 211 | 212 | (check-equal? 213 | (table->string #:row-sep? '(#t #f ...) '(("header"))) 214 | "┌──────┐\n│header│\n└──────┘") 215 | 216 | (check-equal? 217 | (table->string #:row-sep? '() '(("header"))) 218 | "┌──────┐\n│header│\n└──────┘") 219 | 220 | -------------------------------------------------------------------------------- /tests/utils.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit 4 | "../utils.rkt") 5 | 6 | (check-true ((pattern-list-of number?) '())) 7 | (check-true ((pattern-list-of number?) '1)) 8 | (check-true ((pattern-list-of number?) '(1))) 9 | (check-true ((pattern-list-of number?) '(1 2 3))) 10 | (check-true ((pattern-list-of number?) '(1 ...))) 11 | (check-true ((pattern-list-of number?) '(1 2 ...))) 12 | (check-true ((pattern-list-of number?) '(1 2 ... ...))) 13 | (check-true ((pattern-list-of number?) '(1 2 3 ... ... ... 4))) 14 | 15 | (check-false ((pattern-list-of number?) 'a)) ; not a number 16 | (check-false ((pattern-list-of number?) '(a))) ; not a number 17 | (check-false ((pattern-list-of number?) '(...))) ; too many dots 18 | (check-false ((pattern-list-of number?) '(1 2 ... ... ...))) ; too many dots 19 | (check-false ((pattern-list-of number?) '(1 2 ... ... 3 ...))) ; can't have more than 1 ...group 20 | 21 | (check-equal? (pattern-list->list 'x 3) 22 | '(x x x)) 23 | (check-equal? (pattern-list->list '(x) 3) 24 | '(x x x)) 25 | (check-equal? (pattern-list->list '(a ...) 3) 26 | '(a a a)) 27 | (check-equal? (pattern-list->list '(a b c) 5) 28 | '(a b c c c)) 29 | (check-equal? (pattern-list->list '(a b c ... ...) 10) 30 | '(a b c b c b c b c b)) 31 | (check-equal? (pattern-list->list '(a b c ... ... d e) 10) 32 | '(a b c b c b c b d e)) 33 | (check-equal? (pattern-list->list '(a b c ... ... d e) 3) 34 | '(a d e)) 35 | (check-exn exn:fail? (λ () (pattern-list->list '(a b c ... ... d e) 2))) 36 | (check-exn exn:fail? (λ () (pattern-list->list '() 2))) 37 | (check-exn exn:fail? (λ () (pattern-list->list '(a b c) 2))) 38 | (check-equal? (pattern-list->list '() 0) 39 | '()) 40 | 41 | (check-equal? (pattern-list->list '(a b c ...) 4 #:truncate-ok? #t) 42 | '(a b c c)) 43 | (check-equal? (pattern-list->list '(a b c ...) 3 #:truncate-ok? #t) 44 | '(a b c)) 45 | (check-equal? (pattern-list->list '(a b c ...) 2 #:truncate-ok? #t) 46 | '(a b)) 47 | (check-equal? (pattern-list->list '(a b c ...) 1 #:truncate-ok? #t) 48 | '(a)) 49 | (check-equal? (pattern-list->list '(a b c ...) 0 #:truncate-ok? #t) 50 | '()) 51 | (check-exn exn:fail? (λ () (pattern-list->list '(a b c ...) 0 #:truncate-ok? #f))) 52 | 53 | 54 | (check-equal? (group-by-lengths '(a b c d e f) 55 | '(1 2 3)) 56 | '((a) (b c) (d e f))) 57 | (check-equal? (group-by-lengths '(a b c d e f) 58 | '(0 0 1 0 2 3)) 59 | '(() () (a) () (b c) (d e f))) 60 | (check-exn exn:fail? (λ () (group-by-lengths '(a b c d e f) 61 | '(1 2 2)))) 62 | (check-exn exn:fail? (λ () (group-by-lengths '(a b c d e f) 63 | '(1 2 4)))) 64 | 65 | (check-equal? (apply/2d-list-as-list (λ (l) (map add1 l)) 66 | '((1) (2 3) (4 5 6) (7))) 67 | '((2) (3 4) (5 6 7) (8))) 68 | 69 | (check-equal? (string-repeat "abc" 7) 70 | "abcabca") 71 | (check-equal? (string-repeat "abc" 0) 72 | "") 73 | (check-equal? (string-repeat "abc" 2) 74 | "ab") 75 | -------------------------------------------------------------------------------- /utils.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/format 4 | racket/string 5 | racket/list 6 | racket/match 7 | version/utils) 8 | 9 | (provide (all-defined-out)) 10 | 11 | (define-syntax-rule (define/for/fold ([x a] ...) (y ...) body ...) 12 | (define-values (x ...) 13 | (for/fold ([x a] ...) (y ...) 14 | body ...))) 15 | 16 | ;==============; 17 | ;=== String ===; 18 | ;==============; 19 | 20 | (define (string-repeat str len) 21 | (cond [(= 0 len) ""] 22 | [else 23 | (define str-len (string-length str)) 24 | (when (= 0 str-len) 25 | (raise-argument-error 'repeat-string "non-empty string" str)) 26 | (define-values (q r) (quotient/remainder len str-len)) 27 | (string-append* (append (make-list q str) 28 | (list (substring str 0 r))))])) 29 | ; Differs from ~a: 30 | #;(repeat-string "abc" 5) 31 | #;"abcab" 32 | #;(~a "" #:pad-string "abc" #:min-width 5) 33 | #;"bcabc" 34 | 35 | (define (~r* #:sign [sign #f] 36 | #:base [base 10] 37 | #:precision [precision 6] 38 | #:notation [notation 'positional] 39 | #:format-exponent [format-exponent #f] 40 | #:min-width [min-width 1] 41 | #:pad-string [pad-string " "] 42 | #:groups [groups '(3)] 43 | #:group-sep [group-sep ""] 44 | #:decimal-sep [decimal-sep "."]) 45 | (if (version n-dots 0)) n-dots))] ; can't use dots anymore when #f 94 | [else #f])))) 95 | 96 | ;; l : (pattern-list-of any/c) 97 | ;; n-elts: exact-nonnegative-integer? 98 | ;; -> list? 99 | (define (pattern-list->list l n-elts #:truncate-ok? [truncate-ok? #f]) 100 | (match l 101 | ['() 102 | (unless (= n-elts 0) 103 | (error "List is empty but n-elts > 0" l n-elts)) 104 | '()] 105 | [(list front1 (and front (not '...)) ... '... (and '... dots) ... tail ...) 106 | (define n-dots (+ (length dots) 1)) 107 | (define-values (head rep) (split-at-right (cons front1 front) n-dots)) 108 | (define-values (n-rep rem) (quotient/remainder (- n-elts (length head) (length tail)) 109 | n-dots)) 110 | (cond [(and (>= n-rep 0) (>= rem 0)) 111 | (append head (append* (make-list n-rep rep)) (take rep rem) tail)] 112 | [truncate-ok? 113 | (take (append head tail) n-elts)] 114 | [else 115 | (error "Minimum length of list l exceeds n-elt" l n-elts)])] 116 | [(? list?) 117 | ; Repeat the last element. 118 | (pattern-list->list (append l (list (last l) '...)) n-elts #:truncate-ok? truncate-ok?)] 119 | [else (make-list n-elts l)])) 120 | 121 | (define (group-by-lengths l lens) 122 | (unless (= (apply + lens) (length l)) 123 | (error "List length and sum lengths don't match" (length l) (apply + lens))) 124 | (let loop ([l l] [lens lens] [res '()]) 125 | (cond [(and (empty? l) (empty? lens)) 126 | (reverse res)] 127 | [else 128 | (define-values (subl new-l) (split-at l (first lens))) 129 | (loop new-l (rest lens) (cons subl res))]))) 130 | 131 | ;; proc : (listof T) . any -> (listof U) 132 | ;; (proc col args) must return a list of the same length as col. 133 | ;; Applies proc on the flattened ll, but re-structures the result 134 | ;; to have the same 2d shape of l. 135 | ;; Useful to align a column where cells are lists of strings 136 | ;; as a flat list of strings. 137 | (define (apply/2d-list-as-list proc ll . args) 138 | ; Flatten, but keep info about cell lengths. 139 | (define lens (map length ll)) 140 | (define flat-l (append* ll)) 141 | (define flat-res (apply proc flat-l args)) 142 | ; Unflatten. 143 | (group-by-lengths flat-res lens)) 144 | --------------------------------------------------------------------------------