    -- | Table combinators for XHTML.
    module Text.XHtml.Table (HtmlTable, HTMLTABLE(..),
                            (</>), above, (<->), beside,
                             aboves, besides,
                             simpleTable) where

    import Text.XHtml.Internals
    import Text.XHtml.Strict.Elements
    import Text.XHtml.Strict.Attributes

    import qualified Text.XHtml.BlockTable as BT

    infixr 3 </>  -- combining table cells
    infixr 4 <->  -- combining table cells

    --
    -- * Tables
    --

    class HTMLTABLE ht where
          cell :: ht -> HtmlTable

    instance HTMLTABLE HtmlTable where
          cell :: HtmlTable -> HtmlTable
    cell = HtmlTable -> HtmlTable
    forall a. a -> a
    id

    instance HTMLTABLE Html where
          cell :: Html -> HtmlTable
    cell Html
    h =
             let
                  cellFn :: Int -> Int -> Html
    cellFn Int
    x Int
    y = Html
    h Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! (Int -> (Int -> HtmlAttr) -> [HtmlAttr] -> [HtmlAttr]
    forall {t} {a}. (Eq t, Num t) => t -> (t -> a) -> [a] -> [a]
    add Int
    x Int -> HtmlAttr
    colspan ([HtmlAttr] -> [HtmlAttr]) -> [HtmlAttr] -> [HtmlAttr]
    forall a b. (a -> b) -> a -> b
    $ Int -> (Int -> HtmlAttr) -> [HtmlAttr] -> [HtmlAttr]
    forall {t} {a}. (Eq t, Num t) => t -> (t -> a) -> [a] -> [a]
    add Int
    y Int -> HtmlAttr
    rowspan ([HtmlAttr] -> [HtmlAttr]) -> [HtmlAttr] -> [HtmlAttr]
    forall a b. (a -> b) -> a -> b
    $ [])
                  add :: t -> (t -> a) -> [a] -> [a]
    add t
    1 t -> a
    _  [a]
    rest = [a]
    rest
                  add t
    n t -> a
    fn [a]
    rest = t -> a
    fn t
    n a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    rest
                  r :: BlockTable (Int -> Int -> Html)
    r = (Int -> Int -> Html) -> BlockTable (Int -> Int -> Html)
    forall a. a -> BlockTable a
    BT.single Int -> Int -> Html
    cellFn
             in
                  BlockTable (Int -> Int -> Html) -> HtmlTable
    mkHtmlTable BlockTable (Int -> Int -> Html)
    r

    -- | We internally represent the Cell inside a Table with an
    -- object of the type
    --
    -- >	   Int -> Int -> Html
    --
    -- When we render it later, we find out how many columns
    -- or rows this cell will span over, and can
    -- include the correct colspan\/rowspan command.
    newtype HtmlTable
          = HtmlTable (BT.BlockTable (Int -> Int -> Html))

    mkHtmlTable :: BT.BlockTable (Int -> Int -> Html) -> HtmlTable
    mkHtmlTable :: BlockTable (Int -> Int -> Html) -> HtmlTable
    mkHtmlTable BlockTable (Int -> Int -> Html)
    r = BlockTable (Int -> Int -> Html) -> HtmlTable
    HtmlTable BlockTable (Int -> Int -> Html)
    r

    -- We give both infix and nonfix, take your pick.
    -- Notice that there is no concept of a row/column
    -- of zero items.

    (</>),above,(<->),beside :: (HTMLTABLE ht1,HTMLTABLE ht2)
                           => ht1 -> ht2 -> HtmlTable
    above :: forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    above   ht1
    a ht2
    b = (BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html))
    -> HtmlTable -> HtmlTable -> HtmlTable
    combine BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    forall a. BlockTable a -> BlockTable a -> BlockTable a
    BT.above (ht1 -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell ht1
    a) (ht2 -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell ht2
    b)
    </> :: forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    (</>)         = ht1 -> ht2 -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    above
    beside :: forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    beside  ht1
    a ht2
    b = (BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html))
    -> HtmlTable -> HtmlTable -> HtmlTable
    combine BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    forall a. BlockTable a -> BlockTable a -> BlockTable a
    BT.beside (ht1 -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell ht1
    a) (ht2 -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell ht2
    b)
    <-> :: forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    (<->) = ht1 -> ht2 -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    beside

    combine :: (BT.BlockTable (Int -> Int -> Html) ->
                BT.BlockTable (Int -> Int -> Html) ->
                BT.BlockTable (Int -> Int -> Html))
            -> HtmlTable
            -> HtmlTable
            -> HtmlTable
    combine :: (BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html)
     -> BlockTable (Int -> Int -> Html))
    -> HtmlTable -> HtmlTable -> HtmlTable
    combine BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    fn (HtmlTable BlockTable (Int -> Int -> Html)
    a) (HtmlTable BlockTable (Int -> Int -> Html)
    b) = BlockTable (Int -> Int -> Html) -> HtmlTable
    mkHtmlTable (BlockTable (Int -> Int -> Html)
    a BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    -> BlockTable (Int -> Int -> Html)
    `fn` BlockTable (Int -> Int -> Html)
    b)

    -- Both aboves and besides presume a non-empty list.
    -- here is no concept of a empty row or column in these
    -- table combinators.

    aboves :: (HTMLTABLE ht) => [ht] -> HtmlTable
    aboves :: forall ht. HTMLTABLE ht => [ht] -> HtmlTable
    aboves []  = [Char] -> HtmlTable
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "aboves []"
    aboves [ht]
    xs  = (HtmlTable -> HtmlTable -> HtmlTable) -> [HtmlTable] -> HtmlTable
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 HtmlTable -> HtmlTable -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    (</>) ((ht -> HtmlTable) -> [ht] -> [HtmlTable]
    forall a b. (a -> b) -> [a] -> [b]
    map ht -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell [ht]
    xs)

    besides :: (HTMLTABLE ht) => [ht] -> HtmlTable
    besides :: forall ht. HTMLTABLE ht => [ht] -> HtmlTable
    besides [] = [Char] -> HtmlTable
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "besides []"
    besides [ht]
    xs = (HtmlTable -> HtmlTable -> HtmlTable) -> [HtmlTable] -> HtmlTable
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 HtmlTable -> HtmlTable -> HtmlTable
    forall ht1 ht2.
    (HTMLTABLE ht1, HTMLTABLE ht2) =>
    ht1 -> ht2 -> HtmlTable
    (<->) ((ht -> HtmlTable) -> [ht] -> [HtmlTable]
    forall a b. (a -> b) -> [a] -> [b]
    map ht -> HtmlTable
    forall ht. HTMLTABLE ht => ht -> HtmlTable
    cell [ht]
    xs)

    -- | renderTable takes the HtmlTable, and renders it back into
    --   and Html object.
    renderTable :: BT.BlockTable (Int -> Int -> Html) -> Html
    renderTable :: BlockTable (Int -> Int -> Html) -> Html
    renderTable BlockTable (Int -> Int -> Html)
    theTable
          = [Html] -> Html
    forall a. HTML a => [a] -> Html
    concatHtml
              [Html -> Html
    tr (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [Int -> Int -> Html
    theCell Int
    x Int
    y | (Int -> Int -> Html
    theCell,(Int
    x,Int
    y)) <- [(Int -> Int -> Html, (Int, Int))]
    theRow ]
                          | [(Int -> Int -> Html, (Int, Int))]
    theRow <- BlockTable (Int -> Int -> Html)
    -> [[(Int -> Int -> Html, (Int, Int))]]
    forall a. BlockTable a -> [[(a, (Int, Int))]]
    BT.getMatrix BlockTable (Int -> Int -> Html)
    theTable]

    instance HTML HtmlTable where
          toHtml :: HtmlTable -> Html
    toHtml (HtmlTable BlockTable (Int -> Int -> Html)
    tab) = BlockTable (Int -> Int -> Html) -> Html
    renderTable BlockTable (Int -> Int -> Html)
    tab

    instance Show HtmlTable where
          showsPrec :: Int -> HtmlTable -> ShowS
    showsPrec Int
    _ (HtmlTable BlockTable (Int -> Int -> Html)
    tab) = Html -> ShowS
    forall a. Show a => a -> ShowS
    shows (BlockTable (Int -> Int -> Html) -> Html
    renderTable BlockTable (Int -> Int -> Html)
    tab)

    -- | If you can't be bothered with the above, then you
    -- can build simple tables with simpleTable.
    -- Just provide the attributes for the whole table,
    -- attributes for the cells (same for every cell),
    -- and a list of lists of cell contents,
    -- and this function will build the table for you.
    -- It does presume that all the lists are non-empty,
    -- and there is at least one list.
    --
    -- Different length lists means that the last cell
    -- gets padded. If you want more power, then
    -- use the system above, or build tables explicitly.
    simpleTable :: [HtmlAttr] -> [HtmlAttr] -> [[Html]] -> Html
    simpleTable :: [HtmlAttr] -> [HtmlAttr] -> [[Html]] -> Html
    simpleTable [HtmlAttr]
    attr [HtmlAttr]
    cellAttr [[Html]]
    lst
          = Html -> Html
    table (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [HtmlAttr]
    attr
              (Html -> Html) -> HtmlTable -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<  ([HtmlTable] -> HtmlTable
    forall ht. HTMLTABLE ht => [ht] -> HtmlTable
    aboves
                  ([HtmlTable] -> HtmlTable)
    -> ([[Html]] -> [HtmlTable]) -> [[Html]] -> HtmlTable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Html] -> HtmlTable) -> [[Html]] -> [HtmlTable]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Html] -> HtmlTable
    forall ht. HTMLTABLE ht => [ht] -> HtmlTable
    besides ([Html] -> HtmlTable) -> ([Html] -> [Html]) -> [Html] -> HtmlTable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Html -> Html) -> [Html] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Html -> Html
    td (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [HtmlAttr]
    cellAttr) (Html -> Html) -> (Html -> Html) -> Html -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Html -> Html
    forall a. HTML a => a -> Html
    toHtml))
                  ) [[Html]]
    lst