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