module SimpleCss.Tricks.Shortcuts.Html
(p, a, img, pre,
h1, h2, h3, h4, h5, h6,
ul, ol, aul, aol, table,
encoding, writeBlazeCss, initHtmls)
where
import Language.Css.Syntax
import Language.Css.Build
import SimpleCss
import qualified Text.Blaze.Renderer.String as H
import qualified Text.Blaze as H
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA
textTag tag = prim . tag . H.string
p :: String -> Css H.Html
p = textTag H.p
pre :: String -> Css H.Html
pre = textTag H.pre
a :: String -> String -> Css H.Html
a href text = prim $ H.a H.! HA.href (H.stringValue href) $ H.string text
h1 :: String -> Css H.Html
h1 = textTag H.h1
h2 :: String -> Css H.Html
h2 = textTag H.h2
h3 :: String -> Css H.Html
h3 = textTag H.h3
h4 :: String -> Css H.Html
h4 = textTag H.h4
h5 :: String -> Css H.Html
h5 = textTag H.h5
h6 :: String -> Css H.Html
h6 = textTag H.h6
img :: String -> String -> Css H.Html
img alt src = prim $ H.img H.! HA.src (H.stringValue src) H.! HA.alt (H.stringValue alt)
ul :: [String] -> Css H.Html
ul = ls H.ul
ol :: [String] -> Css H.Html
ol = ls H.ol
ls constr = prim . constr . foldl1 (>>) . map (H.li . H.string)
aul :: [(String, String)] -> Css H.Html
aul = als H.ul
aol :: [(String, String)] -> Css H.Html
aol = als H.ol
als constr = prim . constr . foldl1 (>>) . map (H.li . setA)
where setA (href, name) = H.a H.! HA.href (H.stringValue href) $ H.string name
table :: Maybe [String] -> [[String]] -> Css H.Html
table h rs = prim $ H.table $
case h of
Just x -> tr H.th x >> trs
Nothing -> trs
where tr f x = H.tr $ foldl (>>) (return ()) $ map (f . H.string) x
trs = foldl1 (>>) $ map (tr H.td) rs
encoding :: String -> H.Html
encoding str = H.meta H.! HA.http_equiv (H.stringValue "Content-Type")
H.! HA.content (H.stringValue "text/html")
H.! HA.charset (H.stringValue str)
writeBlazeCss :: String -> StyleSheet -> [((String, H.Html), Css H.Html)] -> IO ()
writeBlazeCss cssFile globalStyles xs = writeFile cssFile (gCssCont ++ cssCont) >>
(foldl1 (>>) $ zipWith writeFile (map (fst . fst) xs) $
zipWith (formHtml cssFile) (map (snd . fst) xs) htmls)
where (cssCont, htmls) = toBlaze $ map snd xs
gCssCont = show globalStyles ++ "\n\n"
formHtml :: String -> H.Html -> H.Html -> String
formHtml cssFile hHead hBody = H.renderHtml $ H.docTypeHtml $ H.html $
(H.head $ linkCss cssFile >> hHead) >> (H.body hBody)
where body' = H.body hBody
head' = H.head $ linkCss cssFile >> hHead
linkCss :: String -> H.Html
linkCss cssFile =
H.link H.! HA.rel (H.stringValue "stylesheet")
H.! HA.type_ (H.stringValue "text/css")
H.! HA.href (H.stringValue cssFile)
initHtmls :: [String] -> [(String, H.Html)]
initHtmls names = zip (map (++ ".html") names) $ map fromTitle names
fromTitle :: String -> H.Html
fromTitle title = encoding "UTF-8" >> (H.title $ H.string title)