#if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Safe #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Text.XHtml.BlockTable -- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of -- Science and Technology, 1999-2001 -- License : BSD-style (see the file LICENSE) -- Maintainer : Chris Dornan <chris@chrisdornan.com> -- Stability : Stable -- Portability : Portable -- -- An XHTML combinator library -- -- These combinators can be used to build formated 2D tables. -- The specific target usage 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> -} module Text.XHtml.BlockTable ( -- * Datatypes BlockTable, -- * Contruction Functions single, above, beside, -- * Investigation Functions getMatrix, showsTable, showTable, ) where infixr 4 `beside` infixr 3 `above` -- -- * Construction 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 -- | Creates a (1x1) table entry single :: a -> BlockTable a single a = Table (\ x y z -> [(a,(x+1,y+1))] : z) 1 1 -- | Composes tables vertically. above :: BlockTable a -> BlockTable a -> BlockTable a -- | Composes tables horizontally. 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 ""