Text/Html/BlockTable.hs

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