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 </>
infixr 4 <->
class HTMLTABLE ht where
cell :: ht -> HtmlTable
instance HTMLTABLE HtmlTable where
cell :: HtmlTable -> HtmlTable
cell = 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 forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! (forall {t} {a}. (Eq t, Num t) => t -> (t -> a) -> [a] -> [a]
add Int
x Int -> HtmlAttr
colspan forall a b. (a -> b) -> a -> b
$ forall {t} {a}. (Eq t, Num t) => t -> (t -> a) -> [a] -> [a]
add Int
y Int -> HtmlAttr
rowspan 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 forall a. a -> [a] -> [a]
: [a]
rest
r :: BlockTable (Int -> Int -> Html)
r = forall a. a -> BlockTable a
BT.single Int -> Int -> Html
cellFn
in
BlockTable (Int -> Int -> Html) -> HtmlTable
mkHtmlTable BlockTable (Int -> Int -> Html)
r
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
(</>),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 forall a. BlockTable a -> BlockTable a -> BlockTable a
BT.above (forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht1
a) (forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht2
b)
</> :: forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
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 forall a. BlockTable a -> BlockTable a -> BlockTable a
BT.beside (forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht1
a) (forall ht. HTMLTABLE ht => ht -> HtmlTable
cell ht2
b)
<-> :: forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
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)
aboves :: (HTMLTABLE ht) => [ht] -> HtmlTable
aboves :: forall ht. HTMLTABLE ht => [ht] -> HtmlTable
aboves [] = forall a. HasCallStack => [Char] -> a
error [Char]
"aboves []"
aboves [ht]
xs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
(</>) (forall a b. (a -> b) -> [a] -> [b]
map forall ht. HTMLTABLE ht => ht -> HtmlTable
cell [ht]
xs)
besides :: (HTMLTABLE ht) => [ht] -> HtmlTable
besides :: forall ht. HTMLTABLE ht => [ht] -> HtmlTable
besides [] = forall a. HasCallStack => [Char] -> a
error [Char]
"besides []"
besides [ht]
xs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
(<->) (forall a b. (a -> b) -> [a] -> [b]
map forall ht. HTMLTABLE ht => ht -> HtmlTable
cell [ht]
xs)
renderTable :: BT.BlockTable (Int -> Int -> Html) -> Html
renderTable :: BlockTable (Int -> Int -> Html) -> Html
renderTable BlockTable (Int -> Int -> Html)
theTable
= forall a. HTML a => [a] -> Html
concatHtml
[Html -> Html
tr 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 <- 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) = forall a. Show a => a -> ShowS
shows (BlockTable (Int -> Int -> Html) -> Html
renderTable BlockTable (Int -> Int -> Html)
tab)
simpleTable :: [HtmlAttr] -> [HtmlAttr] -> [[Html]] -> Html
simpleTable :: [HtmlAttr] -> [HtmlAttr] -> [[Html]] -> Html
simpleTable [HtmlAttr]
attr [HtmlAttr]
cellAttr [[Html]]
lst
= Html -> Html
table forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [HtmlAttr]
attr
forall a b. HTML a => (Html -> b) -> a -> b
<< (forall ht. HTMLTABLE ht => [ht] -> HtmlTable
aboves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall ht. HTMLTABLE ht => [ht] -> HtmlTable
besides forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((Html -> Html
td forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [HtmlAttr]
cellAttr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HTML a => a -> Html
toHtml))
) [[Html]]
lst