module Text.CxML.Output --miscellaneous functions for outputting or simplifying contextual markup (showNonCxmlStrict) where import Data.List (intercalate, nub) import Text.CxML.Types import Text.CxML.Tags import Text.CxML.HTML import Text.CxML.CSS (csslink) --from module Text.XHtml.Strict strictDocType = "\n" --FIXME: check doc type. The short way to specify tags without children is not --being correctly parsed by firefox, so probably the doc type is wrong. -- | convert static parts of the document to dynamic HTML fullInlineDoc :: String -> CxML a -> CxML a fullInlineDoc titl bod = (tag "html")!("xmlns","http://www.w3.org/1999/xhtml") /- [ header /- (theTitle : staticCSSLinks ++ [inlineParts]), body /- [htmlPart bod, inlineJS $ js bod ] ] where theTitle = title /- [t titl] css' = css bod staticCSSLinks = map csslink $ nub $ [url | CSSLink url <- css'] cssRls = nub $ [(sel,declBlock) | CSSRule sel declBlock <- css'] -- FIXME: expensive, since compares the full rule. For a small improvement, consider using: -- nubBy :: (a -> a -> Bool) -> [a] -> [a] inlineParts = inlineCSS cssRls --FIXME: list of CSS is traversed twice --FIXME: still lacks JS -- | convert CSS Rule into a HTML style tag inlineCSS :: [([String], [(String,String)])]-> CxML a inlineCSS [] = noElem inlineCSS cssRls = style!("type", "text/css")!("media","screen") /- [t $ concatMap showRule cssRls] where showRule (sel,declBlock) = concat [ intercalate "," sel, " {", concatMap (\(at,vl)->at++":"++vl++";") declBlock, "}\n" ] -- | convert JavaScript into a HTML script tag inlineJS :: [JSDecl]-> CxML a inlineJS [] = noElem inlineJS js = script!("type","text/javascript")/- [t $ show js] instance Show JSDecl where show (OnLoad s) = s -- | Pretty printing CxML () showNonCx :: CxML () -> String showNonCx (CxML (h,ts,c,j)) = concatMap (showNice' 0) $ h () -- | show HTML starting with no indentation showNice = showNice' 0 -- | show HTML with indentation, one space per level showNice' :: Int -> HElem -> String showNice' i (HText str) = concat [spaces i,str, "\n" ] showNice' i (HTag nm@"div" ats chs) = concat [spaces i, "<", nm, concatMap (\(an, av)->" "++an++"=\""++av++"\"") ats, ">\n", concatMap (showNice' (i+1)) chs, spaces i, "\n"] --FIXME: Not just for divs. There are more tags that can not be rendered short even if there are no children showNice' i (HTag nm [] []) = concat [spaces i, "<", nm, " />\n" ] showNice' i (HTag nm ats chs) = concat [spaces i, "<", nm, concatMap (\(an, av)->" "++an++"=\""++av++"\"") ats, ">\n", concatMap (showNice' (i+1)) chs, spaces i, "\n"] spaces i = replicate i ' ' showNonCxmlStrict :: String -> CxML () -> String showNonCxmlStrict titl = (strictDocType ++) . showNonCx . fullInlineDoc titl {- -- debugging showDoc cxml ctx = concat [strictDocType, concatMap show $ (htm cxml) ctx] printFullDoc doc ctx = putStr $ showDoc (fullInlineDoc "TheTitle" doc) ctx instance Show HElem where show h = showNice h showJS:: [JSDecl]->String showJS jss = concat ["Event.observe(window, 'load', function() {", concatMap show jss, "});"] -}