    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Text.Html.BlockTable
    -- Copyright   :  (c) Andy Gill and OGI, 1999-2001
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  Andy Gill <andy@galconn.com>
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- An Html combinator library
    --
    -----------------------------------------------------------------------------

    module Text.Html.BlockTable (

    -- Datatypes:

          BlockTable,             -- abstract

    -- Contruction Functions:

          single,
          empty,
          above,
          beside,

    -- Investigation Functions:

          getMatrix,
          showsTable,
          showTable,

          ) where

    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 :: Int -> BlockTable a -> ShowS
    showsPrec Int
    _ = BlockTable a -> ShowS
    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

    -- You can create a (1x1) table entry

    single :: a -> BlockTable a
    single :: forall a. a -> BlockTable a
    single a
    a = (Int -> Int -> TableI a) -> Int -> Int -> BlockTable a
    forall a. (Int -> Int -> TableI a) -> Int -> Int -> BlockTable a
    Table (\ Int
    x Int
    y [[(a, (Int, Int))]]
    r -> [(a
    a,(Int
    xInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1,Int
    yInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1))] [(a, (Int, Int))] -> TableI a
    forall a. a -> [a] -> [a]
    : [[(a, (Int, Int))]]
    r) Int
    1 Int
    1

    empty :: BlockTable a
    empty :: forall a. BlockTable a
    empty = (Int -> Int -> TableI a) -> Int -> Int -> BlockTable a
    forall a. (Int -> Int -> TableI a) -> Int -> Int -> BlockTable a
    Table (\ Int
    _ Int
    _ [[(a, (Int, Int))]]
    r -> [[(a, (Int, Int))]]
    r) Int
    0 Int
    0

    -- You can compose tables, horizonally and vertically

    above  :: BlockTable a -> BlockTable a -> BlockTable a
    beside :: BlockTable a -> BlockTable a -> BlockTable a

    BlockTable a
    t1 above :: forall a. BlockTable a -> BlockTable a -> BlockTable a
    `above` BlockTable a
    t2 = BlockTable a -> BlockTable a
    forall a. BlockTable a -> BlockTable a
    trans (BlockTable a
    -> BlockTable a
    -> (TableI a -> TableI a -> TableI a)
    -> BlockTable a
    forall a b c.
    BlockTable a
    -> BlockTable b
    -> (TableI a -> TableI b -> TableI c)
    -> BlockTable c
    combine (BlockTable a -> BlockTable a
    forall a. BlockTable a -> BlockTable a
    trans BlockTable a
    t1) (BlockTable a -> BlockTable a
    forall a. BlockTable a -> BlockTable a
    trans BlockTable a
    t2) TableI a -> TableI a -> TableI a
    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 = BlockTable a
    -> BlockTable a
    -> (TableI a -> TableI a -> TableI a)
    -> BlockTable a
    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 [(a, (Int, Int))] -> [(a, (Int, Int))] -> [(a, (Int, Int))]
    forall a. [a] -> [a] -> [a]
    ++ [(a, (Int, Int))]
    y) [(a, (Int, Int))] -> TableI a
    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        [(a, (Int, Int))] -> TableI a
    forall a. a -> [a] -> [a]
    : [[(a, (Int, Int))]]
    xs [[(a, (Int, Int))]] -> TableI a
    forall a. [a] -> [a] -> [a]
    ++ [[(a, (Int, Int))]]
    r
          beside' []     ([(a, (Int, Int))]
    y:[[(a, (Int, Int))]]
    ys) = [(a, (Int, Int))]
    y        [(a, (Int, Int))] -> TableI a
    forall a. a -> [a] -> [a]
    : [[(a, (Int, Int))]]
    ys [[(a, (Int, Int))]] -> TableI a
    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) = (Int -> Int -> TableI a) -> Int -> Int -> BlockTable a
    forall a. (Int -> Int -> TableI a) -> Int -> Int -> BlockTable a
    Table ((Int -> Int -> TableI a) -> Int -> Int -> TableI a
    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 = (Int -> Int -> TableI c) -> Int -> Int -> BlockTable c
    forall a. (Int -> Int -> TableI a) -> Int -> Int -> BlockTable a
    Table Int -> Int -> TableI c
    new_fn (Int
    x1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    x2) Int
    max_y
        where
          max_y :: Int
    max_y = Int -> Int -> Int
    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 Int -> Int -> Ordering
    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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y1 Int -> Int -> Int
    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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y2 Int -> Int -> Int
    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 = [[(a, (Int, Int))]] -> ShowS
    forall a. Show a => a -> ShowS
    shows (BlockTable a -> [[(a, (Int, Int))]]
    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 = BlockTable a -> ShowS
    forall a. Show a => BlockTable a -> ShowS
    showsTable BlockTable a
    table String
    ""