summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--AUTHORS3
-rw-r--r--Example/GridExample.hs102
-rw-r--r--Example/Makefile8
-rw-r--r--Example/README8
-rw-r--r--Example/images/header.gifbin0 -> 26128 bytes
-rw-r--r--LICENSE25
-rw-r--r--Setup.lhs6
-rw-r--r--Text/CxML.hs21
-rw-r--r--Text/CxML/CSS.hs32
-rw-r--r--Text/CxML/HTML.hs130
-rw-r--r--Text/CxML/JS.hs15
-rw-r--r--Text/CxML/NavList.hs73
-rw-r--r--Text/CxML/Output.hs93
-rw-r--r--Text/CxML/Tags.hs97
-rw-r--r--Text/CxML/Types.hs80
-rw-r--r--Text/YuiGrid.hs39
-rw-r--r--Text/YuiGrid/Grid.hs234
-rw-r--r--Text/YuiGrid/LayoutHints.hs92
-rw-r--r--Text/YuiGrid/YGrid.hs84
-rw-r--r--Text/YuiGrid/YGridCxML.hs115
-rw-r--r--yuiGrid.cabal34
21 files changed, 1291 insertions, 0 deletions
diff --git a/AUTHORS b/AUTHORS
new file mode 100644
index 0000000..0f39045
--- /dev/null
+++ b/AUTHORS
@@ -0,0 +1,3 @@
+Tom Nielsen (tanielsen@gmail.com): Initital design and development.
+Sergio Urinovsky (sergio.urinovsky@gmail.com): Design and lead developer.
+
diff --git a/Example/GridExample.hs b/Example/GridExample.hs
new file mode 100644
index 0000000..7bd61e0
--- /dev/null
+++ b/Example/GridExample.hs
@@ -0,0 +1,102 @@
+module Main where
+
+import Text.CxML
+import Text.YuiGrid
+import Network.HTTP.RedHandler
+import Control.Monad.Reader (ask)
+
+
+-----------------------------------------------
+-- Responses with grids
+-----------------------------------------------
+
+type GridResp = HandlerRsp [GridElement ()]
+
+gridRespToRsp :: GridResp -> BasicRsp
+gridRespToRsp = basicRspWith (showNonCxmlStrict "Grid Example" . gridPage)
+
+-----------------------------------------------
+-- Utilities for Handlers with Grid responses
+-----------------------------------------------
+
+-- | add contextual grid elements to the dynamic response
+inGridWithElems :: Monad m => [GridElement RequestContext] -> RqHandlerT m GridResp -> RqHandlerT m GridResp
+inGridWithElems ges handl = do ges' <- fmap (runBoxes ges) ask
+ fmap (fmap (++ ges')) handl
+
+-- | turn a contextual html into a grid response handler
+okCxML :: Monad m => CxML RequestContext -> RqHandlerT m GridResp
+okCxML cx = fmap ( return . (:[]) . boxInMain . runCxML cx) ask
+
+
+-----------------------------------------------
+-- Main daemon and port
+-----------------------------------------------
+main :: IO ()
+main = runHttpServer 8080 mainHandlers
+
+-----------------------------------------------
+-- Routes and handlers
+-----------------------------------------------
+mainHandlers :: [IORqHandler BasicRsp]
+mainHandlers = [staticFilesHandler, appHandlers]
+
+staticFilesHandler = under "pictures" $ mapDir "./images/"
+
+appHandlers = modResp gridRespToRsp $ appCtx $ anyOf [greetHandler, inputFormHandler]
+
+
+inputFormHandler :: IORqHandler GridResp
+inputFormHandler = okCxML inputForm
+
+greetHandler :: IORqHandler GridResp
+greetHandler = ifPost $
+ withPostField "name" (\n -> if null n
+ then notMe
+ else okCxML (greet n)
+ )
+
+
+greet :: String -> CxML a
+greet n = p /- [t $ "Hello " ++ n ++ "!"]
+
+inputForm :: CxML a
+inputForm = form!("method","post")
+ /- [
+ p /- [t "My name is ", textfield "name"],
+ button!("name","action")!("value","submit") /- [t "Submit"]
+ ]
+
+
+
+-----------------------------------------------
+-- Application GRID context
+-----------------------------------------------
+appCtx :: Monad m => RqHandlerT m GridResp -> RqHandlerT m GridResp
+appCtx h = do
+ inGridWithElems [
+ boxInFooter (t "Footer goes here."),
+ boxInHeader (h1logo "Header image goes in the URL" "/pictures/header.gif"),
+ smallMarginBottomCSS $ nearLeft $ setColumnsVote 2 $ nearBottom $ boxInHeader (loginControl "Guest"),
+ smallMarginBottomCSS $ nearRight $ setColumnsVote 2 $ nearBottom $ boxInHeader searchForm,
+ boxInLeftSidebar (vertNav [("Home", "/"),
+ ("About", "/about"),
+ ("Contact", "/contact")])
+ ] $ h
+
+
+-----------------------------------------------
+-- More contextual htmls used in the example
+-----------------------------------------------
+searchForm :: CxML a
+searchForm
+ = form!("method","post")!("action","/search.html")
+ /- [
+ textfield "search",
+ button!("name","action")!("value","submit") /- [t "Search"]
+ ]
+
+
+loginControl ::String -> CxML a
+loginControl userName = t ("User: " ++ userName)
+
diff --git a/Example/Makefile b/Example/Makefile
new file mode 100644
index 0000000..f59e2b8
--- /dev/null
+++ b/Example/Makefile
@@ -0,0 +1,8 @@
+.PHONY: application clean
+
+application:
+ ghc -o GridExample --make GridExample.hs
+
+clean:
+ -rm GridExample
+ -rm *.o *.hi *~
diff --git a/Example/README b/Example/README
new file mode 100644
index 0000000..32561cc
--- /dev/null
+++ b/Example/README
@@ -0,0 +1,8 @@
+BUILD:
+In order to build the example you need to setup also the "redHandlers" pkg.
+Then just run "make" to make the example.
+
+RUN:
+The example is a standalone web application listening on port 8080.
+ - Run the application "main"
+ - Open a browser and try the URL: http://localhost:8080/
diff --git a/Example/images/header.gif b/Example/images/header.gif
new file mode 100644
index 0000000..868d8b9
--- /dev/null
+++ b/Example/images/header.gif
Binary files differ
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..de50f59
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,25 @@
+The MIT License
+
+Copyright (c) 2009 RedNucleus LTD
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
index 0000000..a2b7c03
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,6 @@
+#! /usr/bin/env runhaskell
+
+>import Distribution.Simple
+
+>main = defaultMain
+
diff --git a/Text/CxML.hs b/Text/CxML.hs
new file mode 100644
index 0000000..e310cf8
--- /dev/null
+++ b/Text/CxML.hs
@@ -0,0 +1,21 @@
+module Text.CxML
+ (
+ h1logo, vertNav, --module Text.CxML.NavList,
+ (^#), (^.), t, (!), hidden, textfield, afile, --Text.CxML.HTML,
+ (^%), (^^.), --module Text.CxML.CSS,
+ --module Text.CxML.JS,
+ body, div, h1, tr, td, a, br, span, font, p, form, button, table, tag, title, h2, h3, h4, image, --module Text.CxML.Tags,
+ showNonCxmlStrict, --module Text.CxML.Output,
+ CssInlineDecl, CxML, StyleDecl(..), (/-), concatCxML, runCxML, NonCxML, (+++), noElem, withCtx, modCx --module Text.CxML.Types
+ ) where
+
+import Prelude hiding (div, span)
+
+import Text.CxML.Types
+import Text.CxML.NavList
+import Text.CxML.Tags
+import Text.CxML.Output
+import Text.CxML.HTML
+import Text.CxML.CSS
+import Text.CxML.JS
+
diff --git a/Text/CxML/CSS.hs b/Text/CxML/CSS.hs
new file mode 100644
index 0000000..d84675e
--- /dev/null
+++ b/Text/CxML/CSS.hs
@@ -0,0 +1,32 @@
+module Text.CxML.CSS where
+-- utility functions for manipulating CSS part
+
+import Text.CxML.Types
+import Text.CxML.Tags
+import Text.CxML.HTML
+
+-- change a list of CSS declarations to prepend a selector
+underSelector :: String -> [StyleDecl] -> [StyleDecl]
+underSelector par rls = map (underSelector' par) rls
+
+underSelector' par (CSSRule sel ats) = CSSRule (map prepend sel) ats
+ where prepend s = par++" "++s
+
+underSelector' par sd@(_) = sd
+
+(*>) = underSelector
+
+-- | set style
+infixl 8 ^%
+
+(^%) :: CxML a->[StyleDecl]-> CxML a
+tag ^% sty = CxML (htm tag, titleParts tag, css tag ++ sty, js tag)
+
+-- | create HTML to link to a CSS file
+csslink url = link!("type","text/css")!("rel","stylesheet")^>url
+
+
+infixl 8 ^^.
+(^^.) :: CxML a -> CssInlineDecl -> CxML a
+tag^^.(rlsName,rlsBody) = tag^.rlsName ^%[CSSRule ['.':rlsName] rlsBody ]
+
diff --git a/Text/CxML/HTML.hs b/Text/CxML/HTML.hs
new file mode 100644
index 0000000..fcfba5e
--- /dev/null
+++ b/Text/CxML/HTML.hs
@@ -0,0 +1,130 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+
+module Text.CxML.HTML where
+
+import Text.CxML.Types
+import Text.CxML.Tags(input)
+
+-- | escape HTML
+
+--newtype HtmlSafeString = HtSfString String -- this is a type safe way to prevent XSS. We may do that in the future
+-- see http://blog.moertel.com/articles/2006/10/18/a-type-based-solution-to-the-strings-problem
+
+hText = HText . escapeBrackets -- poor man's solution to the "strings problem" (see link above)
+
+escapeBrackets :: String -> String
+escapeBrackets [] = []
+escapeBrackets ('<':t) = "&lt;"++escapeBrackets t
+escapeBrackets ('>':t) = "&gt;"++escapeBrackets t
+escapeBrackets ('&':t) = "&amp;"++escapeBrackets t
+escapeBrackets ('\'':t) = "&apos;"++escapeBrackets t
+escapeBrackets ('"':t) = "&qout;"++escapeBrackets t
+escapeBrackets ('(':'C':')':t) = "&copy;"++escapeBrackets t --copyright
+escapeBrackets (h:t) = h:(escapeBrackets t)
+
+-- | create a text node. Automatically escape HTML to protect against XSS
+t :: String-> CxML a
+t str = CxML (\_->[hText str],[],[],[])
+
+-- modify HTML part of CxML - used in navList?
+modHElems :: (HElem->HElem)->CxML a->CxML a
+modHElems f (CxML (h,ts,c,j)) = CxML (\ctx->map f $ h ctx, ts, c, j)
+
+
+class CxMLChild a b where
+ (//) :: CxML a -> b -> CxML a
+
+instance CxMLChild a (CxML a)where
+ p//c= withChildren p [c]
+
+instance CxMLChild a [CxML a]where
+ p//c= withChildren p c
+
+instance CxMLChild a [Char]where
+ p//c= withChildren p [t c]
+
+instance CxMLChild a [[Char]] where
+ p//c= withChildren p $ map t c
+
+infixl 5 //
+
+
+
+
+-- | create an operator to set an attribute of HTML elements
+setAttrOp :: String -> (CxML a) -> String -> (CxML a)
+setAttrOp at= \tag-> \val->
+ CxML (\ctx-> map (add_attr at val) $ htm tag ctx, titleParts tag, css tag,js tag )
+
+-- | helper function for setAttrOp
+add_attr :: String->String->HElem->HElem
+add_attr _ _ s@(HText str)= s
+add_attr nm vl (HTag tn ats chs) = HTag tn (add_attr' nm vl ats) chs
+ where
+ add_attr' nm vl [] = [(nm,vl)]
+ add_attr' nm vl ((nm',vl'):ats)
+ = if (nm==nm')
+ then (nm,vl' ++ " " ++ vl):ats
+ else (nm',vl'): add_attr' nm vl ats
+--FIXME: a Map could be used for the attributes, although there should be just a few per tag
+
+
+infixl 8 ^#
+(^#)=setAttrOp "id"
+
+infixl 8 ^.
+(^.)=setAttrOp "class"
+
+infixl 7 ^>
+(^>)=setAttrOp "href"
+
+
+{-
+maybe one day I would like ^> to set href for <a> but src for <img>
+(^>) = \tag-> \val->
+ CxML (\ctx-> map (add_attr at val) $ (htm tag) ctx, css tag,js tag )
+ where tagAtAssoc = [("img", "src"),
+ ("a", "href")
+
+]-}
+
+-- | set any attribute of HTML element
+infixl 8 !
+(!) :: (CxML a)->(String, String)->(CxML a)
+tag ! (at,vl) = CxML (\ctx-> map (add_attr at vl) $ htm tag ctx, titleParts tag, css tag, js tag)
+
+
+--------------------------------------------------
+-----Modified from module Text.XHtml.Extras -----
+--------------------------------------------------
+
+{-widget :: String -> String -> [HtmlAttr] -> Html
+widget w n markupAttrs = input ! ([thetype w,name n,identifier n] ++ markupAttrs)
+
+checkbox :: String -> String -> Html
+hidden :: String -> String -> Html
+radio :: String -> String -> Html
+reset :: String -> String -> Html
+submit :: String -> String -> Html
+password :: String -> Html
+textfield :: String -> Html
+afile :: String -> Html
+clickmap :: String -> Html
+
+checkbox n v = widget "checkbox" n [value v]
+hidden n v = widget "hidden" n [value v]
+radio n v = widget "radio" n [value v]
+reset n v = widget "reset" n [value v]
+submit n v = widget "submit" n [value v]
+password n = widget "password" n []
+textfield n = widget "text" n []
+afile n = widget "file" n []
+clickmap n = widget "image" n []
+-}
+
+widget :: String -> String -> [(String,String)] -> CxML a
+widget w n markupAttrs = foldl (!) input (("type",w):("name",n):("id",n):markupAttrs)
+
+textfield n = widget "text" n []
+hidden n v = widget "hidden" n [("value",v)]
+afile n = widget "file" n []
diff --git a/Text/CxML/JS.hs b/Text/CxML/JS.hs
new file mode 100644
index 0000000..2dbf5cf
--- /dev/null
+++ b/Text/CxML/JS.hs
@@ -0,0 +1,15 @@
+module Text.CxML.JS where
+
+import Text.CxML.Types
+import Text.CxML.Tags
+import Text.CxML.HTML
+
+
+-- link to JavaScript file
+jslink url = script!("type","text/javascript")!("src",url)
+
+-- add JavaScript
+(^:) :: CxML a->[JSDecl]-> CxML a
+tag ^: jsd = CxML (htm tag, titleParts tag, css tag, js tag ++ jsd)
+
+
diff --git a/Text/CxML/NavList.hs b/Text/CxML/NavList.hs
new file mode 100644
index 0000000..c273989
--- /dev/null
+++ b/Text/CxML/NavList.hs
@@ -0,0 +1,73 @@
+module Text.CxML.NavList where
+
+import Text.CxML.Types
+import Text.CxML.Tags
+import Text.CxML.HTML
+import Text.CxML.CSS
+
+-- this should really be renamed CxML.Components
+
+-- this module defines a navigation list component which can be used for tabs, left-hand vertical menu or breadcrumbs.
+-- see " a list apart" on taming lists but I don't like their breadcrumbs solution with nested markup.
+
+data NavListStyle = Tabs | Vertical | Breadcrumbs | HoverCols String String | NoUnderline | LinesBetween | AnyCSS StyleDecl
+ | TextCol String | CurrentLinkCSS [(String, String)] | CurrentItemCSS [(String, String)]
+
+--navList ::[NavListStyle] -> String -> [(String, String)] -> CxML a
+navList styls tid (item:items) = ul^#tid^%(('#':tid) *> (concatMap navStyles styls))/- ((litemf item):(map litem items))
+ where litem (txt,targ) = li /- [a^>targ /- [modHElems processText $ t txt]]
+ litemf (txt,targ) = li^."first" /- [a^>targ /- [t txt]]
+ navStyles Tabs = []
+ navStyles Vertical = [CSSRule ["li a"] [("padding","4px"), ("font-size", "116%")]]
+ navStyles (CurrentLinkCSS sty) = [CSSRule ["li.current a"] sty]
+ navStyles (CurrentItemCSS sty) = [CSSRule ["li a"] sty]
+ navStyles (TextCol cl) = [CSSRule ["li a"] [("color",cl)]]
+ navStyles (HoverCols tx bg) = [CSSRule ["li:hover"] [("background-color",bg)],
+ CSSRule ["li:hover a"] [("color",tx)]]
+ navStyles NoUnderline = [CSSRule ["li a"] [("text-decoration","none")]]
+ navStyles LinesBetween = [CSSRule ["li"] [("border-top","1px solid #bbbbbb")],
+ CSSRule ["li.first"] [("border-top","none")]
+ ]
+ navStyles Breadcrumbs = [CSSRule ["li","ul"] [("display","inline"), ("margin", "0"),("padding", "0")]]
+ prependChar Breadcrumbs = "&#187; "
+ prependChar _ = ""
+ processText (HText t)= HText ((concatMap prependChar styls )++t)
+ processText h = h
+
+vertNav = navList [Vertical, NoUnderline, LinesBetween, TextCol "#000", HoverCols "#f33" "#ccc"] "vertNav"
+
+--http://www.sixshootermedia.com/blog/semantic-h1-logo-link/
+h1logo txt imgpath = h1^#"h1logo"^%rls /- [t txt]
+ where rls = [CSSRule ["#h1logo"] [("text-indent","-9999px"),
+ ("background", "url("++imgpath++") no-repeat;"),
+ ("width", "100%"),("height","60px")
+ ]]
+
+
+formTo :: String -> [CxML a] -> CxML a
+formTo actionUrl chs =
+ form!("method","post")!("action",actionUrl)
+ /- chs
+
+submitBtn lbl = button!("name","action")!("value","submit") /- [t lbl]
+
+
+
+
+
+{- from formerly RequestCtx.hs -}
+
+--yuiMenu = div^."yuimenu" // div^."bd" // [ul^."first-of-type" // "hello world"]
+
+--div^."yuimenu" // div^."bd" // ul^."first-of-type" // "hello world" -- yawn
+
+-- http://www.alistapart.com/articles/prettyaccessibleforms
+formSection nm contents = if null nm
+ then fieldset /- [ol /- contents]
+ else fieldset /- [legend /- [t nm],
+ ol /- contents]
+
+--setValFromCtx :: (a -> String) -> CxML a -> CxML a
+--setValFromCtx stLam (CxML (h,c,j))= CxML (\ctx-> map (add_attr "value" (stLam ctx)) $ h ctx, c,j )
+
+
diff --git a/Text/CxML/Output.hs b/Text/CxML/Output.hs
new file mode 100644
index 0000000..fc95215
--- /dev/null
+++ b/Text/CxML/Output.hs
@@ -0,0 +1,93 @@
+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,
+ "});"]
+-}
diff --git a/Text/CxML/Tags.hs b/Text/CxML/Tags.hs
new file mode 100644
index 0000000..36a68e0
--- /dev/null
+++ b/Text/CxML/Tags.hs
@@ -0,0 +1,97 @@
+module Text.CxML.Tags where
+
+import Text.CxML.Types
+
+-- | combinator to create tags
+tag :: String->CxML a
+tag nm = CxML (\_-> [HTag nm [] []],
+ [] ,
+ [] ,
+ [])
+
+-- used to be with no children but don't distinguish now
+itag :: String-> CxML a
+itag = tag
+
+---------------------------------------------------------
+-----Modified from module Text.XHtml.Strict.Elements-----
+---------------------------------------------------------
+
+abbr = tag "abbr"
+acronym = tag "acronym"
+address = tag "address"
+a = tag "a"
+area = itag "area"
+bdo = tag "bdo"
+big = tag "big"
+blockquote = tag "blockquote"
+body = tag "body"
+bold = tag "b"
+button = tag "button"
+br = itag "br"
+caption = tag "caption"
+cite = tag "cite"
+col = tag "col"
+colgroup = tag "colgroup"
+dd = tag "dd"
+dfn = tag "dfn"
+del = tag "del"
+dl = tag "dl"
+dt = tag "dt"
+em = tag "em"
+fieldset = tag "fieldset"
+form = tag "form"
+h1 = tag "h1"
+h2 = tag "h2"
+h3 = tag "h3"
+h4 = tag "h4"
+h5 = tag "h5"
+h6 = tag "h6"
+header = tag "head"
+hr = itag "hr"
+image = itag "img"
+input = itag "input"
+ins = tag "ins"
+italics = tag "i"
+keyboard = tag "kbd"
+label = tag "label"
+legend = tag "legend"
+li = tag "li"
+meta = itag "meta"
+noscript = tag "noscript"
+object = tag "object"
+ol = tag "ol"
+optgroup = tag "optgroup"
+option = tag "option"
+p = tag "p"
+param = itag "param"
+pre = tag "pre"
+quote = tag "q"
+sample = tag "samp"
+script = tag "script"
+dropdown = tag "select"
+small = tag "small"
+strong = tag "strong"
+style = tag "style"
+sub = tag "sub"
+sup = tag "sup"
+table = tag "table"
+tbody = tag "tbody"
+td = tag "td"
+textarea = tag "textarea"
+tfoot = tag "tfoot"
+th = tag "th"
+thead = tag "thead"
+base = itag "base"
+code = tag "code"
+div = tag "div"
+html = tag "html"
+link = tag "link"
+themap = tag "map"
+span = tag "span"
+title = tag "title"
+tr = tag "tr"
+tt = tag "tt"
+ul = tag "ul"
+var = tag "var"
+font = tag "font"
diff --git a/Text/CxML/Types.hs b/Text/CxML/Types.hs
new file mode 100644
index 0000000..f750d7f
--- /dev/null
+++ b/Text/CxML/Types.hs
@@ -0,0 +1,80 @@
+module Text.CxML.Types where
+
+-- | contextual markup - generates HTML as a function of a context of type a.
+-- also keep track of static CSS and JavaScript
+newtype CxML a = CxML (a->[HElem],[String],[StyleDecl],[JSDecl])
+
+-- non-contextual equivalent useful mainly for making type checker happy occasionally
+type NonCxML = CxML ()
+
+-- | HTML elements
+data HElem = HTag {- tagName -} String [Attr] [HElem]
+ | HText String
+
+type Attr = (String,String)
+
+-- | how to declare CSS & JavaScript
+type CssInlineDecl = (String {-id without prefix . -}, [(String,String)] {- css rules -})
+
+data StyleDecl = CSSRule [String] [(String,String)]
+ | CSSLink String -- specify a dependency on a CSS file (mostly hosted by Yahoo or us)
+
+data JSDecl = OnLoad String
+ | JSLink String -- specify a dependency on a JS file (mostly hosted by Yahoo or us)
+
+-- use a context to turn contextual into non-contextual markup
+runCxML :: CxML a -> a -> NonCxML
+runCxML (CxML (h,ts,c,j)) cx = CxML (\_->h cx,ts, c, j)
+
+-- concatenate two bits of contextual marker
+infixr 2 +++ -- combining Html
+(+++) :: CxML a -> CxML a -> CxML a
+(CxML (h1,ts1,c1,j1)) +++ (CxML (h2,ts2,c2,j2)) = CxML (\ctx->((h1 ctx)++(h2 ctx)), ts1++ts2, c1++c2, j1++j2)
+
+concatCxML :: [CxML a] -> CxML a
+concatCxML= foldr (+++) noElem
+
+-- | empty tag
+noElem = CxML (\_->[],[],[],[])
+
+-- | set the HTML children
+withChildren :: CxML a-> [CxML a]-> CxML a
+withChildren prnt chs = CxML (\ctx->addch ((htm prnt) ctx) $ concatMap (($ctx) . htm) chs,
+ (titleParts prnt),
+ (css prnt)++(concatMap css chs),
+ (js prnt)++(concatMap js chs))
+ where addch ((HTag tn ats oldch):_) newch = [HTag tn ats (oldch++newch)]
+
+withCtx :: (a->CxML a)->CxML a
+withCtx cxLam = CxML (\ctx->(htm (cxLam ctx) ctx), [], [], [])
+
+
+-- the non-overloaded withChildren operator
+infixl 5 /-
+
+(/-) :: CxML b -> [CxML b] -> CxML b
+(/-) p c = withChildren p c
+
+-- | access title parts
+titleParts (CxML (_,ts,_,_))= ts
+
+-- | access JavaScript ( static) part
+js (CxML (_,_,_,j))= j
+
+-- | access CSS ( static ) part
+css (CxML (_,_,c,_))= c
+
+-- | access html (dynamic) part
+htm (CxML (h,_,_,_))= h
+
+htmlPart cxml = CxML (\ctx->(htm cxml) ctx,[],[],[])
+
+modCx :: (b -> a) -> CxML a -> CxML b
+modCx f (CxML (h,ts,c,j)) = CxML (h . f, ts, c, j)
+
+modTitleParts :: ([String] -> [String]) -> CxML a -> CxML a
+modTitleParts f (CxML (h,ts,c,j)) = CxML (h, f ts, c, j)
+
+setTitle, addTitle :: String -> CxML a -> CxML a
+setTitle t = modTitleParts (\_ -> [t])
+addTitle t = modTitleParts (\ts -> ts ++ [t])
diff --git a/Text/YuiGrid.hs b/Text/YuiGrid.hs
new file mode 100644
index 0000000..3ff9839
--- /dev/null
+++ b/Text/YuiGrid.hs
@@ -0,0 +1,39 @@
+module Text.YuiGrid
+ (
+ HasLayoutHints, modLayoutHints,
+ GridElement, GridNode(..),
+ gridPage, fromGridNode, runBox, runBoxes,
+ setInFstSibling, resetInFstSibling,
+ addCss, resetCss, smallMarginBottomCSS, giveBorderCSS,
+ inMain, inHeader, inFooter, inLeftSidebar, inRightSidebar,
+ nearTop, nearBottom, weight,
+ setColumns, setColumnsVote, resetColumns, resetColumnsVote,
+ clearSides, nearLeft, nearRight, horizWeight,
+ toBox, fromBox, toContainer, fromContainer,
+ boxInMain, boxInHeader, boxInFooter, boxInLeftSidebar, boxInRightSidebar,
+ applyLayouts,
+ )
+where
+
+import Text.CxML (CxML, concatCxML, runCxML, showNonCxmlStrict)
+import Text.YuiGrid.LayoutHints
+import Text.YuiGrid.Grid
+import Text.YuiGrid.YGrid
+import Text.YuiGrid.YGridCxML
+
+type GridElement a = GridNode (CxML a)
+
+gridPage :: [GridElement a] -> CxML a
+gridPage bxs = pageToCxML (yGridPage YPW_950px bxs)
+
+fromGridNode :: GridElement a -> CxML a
+fromGridNode (Box cxml _) = cxml
+fromGridNode (Container cxmls _) = concatCxML $ map fromGridNode cxmls
+
+runBox :: GridElement a -> a -> GridElement ()
+runBox (Box cxml lhs) cx = Box (runCxML cxml cx) lhs
+runBox (Container gns lhs) cx = Container (runBoxes gns cx) lhs
+
+runBoxes :: [GridElement a] -> a -> [GridElement ()]
+runBoxes ges req = map (`runBox` req) ges
+
diff --git a/Text/YuiGrid/Grid.hs b/Text/YuiGrid/Grid.hs
new file mode 100644
index 0000000..1192dc5
--- /dev/null
+++ b/Text/YuiGrid/Grid.hs
@@ -0,0 +1,234 @@
+module Text.YuiGrid.Grid where
+
+import Data.Maybe (fromJust, fromMaybe, catMaybes)
+import Data.List (partition, maximumBy, sortBy)
+import Control.Monad (mplus)
+import Data.Ord (comparing)
+import Text.YuiGrid.LayoutHints
+
+data GridNode a = Box a LayoutHints
+ | Container [GridNode a] LayoutHints
+
+instance HasLayoutHints (GridNode a) where
+ --modLayoutHints :: (LayoutHints -> LayoutHints) -> GridNode a -> GridNode a
+ modLayoutHints f (Box x lhs) = Box x (f lhs)
+ modLayoutHints f (Container gns lhs) = Container gns (f lhs)
+
+instance Functor GridNode where
+ fmap f (Box x lhs) = Box (f x) lhs
+ fmap f (Container gns lhs) = Container (map (fmap f) gns) lhs
+
+-- other hints that might be implemented in the future
+-- | ClearLeft | ClearRight | MinHeight Int | MaxHeight Int | MinWidth Int | MaxWidth Int
+layoutHints :: GridNode a -> LayoutHints
+layoutHints (Box _ lhs) = lhs
+layoutHints (Container _ lhs) = lhs
+
+addChildren :: GridNode a -> [GridNode a] -> GridNode a
+addChildren gn [] = gn
+addChildren (Container gns lhs) gns' = Container (gns ++gns') lhs
+addChildren (Box x lhs) gns' = Container (toBox x : gns') lhs
+
+-----------------------------
+-- in first sibling ---------
+-----------------------------
+moveSiblings :: [GridNode a] -> [GridNode a]
+moveSiblings [] = []
+moveSiblings (gn:gns) = moveSiblings' (resetInFstSibling gn) gns
+
+moveSiblings' :: GridNode a -> [GridNode a] -> [GridNode a]
+moveSiblings' gn gns = addChildren gn (map resetInFstSibling toBeMovedGns) : notToBeMovedGns
+ where
+ (toBeMovedGns, notToBeMovedGns) = partition (inFstSibling . layoutHints) gns
+
+-----------------------------
+-- page area calculation ----
+-----------------------------
+
+gridNodesByPageArea :: [GridNode a] -> (
+ [GridNode a], -- inMain nodes
+ [GridNode a], -- inHeader nodes
+ [GridNode a], -- inFooter nodes
+ [GridNode a], -- inLeftSidebar nodes
+ [GridNode a] -- inRightSidebar nodes
+ )
+gridNodesByPageArea gns = (
+ lookupGridNodes InMain,
+ lookupGridNodes InHeader,
+ lookupGridNodes InFooter,
+ lookupGridNodes InLeftSidebar,
+ lookupGridNodes InRightSidebar
+ )
+ where
+ --lookupGridNodes :: PageAreaHint -> [GridNode a]
+ lookupGridNodes hint = fromMaybe [] (lookup hint classifiedGridNodes)
+ --classifiedGridNodes :: [(PageAreaHint,[GridNode a])]
+ classifiedGridNodes = partitionByEq pageArea gns
+
+pageArea :: GridNode a -> PageAreaHint
+pageArea = (fromMaybe InMain) . pageAreaHint'
+
+pageAreaHint' :: GridNode a -> Maybe PageAreaHint
+pageAreaHint' (Box _ lhs) = pageAreaHint lhs
+pageAreaHint' (Container gns lhs) = pageAreaHint lhs `mplus` (occurresMost . catMaybes . map pageAreaHint') gns
+
+
+-----------------------------------
+-- vertical layout calculation ----
+-----------------------------------
+
+-- must be applied to all containers, not just top level containers. It is not recursive.
+gridNodesVerticalPartitions :: [GridNode a] -> [[GridNode a]]
+gridNodesVerticalPartitions = map snd . sortByFst . partitionByEq (verticalHint . layoutHints) . moveSiblings
+
+------------------------------------------
+-- columns and clearsides calculation ----
+------------------------------------------
+splitClearSides :: [[GridNode a]] -> [[GridNode a]]
+splitClearSides = splitTruesAlone ((==ClearSides) . horizontalHint . layoutHints)
+
+splitTruesAlone :: (a->Bool) -> [[a]] -> [[a]]
+splitTruesAlone f = concat . map (splitTruesAlone' f)
+
+{-
+[[top], [bot]]
+
+[[[topCs1],[topCs2],[topothers]], [[botCs1],[botCs2],[botothers]] ]
+[[topCs1],[topCs2],[topothers], [botCs1],[botCs2],[botothers] ]
+
+-}
+
+splitTruesAlone' :: (a->Bool) -> [a] -> [[a]]
+splitTruesAlone' f gns = case withFalse of
+ [] -> withTrueLists
+ _ -> withTrueLists ++ [withFalse]
+ where
+ (withTrue, withFalse) = partition f gns
+ withTrueLists = map (:[]) withTrue
+
+gridNodesByColumns :: Maybe Int -> [GridNode a] -> [[GridNode a]]
+gridNodesByColumns colSpec gns
+ = if cols == 1
+ then [gns] -- dont care about horizontal layouts since all of them go in 1 column
+ else (balancedGroups cols . concat . gridNodesHorizontalPartitions) gns
+ where
+ cols = columns colSpec gns
+
+gridNodesHorizontalPartitions :: [GridNode a] -> [[GridNode a]]
+gridNodesHorizontalPartitions = map snd . sortByFst . partitionByEq (horizontalHint . layoutHints)
+
+
+columnsQtyOpts = [1,2,3,4]
+defaultColumnQty = 1
+
+-- select the number of columns that will be used for a subset of the children of a container
+-- The first argument, is the container specification of columns
+-- the second argument is a subset of the children of the container to layout
+columns :: Maybe Int -> [GridNode a] -> Int
+columns colSpec gns = fromMaybe (columnsQtyElection gns) colSpec
+
+-- uses valid votes from children to select from columnsQtyOpts or the default if there are no valid votes
+columnsQtyElection :: [GridNode a] -> Int
+columnsQtyElection = selectColumnQtyOption . catMaybes . map (columnsQtyVote . layoutHints)
+
+selectColumnQtyOption :: [Int] -> Int
+selectColumnQtyOption [] = defaultColumnQty
+selectColumnQtyOption votes = (head . sortOptionsByVotes columnsQtyOpts) votes
+
+sortOptionsByVotes :: [Int] -> [Int] -> [Int]
+sortOptionsByVotes opts votes
+ = sortBy (comparing (distance votes)) opts
+ where
+ distance :: [Int] -> Int -> Int
+ distance vs opt = sum $ map (sqr . (opt-) ) vs
+ sqr x = x*x
+
+
+--------------------------------------
+------ More GridNode combinators -----
+--------------------------------------
+
+boxInMain, boxInHeader, boxInFooter, boxInLeftSidebar, boxInRightSidebar :: a -> GridNode a
+boxInMain = inMain . toBox
+boxInHeader = inHeader . toBox
+boxInFooter = inFooter . toBox
+boxInLeftSidebar = inLeftSidebar . toBox
+boxInRightSidebar = inRightSidebar . toBox
+
+-- unsafe
+fromBox :: GridNode a -> a
+fromBox (Box x _) = x
+
+toBox :: a -> GridNode a
+toBox x = Box x blankHints
+
+fromContainer :: GridNode a -> [GridNode a]
+fromContainer (Container xs _) = xs
+
+toContainer :: [GridNode a] -> GridNode a
+toContainer xs = Container xs blankHints
+
+------------------------------
+------ Utility functions -----
+------------------------------
+
+{- | Separates a list of elements in n lists of list of elements (or n groups), being n the value of the first arg.
+ The number of elements in the lists produced is balanced.
+ As the number of elements in the orginal group might not be a multiple of n, some lists produced will have one more elements
+ than others
+
+ Some examples of the usage of the function:
+
+ balancedGroups 3 [1..9] = [[1,2,3],[4,5,6],[7,8,9]]
+ balancedGroups 3 [1..10] = [[1,2,3,4],[5,6,7],[8,9,10]]
+ balancedGroups 3 [1..11] = [[1,2,3,4],[5,6,7,8],[9,10,11]]
+ balancedGroups 3 [1..12] = [[1,2,3,4],[5,6,7,8],[9,10,11,12]]
+
+-}
+
+balancedGroups :: Int -> [a] -> [[a]]
+balancedGroups n xs = bigGroups ++ smallGroups
+ where
+ (bigGroups, xs') = iterateNTimes bigGroupsQty (splitAt elemsQtyMax) xs
+ (smallGroups, xs'') = iterateNTimes smallGroupsQty (splitAt elemsQtyMin) xs'
+ elemsQtyMin = xsLength `div` n
+ elemsQtyMax = elemsQtyMin + 1
+ bigGroupsQty = xsLength `mod` n
+ smallGroupsQty = n - bigGroupsQty
+ xsLength = length xs
+
+
+iterateNTimes :: Int -> (a -> (b,a)) -> a -> ([b],a)
+iterateNTimes 0 f seed = ([],seed)
+iterateNTimes n f seed = (x:xs, seed'')
+ where
+ (x, seed') = f seed
+ (xs, seed'') = iterateNTimes (n-1) f seed'
+
+
+sortByFst :: Ord a => [(a,b)] -> [(a,b)]
+sortByFst = sortBy (comparing fst)
+
+partitionByEq :: Eq b => (a -> b) -> [a] -> [(b,[a])]
+partitionByEq f = partitionByEq' . map (\x->(f x, x))
+
+partitionByEq' :: Eq b => [(b,a)] -> [(b,[a])]
+partitionByEq' [] = []
+partitionByEq' ((y,x): ysxs)
+ = (y, x:inClassY) : partitionByEq' ysxs'
+ where
+ (withY, ysxs') = partition ( (==y) . fst) ysxs
+ inClassY = map snd withY
+
+occurrencies :: Eq a => [a] -> [(a,Int)]
+occurrencies [] = []
+occurrencies (x:xs) = let (equalsToX,others) = partition (==x) xs
+ in (x, 1 + length equalsToX) : occurrencies others
+
+occurresMost :: Eq a => [a] -> Maybe a
+occurresMost xs = case occurrencies xs of
+ [] -> Nothing
+ howManies -> (Just . fst . maximumBy cmp) howManies
+ where
+ cmp (_,x) (_,y) = compare x y
+
diff --git a/Text/YuiGrid/LayoutHints.hs b/Text/YuiGrid/LayoutHints.hs
new file mode 100644
index 0000000..2474eb8
--- /dev/null
+++ b/Text/YuiGrid/LayoutHints.hs
@@ -0,0 +1,92 @@
+module Text.YuiGrid.LayoutHints where
+
+import Text.CxML (CssInlineDecl)
+
+data LayoutHints = LayoutHints {
+ inFstSibling :: Bool,
+ cssHints :: [CssInlineDecl],
+ pageAreaHint :: Maybe PageAreaHint,
+ verticalHint :: VerticalHint,
+ columnsQty :: Maybe Int, -- to be used in containers only.
+ columnsQtyVote :: Maybe Int,
+ horizontalHint :: HorizontalHint
+ }
+
+data PageAreaHint = InMain | InHeader | InFooter | InLeftSidebar | InRightSidebar
+ deriving Eq
+
+data VerticalHint = NearTop | Weight Float | NearBottom
+ deriving (Eq, Ord)
+
+data HorizontalHint = ClearSides | NearLeft | HorizWeight Float | NearRight
+ deriving (Eq, Ord)
+
+blankHints :: LayoutHints
+blankHints = LayoutHints False [] Nothing (Weight 0) Nothing Nothing (HorizWeight 0)
+
+
+class HasLayoutHints a where
+ modLayoutHints :: (LayoutHints -> LayoutHints) -> a -> a
+
+setInFstSibling, resetInFstSibling :: HasLayoutHints a => a -> a
+setInFstSibling = modLayoutHints (\lhs -> lhs {inFstSibling = True} )
+resetInFstSibling = modLayoutHints (\lhs -> lhs {inFstSibling = False} )
+
+addCss :: HasLayoutHints a => CssInlineDecl -> a -> a
+addCss (cssId, cssRls) = modLayoutHints (\lhs -> lhs {cssHints = (cssId, cssRls):cssHints lhs} )
+
+resetCss :: HasLayoutHints a => a -> a
+resetCss = modLayoutHints (\lhs -> lhs {cssHints = [] } )
+
+setPageAreaHint :: HasLayoutHints a => PageAreaHint -> a -> a
+setPageAreaHint pahint = modLayoutHints (\lhs -> lhs {pageAreaHint = Just pahint})
+
+setVerticalHint :: HasLayoutHints a => VerticalHint -> a -> a
+setVerticalHint vhint = modLayoutHints (\lhs -> lhs {verticalHint = vhint})
+
+setHorizontalHint :: HasLayoutHints a => HorizontalHint -> a -> a
+setHorizontalHint hhint = modLayoutHints (\lhs -> lhs {horizontalHint = hhint})
+
+inMain, inHeader, inFooter, inLeftSidebar, inRightSidebar :: HasLayoutHints a => a -> a
+inMain = setPageAreaHint InMain
+inHeader = setPageAreaHint InHeader
+inFooter = setPageAreaHint InFooter
+inLeftSidebar = setPageAreaHint InLeftSidebar
+inRightSidebar = setPageAreaHint InRightSidebar
+
+nearTop, nearBottom :: HasLayoutHints a => a -> a
+nearTop = setVerticalHint NearTop
+nearBottom = setVerticalHint NearBottom
+
+weight :: HasLayoutHints a => Float -> a -> a
+weight = setVerticalHint . Weight
+
+setColumns, setColumnsVote :: HasLayoutHints a => Int -> a -> a
+setColumns n = modLayoutHints (\lhs -> lhs {columnsQty = Just n})
+setColumnsVote n = modLayoutHints (\lhs -> lhs {columnsQtyVote = Just n})
+
+resetColumns, resetColumnsVote :: HasLayoutHints a => a -> a
+resetColumns = modLayoutHints (\lhs -> lhs {columnsQty = Nothing})
+resetColumnsVote = modLayoutHints (\lhs -> lhs {columnsQtyVote = Nothing})
+
+clearSides, nearLeft, nearRight :: HasLayoutHints a => a -> a
+clearSides = setHorizontalHint ClearSides
+nearLeft = setHorizontalHint NearLeft
+nearRight = setHorizontalHint NearRight
+
+horizWeight :: HasLayoutHints a => Float -> a -> a
+horizWeight = setHorizontalHint . HorizWeight
+
+
+applyLayouts :: HasLayoutHints a => [a -> a] -> a -> a
+applyLayouts = foldl (.) id
+
+
+-- Combinators that set specific CSS rules with layout hints
+
+smallMarginBottomCSS, giveBorderCSS :: HasLayoutHints a => a -> a
+smallMarginBottomCSS = addCss smallMarginBottomCSSRls
+giveBorderCSS = addCss giveBorderCSSRls
+
+smallMarginBottomCSSRls = ("smallMarginBottom", [("margin-bottom","1em")])
+giveBorderCSSRls = ("giveBorder", [("border","1px solid black")])
diff --git a/Text/YuiGrid/YGrid.hs b/Text/YuiGrid/YGrid.hs
new file mode 100644
index 0000000..15edee2
--- /dev/null
+++ b/Text/YuiGrid/YGrid.hs
@@ -0,0 +1,84 @@
+module Text.YuiGrid.YGrid where
+
+import Text.CxML (CssInlineDecl)
+
+import Text.YuiGrid.LayoutHints
+import Text.YuiGrid.Grid
+
+data YPage a = YPage {
+ pageWidth :: YPageWidth,
+ headerBlock :: [YGrid a],
+ mainBlock :: [YGrid a],
+ footerBlock :: [YGrid a],
+ sidebarBlock :: Maybe (YTemplate, [YGrid a])
+ }
+
+-- body is made from mainBlock and sidebarBlock
+-- if there are no header and footer, just blocks can be rendered (no header, no footer, no body)
+-- if there is no sidebar, blocks don't need to be render, but header and body and footer might need to be rendered
+
+data YPageWidth = YPW_750px -- #doc - 750px centered (good for 800x600)
+ | YPW_950px -- #doc2 - 950px centered (good for 1024x768)
+ | YPW_100perc -- #doc3 - 100% fluid (good for everybody)
+ | YPW_974px -- #doc4 - 974px fluid (good for 1024x768)
+ -- YPW_Custom -- #doc-custom - an example of a custom page width
+
+data YTemplate = SidebarLeft_160px | SidebarLeft_180px | SidebarLeft_300px
+ | SidebarRight_180px | SidebarRight_240px | SidebarRight_300px
+
+data YGrid a = YGrid_SimpleBox a [CssInlineDecl]
+ | YGrid_ComplexBox [YGrid a] [CssInlineDecl]
+ | YGrid_1Col [YGrid a]
+ | YGrid_2Cols Y_2ColsType [YGrid a] [YGrid a]
+ | YGrid_3Cols [YGrid a] [YGrid a] [YGrid a]
+ -- .yui-gb - Special grid, 1/3 - 1/3 - 1/3
+
+data Y_2ColsType = Y_1o2_1o2 -- .yui-g - Standard half grid (and nest again for quarters)
+ | Y_2o3_1o3 -- .yui-gc - Special grid, 2/3 - 1/3
+ | Y_1o3_2o3 -- .yui-gd - Special grid, 1/3 - 2/3
+ | Y_3o4_1o4 -- .yui-ge - Special grid, 3/4 - 1/4
+ | Y_1o4_3o4 -- .yui-gf - Special grid, 1/4 - 3/4
+
+
+-- for the recursive YGrid cases, in case that any of the YGrid children is not subdivided, it will be rendered as a unit,
+-- in case it is subdivided, it will be rendered as a grid.
+-- the first child of multi-column grids will be annotated with first, it doesn't matter whether is a unit or grid itself.
+
+
+yGridPage :: YPageWidth -> [GridNode a] -> YPage a
+yGridPage pageWidth gns =
+ case (leftSidebarGNodes, rightSidebarGNodes) of
+ ([],[]) -> YPage pageWidth yHeader yBody yFooter Nothing -- no sidebars
+ (_,[]) -> YPage pageWidth yHeader yBody yFooter (Just (SidebarLeft_160px, yLeftSidebar)) -- left sidebar using template
+ ([],_) -> YPage pageWidth yHeader yBody yFooter (Just (SidebarRight_180px, yRightSidebar)) -- right sidebar using template
+ _ -> YPage pageWidth yHeader yBodyWithRightSidebar yFooter (Just (SidebarLeft_160px, yLeftSidebar))
+ -- left sidebar using template, right encoded in body
+ where
+ (mainGNodes, headerGNodes, footerGNodes, leftSidebarGNodes, rightSidebarGNodes) = gridNodesByPageArea gns
+ yHeader = yGridStack headerGNodes
+ yFooter = yGridStack footerGNodes
+ yLeftSidebar = yGridStack leftSidebarGNodes
+ yRightSidebar = yGridStack rightSidebarGNodes
+ yBody = yGridStack mainGNodes
+ yBodyWithRightSidebar = [YGrid_2Cols Y_3o4_1o4 yBody yRightSidebar]
+ yGridStack = yGrids Nothing
+
+yGrid :: GridNode a -> YGrid a
+yGrid (Box x lhs) = YGrid_SimpleBox x (cssHints lhs)
+yGrid gn@(Container gns lhs) = YGrid_ComplexBox (yGrids (columnsQty lhs) gns) (cssHints lhs)
+
+yGrids :: Maybe Int -> [GridNode a] -> [YGrid a]
+yGrids colSpec = map (yGridCols . gridNodesByColumns colSpec) . splitClearSides . gridNodesVerticalPartitions
+
+yGridCols :: [[GridNode a]] -> YGrid a
+yGridCols cols = yGridCols' (map (map yGrid) cols)
+
+yGridCols' :: [[YGrid a]] -> YGrid a
+yGridCols' [col1] = YGrid_1Col col1
+yGridCols' [col1,col2] = yGrid_2Col col1 col2
+yGridCols' [col1,col2,col3] = YGrid_3Cols col1 col2 col3
+yGridCols' [col1,col2,col3,col4] = yGrid_2Col [yGrid_2Col col1 col2] [yGrid_2Col col3 col4]
+yGridCols' cols = YGrid_1Col (concat cols)
+
+yGrid_2Col = YGrid_2Cols Y_1o2_1o2
+
diff --git a/Text/YuiGrid/YGridCxML.hs b/Text/YuiGrid/YGridCxML.hs
new file mode 100644
index 0000000..df28245
--- /dev/null
+++ b/Text/YuiGrid/YGridCxML.hs
@@ -0,0 +1,115 @@
+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_URL_Dir = "" -- Set to use offline (during development), the file needs to be located properly in the file system.
+ 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]
+--FIXME: there is space for optimization here or in YGrid, i.e.:
+--(YGrid_ComplexBox c1 csss)
+--or
+--(YGrid_1Col c1) with c1 being singleton. also, might happen to have empty cols?
+
+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
+ --optimization cases: avoid unecessary <div class="yui-u ..."> when the column has one element
+yCol ctx col = yMaybeBoxDiv ctx [] (map yGridToCxML col)
+
+yMaybeBoxDiv :: Context -> [CssInlineDecl] -> [CxML a] -> CxML a
+--yMaybeBoxDiv NonCtx [] cxmls = concatCxML cxmls
+ -- optimization: div not generated for the box since there are no CSS rules
+ -- and it is not a column
+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" -- Standard half grid (and nest again for quarters)
+yGrdClass' (YGrid_2Cols Y_2o3_1o3 _ _) = "yui-gc" -- Special grid, 2/3 - 1/3
+yGrdClass' (YGrid_2Cols Y_1o3_2o3 _ _) = "yui-gd" -- Special grid, 1/3 - 2/3
+yGrdClass' (YGrid_2Cols Y_3o4_1o4 _ _) = "yui-ge" -- Special grid, 3/4 - 1/4
+yGrdClass' (YGrid_2Cols Y_1o4_3o4 _ _) = "yui-gf" -- Special grid, 1/4 - 3/4
+yGrdClass' (YGrid_3Cols _ _ _) = "yui-gb" -- .yui-gb - Special grid, 1/3 - 1/3 - 1/3
+yGrdClass' _ = "" -- just in case some case was forgotten
+
+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]
+
diff --git a/yuiGrid.cabal b/yuiGrid.cabal
new file mode 100644
index 0000000..3f63a73
--- /dev/null
+++ b/yuiGrid.cabal
@@ -0,0 +1,34 @@
+Name: yuiGrid
+Version: 0.1
+Synopsis: Grids defined by layout hints and implemented on top of Yahoo grids.
+Description: The grid is specified by boxes, containers and hints telling how these boxes and containers should be laid out. The hints also
+ include CSS specifications. Everything is rendered to html using Yahoo grids through the contextual html combinators
+ (see yahoo grids in <http://developer.yahoo.com/yui/grids >).
+ The contextual html combinators are also implemented in this package (called CxML here). They allow to keep track of input context
+ and output html parts like inline CSSs, JSs, etc.
+Category: Web
+License: OtherLicense
+License-file: LICENSE
+Author: RedNucleus (see AUTHORS)
+Maintainer: sergio.urinovsky@gmail.com
+Stability: Experimental
+Build-Type: Simple
+Build-Depends: base
+Exposed-modules: Text.CxML,
+ Text.YuiGrid
+Other-modules: Text.CxML.NavList,
+ Text.CxML.HTML,
+ Text.CxML.CSS,
+ Text.CxML.JS,
+ Text.CxML.Tags,
+ Text.CxML.Output,
+ Text.CxML.Types,
+ Text.YuiGrid.LayoutHints,
+ Text.YuiGrid.Grid,
+ Text.YuiGrid.YGrid,
+ Text.YuiGrid.YGridCxML
+
+Extra-source-files: AUTHORS,
+ Example/README, Example/Makefile,
+ Example/GridExample.hs,
+ Example/images/header.gif