Text/Html/BlockTable.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Text.Html.BlockTable
   4 -- Copyright   :  (c) Andy Gill, and the Oregon Graduate Institute of
   5 --                Science and Technology, 1999-2001
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  Andy Gill <andy@galconn.com>
   9 -- Stability   :  experimental
  10 -- Portability :  portable
  11 --
  12 -- An Html combinator library
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 module Text.Html.BlockTable (
  17
  18 -- Datatypes:
  19
  20       BlockTable,             -- abstract
  21
  22 -- Contruction Functions:
  23
  24       single,
  25       above,
  26       beside,
  27
  28 -- Investigation Functions:
  29
  30       getMatrix,
  31       showsTable,
  32       showTable,
  33
  34       ) where
  35
  36 import Prelude
  37
  38 infixr 4 `beside`
  39 infixr 3 `above`
  40
  41 -- These combinators can be used to build formated 2D tables.
  42 -- The specific target useage is for HTML table generation.
  43
  44 {-
  45    Examples of use:
  46
  47         > table1 :: BlockTable String
  48         > table1 = single "Hello"       +-----+
  49                                         |Hello|
  50           This is a 1x1 cell            +-----+
  51           Note: single has type
  52
  53                 single :: a -> BlockTable a
  54
  55           So the cells can contain anything.
  56
  57         > table2 :: BlockTable String
  58         > table2 = single "World"       +-----+
  59                                         |World|
  60                                         +-----+
  61
  62
  63         > table3 :: BlockTable String
  64         > table3 = table1 %-% table2    +-----%-----+
  65                                         |Hello%World|
  66          % is used to indicate          +-----%-----+
  67          the join edge between
  68          the two Tables.
  69
  70         > table4 :: BlockTable String
  71         > table4 = table3 %/% table2    +-----+-----+
  72                                         |Hello|World|
  73           Notice the padding on the     %%%%%%%%%%%%%
  74           smaller (bottom) cell to      |World      |
  75           force the table to be a       +-----------+
  76           rectangle.
  77
  78         > table5 :: BlockTable String
  79         > table5 = table1 %-% table4    +-----%-----+-----+
  80                                         |Hello%Hello|World|
  81           Notice the padding on the     |     %-----+-----+
  82           leftmost cell, again to       |     %World      |
  83           force the table to be a       +-----%-----------+
  84           rectangle.
  85
  86    Now the table can be rendered with processTable, for example:
  87         Main> processTable table5
  88         [[("Hello",(1,2)),
  89           ("Hello",(1,1)),
  90           ("World",(1,1))],
  91          [("World",(2,1))]] :: [[([Char],(Int,Int))]]
  92         Main>
  93 -}
  94
  95 -- ---------------------------------------------------------------------------
  96 -- Contruction Functions
  97
  98 -- Perhaps one day I'll write the Show instance
  99 -- to show boxes aka the above ascii renditions.
 100
 101 instance (Show a) => Show (BlockTable a) where
 102       showsPrec p = showsTable
 103
 104 type TableI a = [[(a,(Int,Int))]] -> [[(a,(Int,Int))]]
 105
 106 data BlockTable a = Table (Int -> Int -> TableI a) Int Int
 107
 108
 109 -- You can create a (1x1) table entry
 110
 111 single :: a -> BlockTable a
 112 single a = Table (\ x y z -> [(a,(x+1,y+1))] : z) 1 1
 113
 114
 115 -- You can compose tables, horizonally and vertically
 116
 117 above  :: BlockTable a -> BlockTable a -> BlockTable a
 118 beside :: BlockTable a -> BlockTable a -> BlockTable a
 119
 120 t1 `above` t2 = trans (combine (trans t1) (trans t2) (.))
 121
 122 t1 `beside` t2 = combine t1 t2 (\ lst1 lst2 r ->
 123     let
 124       -- Note this depends on the fact that
 125       -- that the result has the same number
 126       -- of lines as the y dimention; one list
 127       -- per line. This is not true in general
 128       -- but is always true for these combinators.
 129       -- I should assert this!
 130       -- I should even prove this.
 131       beside (x:xs) (y:ys) = (x ++ y) : beside xs ys
 132       beside (x:xs) []     = x        : xs ++ r
 133       beside []     (y:ys) = y        : ys ++ r
 134       beside []     []     =                  r
 135     in
 136       beside (lst1 []) (lst2 []))
 137
 138 -- trans flips (transposes) over the x and y axis of
 139 -- the table. It is only used internally, and typically
 140 -- in pairs, ie. (flip ... munge ... (un)flip).
 141
 142 trans :: BlockTable a -> BlockTable a
 143 trans (Table f1 x1 y1) = Table (flip f1) y1 x1
 144
 145 combine :: BlockTable a
 146       -> BlockTable b
 147       -> (TableI a -> TableI b -> TableI c)
 148       -> BlockTable c
 149 combine (Table f1 x1 y1) (Table f2 x2 y2) comb = Table new_fn (x1+x2) max_y
 150     where
 151       max_y = max y1 y2
 152       new_fn x y =
 153          case compare y1 y2 of
 154           EQ -> comb (f1 0 y)             (f2 x y)
 155           GT -> comb (f1 0 y)             (f2 x (y + y1 - y2))
 156           LT -> comb (f1 0 (y + y2 - y1)) (f2 x y)
 157
 158 -- ---------------------------------------------------------------------------
 159 -- Investigation Functions
 160
 161 -- This is the other thing you can do with a Table;
 162 -- turn it into a 2D list, tagged with the (x,y)
 163 -- sizes of each cell in the table.
 164
 165 getMatrix :: BlockTable a -> [[(a,(Int,Int))]]
 166 getMatrix (Table r _ _) = r 0 0 []
 167
 168 -- You can also look at a table
 169
 170 showsTable :: (Show a) => BlockTable a -> ShowS
 171 showsTable table = shows (getMatrix table)
 172
 173 showTable :: (Show a) => BlockTable a -> String
 174 showTable table = showsTable table ""