module Text.Tabular.Html where
import Text.Tabular
import Text.Html
render :: (rh -> Html)
-> (ch -> Html)
-> (a -> Html) -> Table rh ch a -> Html
render fr fc f (Table rh ch cells) =
table $ header +++ body
where
header = tr (myTh noHtml +++ headerCore)
headerCore = concatHtml $ squish applyVAttr myTh (fmap fc ch)
--
body = concatHtml $ squish applyHAttr tr
$ fmap fst
$ zipHeader noHtml rows rh
rows = zipWith (\h cs -> myTh h +++ doRow cs)
rhStrings cells
doRow cs = concatHtml $ squish applyVAttr myTd $
fmap fst $ zipHeader noHtml (map f cs) (fmap fc ch)
--
myTh = th
myTd = td
rhStrings = map fr $ headerContents rh
applyVAttr p x = x ! vAttr p
applyHAttr p x = x ! hAttr p
vAttr :: Properties -> [HtmlAttr]
vAttr DoubleLine = [theclass "thickright"]
vAttr SingleLine = [theclass "thinright"]
vAttr _ = []
hAttr :: Properties -> [HtmlAttr]
hAttr DoubleLine = [theclass "thickbottom"]
hAttr SingleLine = [theclass "thinbottom"]
hAttr _ = []
-- | Convenience function to add a CSS string to your
-- HTML document
css :: String -> Html
css c = style (stringToHtml c) ! [ thetype "text/css" ]
-- | You need to incorporate some CSS into your file with
-- the classes @thinbottom@, @thinright@, @thickbottom@
-- and @thickright@. See 'css'
defaultCss :: String
defaultCss = unlines
[ "table { border-collapse: collapse; border: 1px solid; }"
, "th { padding:0.2em; background-color: #eeeeee }"
, "td { padding:0.2em; }"
, ".thinbottom { border-bottom: 1px solid }"
, ".thickbottom { border-bottom: 3px solid }"
, ".thinright { border-right: 1px solid }"
, ".thickright { border-right: 3px solid }"
]