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.Pretty
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
-- html-elements
textTag tag = prim . tag . H.string
-- | @p@ tag
p :: String -> Css H.Html
p = textTag H.p
-- | @pre@ tag
pre :: String -> Css H.Html
pre = textTag H.pre
-- | @a@ tag
--
-- arguments
--
-- * href
--
-- * text
a :: String -> String -> Css H.Html
a href text = prim $ H.a H.! HA.href (H.stringValue href) $ H.string text
-- headers
-- | @h1@ tag
h1 :: String -> Css H.Html
h1 = textTag H.h1
-- | @h2@ tag
h2 :: String -> Css H.Html
h2 = textTag H.h2
-- | @h3@ tag
h3 :: String -> Css H.Html
h3 = textTag H.h3
-- | @h4@ tag
h4 :: String -> Css H.Html
h4 = textTag H.h4
-- | @h5@ tag
h5 :: String -> Css H.Html
h5 = textTag H.h5
-- | @h6@ tag
h6 :: String -> Css H.Html
h6 = textTag H.h6
-- | images
--
-- arguments :
--
-- * @alt@ atribute value
--
-- * @src@ atribute value
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@ tag
ul :: [String] -> Css H.Html
ul = ls H.ul
-- | @ol@ tag
ol :: [String] -> Css H.Html
ol = ls H.ol
-- lists
ls constr = prim . constr . foldl1 (>>) . map (H.li . H.string)
-- | @ul@ tag with links
--
-- arguments : [(href, text)]
aul :: [(String, String)] -> Css H.Html
aul = als H.ul
-- | @ol@ tag with links
--
-- arguments : [(href, text)]
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
-- tables
-- | table
--
-- arguments :
--
-- * Maybe header
--
-- * [rows]
--
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.httpEquiv (H.stringValue "Content-Type")
H.! HA.content (H.stringValue "text/html")
H.! HA.charset (H.stringValue str)
-- | writes css and htmls to files
--
-- arguments :
--
-- * css file name
--
-- * global css StyleSheet i.e. ruleSets about @body@ or some html elements
--
-- * list of ((filename, html head sub elements), css)
writeBlazeCss ::
String -> StyleSheet
-> [((String, H.Html), Css H.Html)] -> IO ()
writeBlazeCss cssFile globalStyles xs =
writeFile cssFile (prettyPrint $ merge globalStyles cssCont) >>
(foldl1 (>>) $ zipWith writeFile (map (fst . fst) xs) $
zipWith (formHtml cssFile) (map (snd . fst) xs) htmls)
where (cssCont, htmls) = toBlaze $ map snd xs
merge (StyleSheet h0 h1 body) x = StyleSheet h0 h1
$ body ++ map SRuleSet x
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)
-- | genereates html filenames and head's sublelements from list of titles
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)