Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * | |
4 | * MLton is released under a BSD-style license. | |
5 | * See the file MLton-LICENSE for details. | |
6 | *) | |
7 | ||
8 | structure Justify: JUSTIFY = | |
9 | struct | |
10 | ||
11 | structure C = Char | |
12 | structure S = String | |
13 | ||
14 | datatype t = | |
15 | Left | |
16 | | Center | |
17 | | Right | |
18 | ||
19 | val toString = | |
20 | fn Left => "Left" | |
21 | | Center => "Center" | |
22 | | Right => "Right" | |
23 | ||
24 | val layout = Layout.str o toString | |
25 | ||
26 | fun spaces n = S.make (n, C.space) | |
27 | ||
28 | fun justify (s, width, just) = | |
29 | let val numchars = S.size s | |
30 | val numspaces = width - numchars | |
31 | in S.concat | |
32 | (case just of | |
33 | Left => [s, spaces numspaces] | |
34 | | Center => let val numLeft = numspaces div 2 | |
35 | val numRight = numspaces - numLeft | |
36 | in [spaces numLeft, s, spaces numRight] | |
37 | end | |
38 | | Right => [spaces numspaces, s]) | |
39 | end | |
40 | ||
41 | fun table {columnHeads: string list option, | |
42 | justs: t list, | |
43 | rows: string list list} = | |
44 | let | |
45 | val headsAndRows = | |
46 | case columnHeads of | |
47 | NONE => rows | |
48 | | SOME h => h :: rows | |
49 | val maxs = | |
50 | List.fold (headsAndRows, | |
51 | List.revMap (justs, fn _ => 0), | |
52 | fn (row, ms) => | |
53 | List.map2 (row, ms, fn (s, m) => Int.max (m, String.size s))) | |
54 | val rows = | |
55 | List.map (rows, fn row => List.map3 (row, maxs, justs, justify)) | |
56 | val rows = | |
57 | case columnHeads of | |
58 | NONE => rows | |
59 | | SOME heads => | |
60 | let | |
61 | val heads = List.map2 (heads, maxs, fn (s, i) => | |
62 | justify (s, i, Center)) | |
63 | val dashes = List.map (maxs, fn i => String.make (i, #"-")) | |
64 | in | |
65 | heads :: dashes :: rows | |
66 | end | |
67 | in | |
68 | rows | |
69 | end | |
70 | ||
71 | val table = | |
72 | Trace.trace ("Justify.table", | |
73 | fn {columnHeads, justs, rows} => | |
74 | Layout.record [("columnHeads", | |
75 | Option.layout (List.layout String.layout) | |
76 | columnHeads), | |
77 | ("justs", List.layout layout justs), | |
78 | ("rows", | |
79 | List.layout (List.layout String.layout) rows)], | |
80 | List.layout (List.layout String.layout)) | |
81 | table | |
82 | ||
83 | fun tableOfColumns (columns: (t * string list) list) = | |
84 | let | |
85 | val justs = List.map (columns, #1) | |
86 | val columns = List.map (columns, #2) | |
87 | fun loop (columns: string list list, ac: string list list) = | |
88 | if List.isEmpty (hd columns) | |
89 | then rev ac | |
90 | else loop (List.map (columns, tl), List.map (columns, hd) :: ac) | |
91 | val rows = loop (columns, []) | |
92 | in | |
93 | table {columnHeads = NONE, | |
94 | justs = justs, | |
95 | rows = rows} | |
96 | end | |
97 | ||
98 | fun outputTable (t, out) = | |
99 | let | |
100 | val print = Out.outputc out | |
101 | in | |
102 | List.foreach (t, fn ss => | |
103 | (case ss of | |
104 | [] => () | |
105 | | s :: ss => | |
106 | (print s | |
107 | ; List.foreach (ss, fn s => (print " "; print s))) | |
108 | ; print "\n")) | |
109 | end | |
110 | ||
111 | end |