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