-----------------------------------------------------------------------------
-- |
-- 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 :: Int -> BlockTable a -> ShowS
showsPrec Int
_ = forall a. Show a => BlockTable a -> ShowS
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 :: forall a. a -> BlockTable a
single a
a = forall a. (Int -> Int -> TableI a) -> Int -> Int -> BlockTable a
Table (\ Int
x Int
y [[(a, (Int, Int))]]
z -> [(a
a,(Int
xforall a. Num a => a -> a -> a
+Int
1,Int
yforall a. Num a => a -> a -> a
+Int
1))] forall a. a -> [a] -> [a]
: [[(a, (Int, Int))]]
z) Int
1 Int
1


-- | Composes tables vertically.
above  :: BlockTable a -> BlockTable a -> BlockTable a

-- | Composes tables horizontally.
beside :: BlockTable a -> BlockTable a -> BlockTable a

BlockTable a
t1 above :: forall a. BlockTable a -> BlockTable a -> BlockTable a
`above` BlockTable a
t2 = forall a. BlockTable a -> BlockTable a
trans (forall a b c.
BlockTable a
-> BlockTable b
-> (TableI a -> TableI b -> TableI c)
-> BlockTable c
combine (forall a. BlockTable a -> BlockTable a
trans BlockTable a
t1) (forall a. BlockTable a -> BlockTable a
trans BlockTable a
t2) forall b c a. (b -> c) -> (a -> b) -> a -> c
(.))

BlockTable a
t1 beside :: forall a. BlockTable a -> BlockTable a -> BlockTable a
`beside` BlockTable a
t2 = forall a b c.
BlockTable a
-> BlockTable b
-> (TableI a -> TableI b -> TableI c)
-> BlockTable c
combine BlockTable a
t1 BlockTable a
t2 (\ TableI a
lst1 TableI a
lst2 [[(a, (Int, Int))]]
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' :: [[(a, (Int, Int))]] -> TableI a
beside' ([(a, (Int, Int))]
x:[[(a, (Int, Int))]]
xs) ([(a, (Int, Int))]
y:[[(a, (Int, Int))]]
ys) = ([(a, (Int, Int))]
x forall a. [a] -> [a] -> [a]
++ [(a, (Int, Int))]
y) forall a. a -> [a] -> [a]
: [[(a, (Int, Int))]] -> TableI a
beside' [[(a, (Int, Int))]]
xs [[(a, (Int, Int))]]
ys
      beside' ([(a, (Int, Int))]
x:[[(a, (Int, Int))]]
xs) []     = [(a, (Int, Int))]
x        forall a. a -> [a] -> [a]
: [[(a, (Int, Int))]]
xs forall a. [a] -> [a] -> [a]
++ [[(a, (Int, Int))]]
r
      beside' []     ([(a, (Int, Int))]
y:[[(a, (Int, Int))]]
ys) = [(a, (Int, Int))]
y        forall a. a -> [a] -> [a]
: [[(a, (Int, Int))]]
ys forall a. [a] -> [a] -> [a]
++ [[(a, (Int, Int))]]
r
      beside' []     []     =                  [[(a, (Int, Int))]]
r
    in
      [[(a, (Int, Int))]] -> TableI a
beside' (TableI a
lst1 []) (TableI a
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 :: forall a. BlockTable a -> BlockTable a
trans (Table Int -> Int -> TableI a
f1 Int
x1 Int
y1) = forall a. (Int -> Int -> TableI a) -> Int -> Int -> BlockTable a
Table (forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> TableI a
f1) Int
y1 Int
x1

combine :: BlockTable a 
      -> BlockTable b 
      -> (TableI a -> TableI b -> TableI c) 
      -> BlockTable c
combine :: forall a b c.
BlockTable a
-> BlockTable b
-> (TableI a -> TableI b -> TableI c)
-> BlockTable c
combine (Table Int -> Int -> TableI a
f1 Int
x1 Int
y1) (Table Int -> Int -> TableI b
f2 Int
x2 Int
y2) TableI a -> TableI b -> TableI c
comb = forall a. (Int -> Int -> TableI a) -> Int -> Int -> BlockTable a
Table Int -> Int -> TableI c
new_fn (Int
x1forall a. Num a => a -> a -> a
+Int
x2) Int
max_y
    where
      max_y :: Int
max_y = forall a. Ord a => a -> a -> a
max Int
y1 Int
y2
      new_fn :: Int -> Int -> TableI c
new_fn Int
x Int
y =
         case forall a. Ord a => a -> a -> Ordering
compare Int
y1 Int
y2 of
          Ordering
EQ -> TableI a -> TableI b -> TableI c
comb (Int -> Int -> TableI a
f1 Int
0 Int
y)             (Int -> Int -> TableI b
f2 Int
x Int
y)
          Ordering
GT -> TableI a -> TableI b -> TableI c
comb (Int -> Int -> TableI a
f1 Int
0 Int
y)             (Int -> Int -> TableI b
f2 Int
x (Int
y forall a. Num a => a -> a -> a
+ Int
y1 forall a. Num a => a -> a -> a
- Int
y2))
          Ordering
LT -> TableI a -> TableI b -> TableI c
comb (Int -> Int -> TableI a
f1 Int
0 (Int
y forall a. Num a => a -> a -> a
+ Int
y2 forall a. Num a => a -> a -> a
- Int
y1)) (Int -> Int -> TableI b
f2 Int
x Int
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 :: forall a. BlockTable a -> [[(a, (Int, Int))]]
getMatrix (Table Int -> Int -> TableI a
r Int
_ Int
_) = Int -> Int -> TableI a
r Int
0 Int
0 []

-- You can also look at a table

showsTable :: (Show a) => BlockTable a -> ShowS
showsTable :: forall a. Show a => BlockTable a -> ShowS
showsTable BlockTable a
table = forall a. Show a => a -> ShowS
shows (forall a. BlockTable a -> [[(a, (Int, Int))]]
getMatrix BlockTable a
table)

showTable :: (Show a) => BlockTable a -> String
showTable :: forall a. Show a => BlockTable a -> String
showTable BlockTable a
table = forall a. Show a => BlockTable a -> ShowS
showsTable BlockTable a
table String
""