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