module Text.Tabular.Html where

import Text.Tabular
import Text.Html

render :: (rh -> Html)
       -> (ch -> Html)
       -> (a -> Html) -> Table rh ch a -> Html
render :: (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 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
header Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
body
 where
  header :: Html
header = Html -> Html
tr (Html -> Html
myTh Html
noHtml Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
headerCore)
  headerCore :: Html
headerCore = [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (Properties -> Html -> Html)
-> (Html -> Html) -> Header Html -> [Html]
forall b h. (Properties -> b -> b) -> (h -> b) -> Header h -> [b]
squish Properties -> Html -> Html
forall a. ADDATTRS a => Properties -> a -> a
applyVAttr Html -> Html
myTh ((ch -> Html) -> Header ch -> Header Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ch -> Html
fc Header ch
ch)
  --
  body :: Html
body = [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (Properties -> Html -> Html)
-> (Html -> Html) -> Header Html -> [Html]
forall b h. (Properties -> b -> b) -> (h -> b) -> Header h -> [b]
squish Properties -> Html -> Html
forall a. ADDATTRS a => Properties -> a -> a
applyHAttr Html -> Html
tr
       (Header Html -> [Html]) -> Header Html -> [Html]
forall a b. (a -> b) -> a -> b
$ ((Html, rh) -> Html) -> Header (Html, rh) -> Header Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Html, rh) -> Html
forall a b. (a, b) -> a
fst
       (Header (Html, rh) -> Header Html)
-> Header (Html, rh) -> Header Html
forall a b. (a -> b) -> a -> b
$ Html -> [Html] -> Header rh -> Header (Html, rh)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Html
noHtml [Html]
rows Header rh
rh
  rows :: [Html]
rows = (Html -> [a] -> Html) -> [Html] -> [[a]] -> [Html]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Html
h [a]
cs -> Html -> Html
myTh Html
h Html -> Html -> Html
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 = [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (Properties -> Html -> Html)
-> (Html -> Html) -> Header Html -> [Html]
forall b h. (Properties -> b -> b) -> (h -> b) -> Header h -> [b]
squish Properties -> Html -> Html
forall a. ADDATTRS a => Properties -> a -> a
applyVAttr Html -> Html
myTd (Header Html -> [Html]) -> Header Html -> [Html]
forall a b. (a -> b) -> a -> b
$
               ((Html, Html) -> Html) -> Header (Html, Html) -> Header Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Html, Html) -> Html
forall a b. (a, b) -> a
fst (Header (Html, Html) -> Header Html)
-> Header (Html, Html) -> Header Html
forall a b. (a -> b) -> a -> b
$ Html -> [Html] -> Header Html -> Header (Html, Html)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Html
noHtml ((a -> Html) -> [a] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map a -> Html
f [a]
cs) ((ch -> Html) -> Header ch -> Header Html
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 = (rh -> Html) -> [rh] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map rh -> Html
fr ([rh] -> [Html]) -> [rh] -> [Html]
forall a b. (a -> b) -> a -> b
$ Header rh -> [rh]
forall h. Header h -> [h]
headerContents Header rh
rh
  applyVAttr :: Properties -> a -> a
applyVAttr Properties
p a
x = a
x a -> [HtmlAttr] -> a
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! Properties -> [HtmlAttr]
vAttr Properties
p
  applyHAttr :: Properties -> a -> a
applyHAttr Properties
p a
x = a
x a -> [HtmlAttr] -> a
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
_          = []


-- | Convenience function to add a CSS string to your
--   HTML document
css :: String -> Html
css :: String -> Html
css String
c = Html -> Html
style (String -> Html
stringToHtml String
c) Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
thetype String
"text/css" ]

-- | You need to incorporate some CSS into your file with
--   the classes @thinbottom@, @thinright@, @thickbottom@
--   and @thickright@.  See '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 }"
  ]