module Text.Tabular.Html where
import Text.Tabular
import Text.Html
render :: (rh -> Html)
-> (ch -> Html)
-> (a -> Html) -> Table rh ch a -> Html
render :: forall rh ch a.
(rh -> Html)
-> (ch -> Html) -> (a -> Html) -> Table rh ch a -> Html
render rh -> Html
fr ch -> Html
fc a -> Html
f (Table Header rh
rh Header ch
ch [[a]]
cells) =
Html -> Html
table forall a b. (a -> b) -> a -> b
$ Html
header forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
body
where
header :: Html
header = Html -> Html
tr (Html -> Html
myTh Html
noHtml forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
headerCore)
headerCore :: Html
headerCore = forall a. HTML a => [a] -> Html
concatHtml forall a b. (a -> b) -> a -> b
$ forall b h. (Properties -> b -> b) -> (h -> b) -> Header h -> [b]
squish forall {a}. ADDATTRS a => Properties -> a -> a
applyVAttr Html -> Html
myTh (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ch -> Html
fc Header ch
ch)
body :: Html
body = forall a. HTML a => [a] -> Html
concatHtml forall a b. (a -> b) -> a -> b
$ forall b h. (Properties -> b -> b) -> (h -> b) -> Header h -> [b]
squish forall {a}. ADDATTRS a => Properties -> a -> a
applyHAttr Html -> Html
tr
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst
forall a b. (a -> b) -> a -> b
$ forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Html
noHtml [Html]
rows Header rh
rh
rows :: [Html]
rows = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Html
h [a]
cs -> Html -> Html
myTh Html
h forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [a] -> Html
doRow [a]
cs)
[Html]
rhStrings [[a]]
cells
doRow :: [a] -> Html
doRow [a]
cs = forall a. HTML a => [a] -> Html
concatHtml forall a b. (a -> b) -> a -> b
$ forall b h. (Properties -> b -> b) -> (h -> b) -> Header h -> [b]
squish forall {a}. ADDATTRS a => Properties -> a -> a
applyVAttr Html -> Html
myTd forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Html
noHtml (forall a b. (a -> b) -> [a] -> [b]
map a -> Html
f [a]
cs) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ch -> Html
fc Header ch
ch)
myTh :: Html -> Html
myTh = Html -> Html
th
myTd :: Html -> Html
myTd = Html -> Html
td
rhStrings :: [Html]
rhStrings = forall a b. (a -> b) -> [a] -> [b]
map rh -> Html
fr forall a b. (a -> b) -> a -> b
$ forall h. Header h -> [h]
headerContents Header rh
rh
applyVAttr :: Properties -> a -> a
applyVAttr Properties
p a
x = a
x forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! Properties -> [HtmlAttr]
vAttr Properties
p
applyHAttr :: Properties -> a -> a
applyHAttr Properties
p a
x = a
x forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! Properties -> [HtmlAttr]
hAttr Properties
p
vAttr :: Properties -> [HtmlAttr]
vAttr :: Properties -> [HtmlAttr]
vAttr Properties
DoubleLine = [String -> HtmlAttr
theclass String
"thickright"]
vAttr Properties
SingleLine = [String -> HtmlAttr
theclass String
"thinright"]
vAttr Properties
_ = []
hAttr :: Properties -> [HtmlAttr]
hAttr :: Properties -> [HtmlAttr]
hAttr Properties
DoubleLine = [String -> HtmlAttr
theclass String
"thickbottom"]
hAttr Properties
SingleLine = [String -> HtmlAttr
theclass String
"thinbottom"]
hAttr Properties
_ = []
css :: String -> Html
css :: String -> Html
css String
c = Html -> Html
style (String -> Html
stringToHtml String
c) forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
thetype String
"text/css" ]
defaultCss :: String
defaultCss :: String
defaultCss = [String] -> String
unlines
[ String
"table { border-collapse: collapse; border: 1px solid; }"
, String
"th { padding:0.2em; background-color: #eeeeee }"
, String
"td { padding:0.2em; }"
, String
".thinbottom { border-bottom: 1px solid }"
, String
".thickbottom { border-bottom: 3px solid }"
, String
".thinright { border-right: 1px solid }"
, String
".thickright { border-right: 3px solid }"
]