simple-css-0.0.3: 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  - style sheets
--
-- Home.html, Blog.html, About.html, Contact.html - pages

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

-- colors 

menuCol = cword "#4370b5"
menuBorderCol = cword "#3c5b88"

globalBkgCol = cword "#b7cff3"
homeCol     = menuCol 
blogCol     = menuCol 
aboutCol    = menuCol 
contactCol  = menuCol
menuTextCol = white 

-- borders

bttnBorderWidth = 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 . (uncurry activeBttn)  )
                    <*> map (box . (uncurry passiveBttn) )
                    <*> map (menuLinks . snd))
        . zip rads

-- different border-radius values for menu
rads = [(20, 0), (0, 0), (0, 0), (0, 20)]

menuLinks :: Page -> Css Html
menuLinks = a <$> pageLink <*> map toLower . show

activeBttn :: (Int, Int) -> Page -> [Decl]
activeBttn r x = 
               padding [left] bttnBorderWidth
            ++ bttn r (pageColor x) x

passiveBttn :: (Int, Int) -> Page -> [Decl]
passiveBttn r = bttn r globalBkgCol

bttn :: (Int, Int) -> Expr -> Page -> [Decl]
bttn (tr, br) col x = border [top, bottom, right] C.solid (px 1) menuBorderCol 
          ++ border [left] C.solid (px 5) menuCol
          ++ margin [bottom] (px 3)        
          ++ margin [right] (px 40)
          ++ padding [top, bottom] (px 10)
          ++ borderRadius [int 0, px tr, px br, int 0]
          ++ brick menuTextCol (pageColor x)

-- header
        
pageHeader :: Page -> Css Html
pageHeader x = dot ([C.textAlign <:> C.center] 
            ++ (color menuBorderCol)) $ 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 $  borderRadius [px 5, int 0, int 0, px 5]
                       ++ (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 (menuBorderCol)
        ++ (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 (dot (margin [top] $ px 25) 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