Text/CxML/Output.hs

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 = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\""
          ++ " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\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, "</", nm, ">\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, "</", nm, ">\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,
                     "});"]
-}