module Text.YuiGrid.YGridCxML (pageToCxML) where
import Prelude hiding (div, span)
import Data.List (nub)
import Text.CxML (CxML, (^%), StyleDecl(..), body, (/-), div, (^#), (^.), CssInlineDecl)
import Text.YuiGrid.YGrid
yahooRls :: [StyleDecl]
yahooRls = [CSSLink (yGridsCSS_URL_Dir ++ yGridsCSS_File), gridsPatchCSSRule]
where
yGridsCSS_URL_Dir = "http://yui.yahooapis.com/2.5.2/build/reset-fonts-grids"
yGridsCSS_File = "/reset-fonts-grids.css"
gridsPatchCSSRule = CSSRule [ ".yui-u .yui-g", ".yui-u .yui-gb",
".yui-u .yui-gc", ".yui-u .yui-gd",
".yui-u .yui-ge", ".yui-u .yui-gf"
] [("width","100%")]
pageToCxML :: YPage (CxML a) -> CxML a
pageToCxML yPage
= body ^% yahooRls /-
[div^#docId^.docClass /-
[
div^#"hd" /- map yGridToCxML (headerBlock yPage),
div^#"bd" /- bd,
div^#"ft" /- map yGridToCxML (footerBlock yPage)
]
]
where
docId = case pageWidth yPage of
YPW_750px -> "doc"
YPW_950px -> "doc2"
YPW_100perc -> "doc3"
YPW_974px -> "doc4"
docClass = case sidebarBlock yPage of
Nothing -> ""
Just (SidebarLeft_160px,_) -> "yui-t1"
Just (SidebarLeft_180px,_) -> "yui-t2"
Just (SidebarLeft_300px,_) -> "yui-t3"
Just (SidebarRight_180px,_) -> "yui-t4"
Just (SidebarRight_240px,_) -> "yui-t5"
Just (SidebarRight_300px,_) -> "yui-t6"
bd = case sidebarBlock yPage of
Nothing -> theMain
Just (_, sidebar) -> [ div^."yui-b" /- map yGridToCxML sidebar,
div^#"yui-main" /- [div^."yui-b" /- theMain]
]
theMain = map yGridToCxML (mainBlock yPage)
data Context = NonCtx | FstColCtx | NonFstColCtx
yGridToCxML :: YGrid (CxML a) -> CxML a
yGridToCxML = yGridToCxML' NonCtx
yGridToCxML' :: Context -> YGrid (CxML a) -> CxML a
yGridToCxML' ctx (YGrid_SimpleBox cxml csss) = yMaybeBoxDiv ctx csss [cxml]
yGridToCxML' ctx (YGrid_ComplexBox c1 csss) = yMaybeBoxDiv ctx csss (map yGridToCxML c1)
yGridToCxML' ctx (YGrid_1Col c1) = yMaybeBoxDiv ctx [] (map yGridToCxML c1)
yGridToCxML' ctx g@(YGrid_2Cols _ c1 c2)
= div^.(yGrdClass ctx g) /- [yFstCol c1, yNonFstCol c2]
yGridToCxML' ctx g@(YGrid_3Cols c1 c2 c3)
= div^.(yGrdClass ctx g) /- [yFstCol c1, yNonFstCol c2, yNonFstCol c3]
--or
yFstCol, yNonFstCol :: [YGrid (CxML a)] -> CxML a
yFstCol = yCol FstColCtx
yNonFstCol = yCol NonFstColCtx
yCol :: Context -> [YGrid (CxML a)] -> CxML a
yCol ctx [g] = yGridToCxML' ctx g
yCol ctx col = yMaybeBoxDiv ctx [] (map yGridToCxML col)
yMaybeBoxDiv :: Context -> [CssInlineDecl] -> [CxML a] -> CxML a
yMaybeBoxDiv NonCtx csss cxmls = setCSS csss cxmls
yMaybeBoxDiv ctx csss cxmls = setUnitClass ctx $ div /- [setCSS csss cxmls]
yGrdClass :: Context -> YGrid a -> String
yGrdClass FstColCtx g = yGrdClass' g ++ " first"
yGrdClass _ g = yGrdClass' g
yGrdClass' :: YGrid a -> String
yGrdClass' (YGrid_2Cols Y_1o2_1o2 _ _) = "yui-g"
yGrdClass' (YGrid_2Cols Y_2o3_1o3 _ _) = "yui-gc"
yGrdClass' (YGrid_2Cols Y_1o3_2o3 _ _) = "yui-gd"
yGrdClass' (YGrid_2Cols Y_3o4_1o4 _ _) = "yui-ge"
yGrdClass' (YGrid_2Cols Y_1o4_3o4 _ _) = "yui-gf"
yGrdClass' (YGrid_3Cols _ _ _) = "yui-gb"
yGrdClass' _ = ""
setUnitClass :: Context -> CxML a -> CxML a
setUnitClass NonCtx cxml = cxml
setUnitClass FstColCtx cxml = cxml^."yui-u first"
setUnitClass NonFstColCtx cxml = cxml^."yui-u"
setCSS :: [CssInlineDecl] -> [CxML a] -> CxML a
setCSS csss cxmls = foldl setCSS' (div /- cxmls) csss
setCSS' :: CxML a -> (String, [(String, String)]) -> CxML a
setCSS' cxml (cssId, rls) = cxml^.cssId^%[CSSRule ['.':cssId] rls]