1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
-----------------------------------------------------------------------------
--
-- Module : Text.Html.BlockTable
-- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of
-- Science and Technology, 1999-2001
-- License : BSD-style (see the file libraries/core/LICENSE)
--
-- Maintainer : Andy Gill <andy@galconn.com>
-- Stability : experimental
-- Portability : portable
--
-- $Id: BlockTable.hs,v 1.2 2002/07/24 09:42:18 simonmar Exp $
--
-- An Html combinator library
--
-----------------------------------------------------------------------------
module Haddock.Utils.BlockTable (
-- Datatypes:
BlockTable, -- abstract
-- Contruction Functions:
single,
empty,
above,
beside,
-- Investigation Functions:
getMatrix,
showsTable,
showTable,
) where
import Prelude
infixr 4 `beside`
infixr 3 `above`
-- These combinators can be used to build formated 2D tables.
-- The specific target useage is for HTML table generation.
{-
Examples of use:
> table1 :: BlockTable String
> table1 = single "Hello" +-----+
|Hello|
This is a 1x1 cell +-----+
Note: single has type
single :: a -> BlockTable a
So the cells can contain anything.
> table2 :: BlockTable String
> table2 = single "World" +-----+
|World|
+-----+
> table3 :: BlockTable String
> table3 = table1 %-% table2 +-----%-----+
|Hello%World|
% is used to indicate +-----%-----+
the join edge between
the two Tables.
> table4 :: BlockTable String
> table4 = table3 %/% table2 +-----+-----+
|Hello|World|
Notice the padding on the %%%%%%%%%%%%%
smaller (bottom) cell to |World |
force the table to be a +-----------+
rectangle.
> table5 :: BlockTable String
> table5 = table1 %-% table4 +-----%-----+-----+
|Hello%Hello|World|
Notice the padding on the | %-----+-----+
leftmost cell, again to | %World |
force the table to be a +-----%-----------+
rectangle.
Now the table can be rendered with processTable, for example:
Main> processTable table5
[[("Hello",(1,2)),
("Hello",(1,1)),
("World",(1,1))],
[("World",(2,1))]] :: [[([Char],(Int,Int))]]
Main>
-}
-- ---------------------------------------------------------------------------
-- Contruction Functions
-- Perhaps one day I'll write the Show instance
-- to show boxes aka the above ascii renditions.
instance (Show a) => Show (BlockTable a) where
showsPrec _ = showsTable
type TableI a = [[(a,(Int,Int))]] -> [[(a,(Int,Int))]]
data BlockTable a = Table (Int -> Int -> TableI a) Int Int
-- You can create a (1x1) table entry
single :: a -> BlockTable a
single a = Table (\ x y r -> [(a,(x+1,y+1))] : r) 1 1
empty :: BlockTable a
empty = Table (\ _ _ r -> r) 0 0
-- You can compose tables, horizonally and vertically
above :: BlockTable a -> BlockTable a -> BlockTable a
beside :: BlockTable a -> BlockTable a -> BlockTable a
t1 `above` t2 = trans (combine (trans t1) (trans t2) (.))
t1 `beside` t2 = combine t1 t2 (\ lst1 lst2 r ->
let
-- Note this depends on the fact that
-- that the result has the same number
-- of lines as the y dimention; one list
-- per line. This is not true in general
-- but is always true for these combinators.
-- I should assert this!
-- I should even prove this.
beside' (x:xs) (y:ys) = (x ++ y) : beside' xs ys
beside' (x:xs) [] = x : xs ++ r
beside' [] (y:ys) = y : ys ++ r
beside' [] [] = r
in
beside' (lst1 []) (lst2 []))
-- trans flips (transposes) over the x and y axis of
-- the table. It is only used internally, and typically
-- in pairs, ie. (flip ... munge ... (un)flip).
trans :: BlockTable a -> BlockTable a
trans (Table f1 x1 y1) = Table (flip f1) y1 x1
combine :: BlockTable a
-> BlockTable b
-> (TableI a -> TableI b -> TableI c)
-> BlockTable c
combine (Table f1 x1 y1) (Table f2 x2 y2) comb = Table new_fn (x1+x2) max_y
where
max_y = max y1 y2
new_fn x y =
case compare y1 y2 of
EQ -> comb (f1 0 y) (f2 x y)
GT -> comb (f1 0 y) (f2 x (y + y1 - y2))
LT -> comb (f1 0 (y + y2 - y1)) (f2 x y)
-- ---------------------------------------------------------------------------
-- Investigation Functions
-- This is the other thing you can do with a Table;
-- turn it into a 2D list, tagged with the (x,y)
-- sizes of each cell in the table.
getMatrix :: BlockTable a -> [[(a,(Int,Int))]]
getMatrix (Table r _ _) = r 0 0 []
-- You can also look at a table
showsTable :: (Show a) => BlockTable a -> ShowS
showsTable table = shows (getMatrix table)
showTable :: (Show a) => BlockTable a -> String
showTable table = showsTable table ""
|
