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


-- 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.http_equiv (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 (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)

-- | 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)