De-flatten the namespace

1 files changed, 180 insertions, 0 deletions

diff --git a/src/Haddock/Utils/BlockTable.hs b/src/Haddock/Utils/BlockTable.hs
new file mode 100644
index 00000000..ed51654e
--- /dev/null
+++ b/src/Haddock/Utils/BlockTable.hs
@@ -0,0 +1,180 @@
+-----------------------------------------------------------------------------
+-- 
+-- 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 ""