simple-css-0.0.1: example/Main.hs

import Language.Css.Syntax
import Language.Css.Build

import qualified Language.Css.Build.Idents as C

import SimpleCss
import SimpleCss.Tricks

import Text.Blaze (Html)
import Control.Applicative

import Data.Char

-- generates litle blog-site in current directory
--
-- css.css  - css file
--
-- Home.html, Blog.html, About.html, Contact.html - pages

---------------------------------------------------
--
-- parameters

-- colors 

globalBkgCol = white -- cword "#b6ceff"
homeCol   = black --  cword "#1936ca"
blogCol   = blue -- cword "#4d67d8"
aboutCol  = red -- cword "#9db1ec"
contactCol = green -- cword "#e2f1fe"
menuTextCol = white 

-- borders

bttnBordWidth = px 25


----------------------------------------------------
-- pages

data Page = Home | Blog | About | Contact
        deriving (Show)

pageColor :: Page -> Expr
pageColor x = 
    case x of
        Home -> homeCol
        Blog -> blogCol
        About -> aboutCol
        Contact -> contactCol

pageLink :: Page -> String
pageLink = ( ++ ".html") . show 

titles = map show pages
pages  = [Home, Blog, About, Contact]

------------------------------------------------------
-- elements

-- menu

menus :: [Page] -> [Css Html]
menus = tabs vmenu <$> map (box . activeBttn) 
                   <*> map (box . passiveBttn) 
                   <*> map menuLinks 
    
menuLinks :: Page -> Css Html
menuLinks = a <$> pageLink <*> map toLower . show

activeBttn :: Page -> [Decl]
activeBttn x = border [left] C.solid bttnBordWidth (pageColor x) 
            ++ bttn (pageColor x) x

passiveBttn :: Page -> [Decl]
passiveBttn = bttn globalBkgCol

bttn :: Expr -> Page -> [Decl]
bttn col x = border [right] C.solid bttnBordWidth col 
          ++ padding sides (px 10)
          ++ brick menuTextCol (pageColor x)

-- header
        
pageHeader :: Page -> Css Html
pageHeader x = dot ([C.textAlign <:> C.center] 
            ++ (color $ pageColor x)) $ h1 $ show x

-- content

pageContent :: Page -> Css Html
pageContent x =
    case x of
        Home -> text 1000
        Blog -> vcat $ zipWith blogItem 
                    ["22 september", "13 september", "2 spetember", "26 august"] 
                    [500, 1000, 500, 150]
        About -> text 3000
        Contact -> text 10000

blogItem d n = vcat [st $ h3 d, text n]
        where st = dot $ (padding sides $ px 5 ) 
                      ++ (brick menuTextCol $ pageColor Blog)  

text :: Int -> Css Html
text n = dot (padding [bottom] (pct 5) 
            ++ margin sides (pct 5)) $ 
    p $ take n $ cycle "once upon a text "

-- footer

addFooter :: Expr -> Css a -> Css a -> Css a
addFooter h content footer = vcat [ stCont $ div' $ content, stFooter $ div' footer ]
    where stCont = dot (height (pct 100) ++ [C.minHeight <:> pct 100, C.position <:> C.relative]) 
          stFooter = dot (width (pct 100) ++ [C.position <:> C.absolute, C.bottom <:> int 0, C.height <:> h])


footer x = dot (
           borderNone sides 
        ++ margin sides (int 0) 
        ++ brick menuTextCol (pageColor x)
        ++ (padding sides $ px 10)) $ p "simple-css : example"


--------------------------------------------------------------------
-- putting it all together

htmls :: Css Html -> Page -> Css Html
htmls m p = vcat [
                footer p,
                dot ((margin sides $ int 0) ++ borderNone sides) $
                leftContent pct 20 m $ addBorder $ vcat [pageHeader p, pageContent p]]
    where addBorder = dot $ (margin [left] (px 20))

-------------------------------------------------------------------
-- global style sheets

bodyStyle = ruleSets [
    ident "body" $ (margin sides $ int 0) 
                ++ (borderNone sides) 
                ++  bkgColor globalBkgCol]

-------------------------------------------------------------------
-- printing

res = zipWith htmls (menus pages) pages

main = writeBlazeCss "css.css" bodyStyle $ zip (initHtmls titles) res