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 fr :: rh -> Html
fr fc :: ch -> Html
fc f :: a -> Html
f (Table rh :: Header rh
rh ch :: Header ch
ch cells :: [[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 (\h :: Html
h cs :: [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 cs :: [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 p :: Properties
p x :: a
x = a
x a -> [HtmlAttr] -> a
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! Properties -> [HtmlAttr]
vAttr Properties
p
  applyHAttr :: Properties -> a -> a
applyHAttr p :: Properties
p x :: 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 DoubleLine = [String -> HtmlAttr
theclass "thickright"]
vAttr SingleLine = [String -> HtmlAttr
theclass "thinright"]
vAttr _          = []

hAttr :: Properties -> [HtmlAttr]
hAttr :: Properties -> [HtmlAttr]
hAttr DoubleLine = [String -> HtmlAttr
theclass "thickbottom"]
hAttr SingleLine = [String -> HtmlAttr
theclass "thinbottom"]
hAttr _          = []


-- | Convenience function to add a CSS string to your
--   HTML document
css :: String -> Html
css :: String -> Html
css c :: String
c = Html -> Html
style (String -> Html
stringToHtml String
c) Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
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 :: String
defaultCss = [String] -> String
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 }"
  ]