{- |
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 ""