packages feed

clevercss (empty) → 0.1

raw patch · 8 files changed

+1449/−0 lines, 8 filesdep +basedep +haskell98dep +mtlbuild-type:Customsetup-changed

Dependencies added: base, haskell98, mtl, parsec

Files

+ CCMain.hs view
@@ -0,0 +1,67 @@+------------------------------------------------------------------------------------------+-- CleverCSS in Haskell, (c) 2007 Georg Brandl. Licensed under the BSD license.+--+-- Main module: command-line interface.+------------------------------------------------------------------------------------------ ++module Main (main) where++import Control.Monad (when)+import Data.List (findIndices)+import System+import System.Console.GetOpt+import System.IO++import Text.CSS.CleverCSS++-- read an option definition from a command line option+readDef arg = case span (/= '=') arg of+                (_,    "")  -> error "invalid variable definition, must be name=value"+                (_,    "=") -> error "empty variable value"+                (name, val) -> (name, tail val)++optdescr = [Option "D" [] (ReqArg readDef "name=value") "define a variable",+            Option "h" ["help"] (NoArg ("help","")) "print this help message"]++help errs = do+  pname <- getProgName+  when ((not.null) errs) $ putStrLn $ concat errs+  putStrLn (usageInfo ("Usage: " ++ pname ++ " [opts] [file ...]\n\+          \\n\+          \With file names, read these and convert them to CSS files.\n\+          \The output file name is determined by stripping the input\n\+          \file names' extensions and adding `.css'. Existing files are\n\+          \overwritten.\n\+          \Without file names, read from stdin and write to stdout.\n\n\+          \Options:\n") optdescr)++main :: IO ()+main = do+  rawargs <- getArgs+  let (defs, args, errs) = getOpt Permute optdescr rawargs+  if (not.null) errs || ("help","") `elem` defs then help errs else+    case length args of+      0 -> process getContents "stdin" stdout defs >> return ()+      _ -> mapM_ (processFile defs) args+  where+    processFile defs filename = do+         let outfilename = case findIndices (=='.') filename of+                             [] -> filename ++ ".css"+                             is -> take (last is) filename ++ ".css"+         if outfilename == filename then+           fail $ "Input and output filenames are equal: " ++ filename+           else do+             outfile <- openFile outfilename WriteMode+             result <- process (readFile filename) filename outfile defs+             hClose outfile+             when result $ putStr $+                    "Converted file " ++ filename ++ " to " ++ outfilename ++ ".\n"+    process inaction filename outfile defs = do+         input <- inaction+         case cleverCSSConvert filename input defs of+           Left err  -> do+             hPutStr stderr $ "While processing " ++ filename ++ ":\n" ++ err ++ "\n"+             return False+           Right out -> do+             hPutStr outfile out+             return True
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) by Georg Brandl. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * The names of the contributors may not be used to endorse or
+      promote products derived from this software without specific
+      prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ Text/CSS/CleverCSS.hs view
@@ -0,0 +1,477 @@+------------------------------------------------------------------------------------------+-- CleverCSS in Haskell, (c) 2007 Georg Brandl. Licensed under the BSD license.+--+-- CleverCSS module: main parsing and evaluation.+--+-- TODO: properly parse selectors before splitting them+------------------------------------------------------------------------------------------ +{-# LANGUAGE PatternGuards #-}++module Text.CSS.CleverCSS (cleverCSSConvert) where++import Control.Monad.Error+import Control.Monad.RWS+import Data.Char (toUpper, toLower)+import Data.List (findIndex)+import Text.Printf (printf)+import Text.ParserCombinators.Parsec hiding (newline)+import qualified Data.Map as Map++import Text.CSS.CleverCSSUtil++css_functions = ["url", "attr", "counter"] -- rgb() is special++------------------------------------------------------------------------------------------+-- "AST" for clevercss templates++type CSSNumber = (Rational, String)  -- number, unit+type CSSColor = Either String Color  -- color name or RGB+data AssignType = Always | IfNotAssigned  deriving Eq++data Topl = Assign !AssignType !Line !String [Expr]+          | Import !Line [Expr]+          | Block  !Line ![String] [Item]+            deriving Eq+data Item = Property !Line !String [Expr]+          | SubBlock !Line ![String] [Item]+          | SubGroup !Line !String [Item]+            deriving Eq+data Expr = Plus Expr Expr | Minus Expr Expr+          | Mul Expr Expr | Divide Expr Expr | Modulo Expr Expr+          | ExprListCons Expr Expr | ExprList [Expr] | Subseq [Expr]+          | Call Expr !String (Maybe Expr)+          | Var !String | Bare !String | String !String | CSSFunc !String Expr+          | Number !Rational | Dim !CSSNumber | Color !CSSColor | Rgb Expr Expr Expr+          | Error !String+            deriving Eq++instance Show Topl where+  show (Assign Always _ name exprs) = name ++ " = " ++ joinShow " " exprs+  show (Assign IfNotAssigned _ name exprs) = name ++ " ?= " ++ joinShow " " exprs+  show (Import _ exprs) = "@import " ++ joinShow " " exprs+  show (Block _ sels items) = (joinStr ", " sels) ++ ":\n" +++                            unlines (map ("  "++) (map show items))++instance Show Item where+  show (Property _ name exprs) = name ++ ": " ++ joinShow " " exprs+  show (SubGroup _ name items) = name ++ "->\n" +++                                 unlines (map ("    "++) (map show items))+  show (SubBlock _ sels items) = (joinStr ", " sels) ++ ":\n" +++                                 unlines (map ("  "++) (map show items))++instance Show Expr where+  -- things that shouldn't remain when evaluated+  show (Plus a b)          = printf "<Plus %s %s>" (show a) (show b)+  show (Minus a b)         = printf "<Minus %s %s>" (show a) (show b)+  show (Mul a b)           = printf "<Mul %s %s>" (show a) (show b)+  show (Divide a b)        = printf "<Divide %s %s>" (show a) (show b)+  show (Modulo a b)        = printf "<Modulo %s %s>" (show a) (show b)+  show (ExprListCons a b)  = printf "<ExprListCons %s %s>" (show a) (show b)+  show (Call e n Nothing)  = printf "<Call %s.%s()>" (show e) n+  show (Call e n (Just a)) = printf "<Call %s.%s(%s)>" (show e) n (show a)+  show (Var a)             = printf "<Var %s>" a+  show (Rgb r g b)         = printf "<Rgb %s %s %s>" (show r) (show g) (show b)+  show (Error e)           = printf "<Error: %s>" e+  -- things that can remain and need to be pretty-printed+  show (ExprList l)        = joinShow ", " l+  show (Subseq l)          = joinShow " " l+  show (String s)          = cssShow s+  show (Number n)          = show (fromRational n)+  show (Dim (n, u))        = show (fromRational n) ++ u+  show (CSSFunc name args) = name ++ "(" ++ show args ++ ")"+  show (Color (Left n))    = n+  show (Color (Right (r,g,b))) = case Map.lookup (r,g,b) reverse_colors of+                                   Just name -> name +                                   Nothing -> printf "#%02x%02x%02x" r g b+  show (Bare s)            = s++------------------------------------------------------------------------------------------+-- the tokenizer and parser++-- helpers for toplevel and expression parsers+nl           = char '\n' <?> "end of line"+ws           = many (char ' ') <?> "whitespace"+comment      = string "//" >> many (noneOf "\n") <?> "comment"+wscomment    = ws >> option "" (try comment)+emptyLine    = wscomment >> nl <?> "empty line"+-- a newline always consumes empty lines too  -- different from many1 emptyLine!+newline      = emptyLine >> many (try emptyLine) <?> "newline"+pws parser   = parser ~>> wscomment+-- a CSS identifier+ident        = (pws $ try $ (perhaps $ char '-') ++++                      ((char '_' <|> letter <|> escape) +:++                       many (char '_' <|> char '-' <|> alphaNum <|> escape)))+               <?> "identifier"+escape       = char '\\' >> (uniescape <|> charescape)+uniescape    = (varCount 1 6 hexDigit ~>> perhaps (oneOf " \n"))+               >>= (return . hexToString)+charescape   = noneOf ("\n" ++ ['0'..'9'] ++ ['a'..'f'] ++ ['A'..'F'])+at_ident     = (char '@' >> ident) <?> "at-identifier"+varname      = (char '_' <|> letter) +:+ many (char '_' <|> alphaNum)++-- top-level parser+parser :: GenParser Char [Int] [Topl]+parser = many emptyLine >> many (import_ <|> assign <|> cassign <|> block) ~>> end+  where+    import_ = do+      atid <- at_ident+      if atid == "import" then liftM2 Import getline exprseq_nl+                          else unexpected "at-identifier, expecting @import"+    assign  = liftM3 (Assign Always) getline varassign exprseq_nl+    cassign = liftM3 (Assign IfNotAssigned) getline cvarassign exprseq_nl+    block = do+      line <- getline+      selectornames <- selector False+      firstitem <- subblock True <|> subgroup True <|> property True+      restitems <- many $ (subblock False <|> subgroup False <|> property False)+      updateState tail+      return $! Block line selectornames (firstitem:restitems)+    subblock fst = do+      line <- getline+      selectornames <- selector fst+      firstitem <- subblock True <|> subgroup True <|> property True+      restitems <- many $ (subblock False <|> subgroup False <|> property False)+      updateState tail+      return $! SubBlock line selectornames (firstitem:restitems)+    subgroup fst = do+      line <- getline+      groupname <- grpname fst+      firstitem <- property True+      restitems <- many $ property False+      updateState tail+      return $! SubGroup line groupname (firstitem:restitems)+    property fst = liftM3 Property getline (propname fst) exprseq_nl+    selector fst = do+      names <- selnames fst+      return $! map trim (split "," names) -- XXX: breaks with fancy selectors++    -- position helper+    getline      = liftM sourceLine getPosition++    -- toplevel variable assignment+    varassign    = (try $ varname ~>> (ws >> char '=' >> ws)) <?> "assignment"+    cvarassign   = (try $ varname ~>> (ws >> string "?=" >> ws)) <?> "assignment"++    -- grouping constructs -- fst means, first thing in a block+    selnames fst = (try $ indented fst $ --string "def " >> ws >>+                        noneOf "\n" `manyTill` (try $ char ':' >> newline))+                   <?> "selectors"+    propname fst = (try $ indented fst $ ident ~>> char ':') <?> "property name"+    grpname  fst = (try $ indented fst $ grpident ~>> (string "->" >> newline))+                   <?> "group name"+    grpident     = (pws $ try $ many1 letter ++++                          manyConcat (try $ char '-' +:+ many1 letter))+    manyConcat   = liftM concat . many+    end          = ((try $ string "__END__" >> nl) >> return ()) <|> eof++    -- indentation handling: for the first thing in a block, need a new indentation+    -- level, after that, the same -- the new level is popped from the stack in the+    -- individual block parsers+    indented fst parser = do+      ind <- ws+      tok <- parser+      state <- getState+      let ilen = length ind+          olen = head state+      if fst then if ilen > olen then do+                              setState (length ind : state)+                              return tok+                            else unexpected "indentation"+             else if ilen == olen then return tok else unexpected "indentation level"++-- expression parser+exprseq_nl = exprseq ~>> (option ';' (char ';') >> newline)++exprseq :: GenParser Char [Int] [Expr]+exprseq = ws >> many1 expression+  where+    expression = plusExpr `chainr1` listOp+    listOp = op ',' >> return ExprListCons+    plusOp = (op '+' >> return Plus) <|> (op '-' >> return Minus)+    plusExpr = mulExpr `chainl1` plusOp+    mulOp = (op '*' >> return Mul) <|> (op '/' >> return Divide) <|>+            (op '%' >> return Modulo)+    mulExpr = primary `chainl1` mulOp+    primary = do+      object <- parenthesized <|> str <|> dimension <|> number <|> color <|>+                func <|> rgb <|> var <|> bare+      calltails object+    parenthesized = liftM Subseq $ between (op '(') (op ')') (many1 expression)+    str = liftM String $ (sqstring <|> dqstring)+    number = liftM (Number . readNum) num+    dimension = liftM (Dim . readDim) dim+    color = liftM (Color . Right . hexToColor) hexcolor+    var = liftM Var varref+    bare = do+      name <- ident+      if Map.member name colors then return $ Color (Left name)+                                else return $ Bare name+    func = do+      funcname <- choice (map funcall css_functions)+      args <- expression+      op ')'+      return $! CSSFunc funcname args+    rgb = do+      funcall "rgb"+      channels <- expression -- r, g, b+      op ')'+      case channels of (ExprListCons _ (ExprListCons _ (ExprListCons _ _))) ->+                         fail "too many arguments for rgb()"+                       (ExprListCons a (ExprListCons b c)) ->+                         return $! Rgb a b c+                       _ -> fail "not enough expressions for rgb()"+    calltails object = do+      calltail <- option Nothing (call object)+      case calltail of+        Nothing     -> return object+        Just called -> calltails called+    call object = do+      methname <- methcall+      callexpr <- option Nothing (liftM Just expression)+      op ')'+      return $! Just (Call object methname callexpr)++    -- tokens appearing within expressions, always parsed with trailing+    -- whitespace discarded+    varref       = (pws $ char '$' >> varname) <?> "variable reference"+    funcall   fn = (pws $ try $ string fn ~>> char '(') <?> "function " ++ fn+    methcall     = (pws $ char '.' >> varname ~>> (ws >> char '(')) <?> "method call"+    num          = (pws $ (perhaps $ char '-') +++ many1 digit ++++                        option "" (char '.' +:+ many1 digit)) <?> "number"+    dim          = (pws $ try $ num +++ ws +++ unit) <?> "dimension"+    unit         = choice (map string+                           ["em", "ex", "px", "cm", "mm", "in", "pt", "pc", "deg",+                            "rad", "grad", "ms", "s", "Hz", "kHz", "%"])+    dqstring     = (pws $ char '"' >> many1 (noneOf "\n\\\"" <|> escape) ~>> char '"')+                   <?> "string"+    sqstring     = (pws $ char '\'' >> many1 (noneOf "\n\\'" <|> escape) ~>> char '\'')+                   <?> "string"+    hexcolor     = (pws $ char '#' >> ((try $ count 6 hexDigit) <|> count 3 hexDigit))+                   <?> "color"+    op c         = (pws $ char c) <?> "operator " ++ [c]++------------------------------------------------------------------------------------------+-- the evaluator++data EvalError = EvalErr !Line !String  -- line, message+type EvalMonad = RWST (Map.Map String Expr) () [Topl] (Either EvalError) ()++instance Error EvalError where+  strMsg s = EvalErr 0 s++instance Show EvalError where+  show (EvalErr 0 msg) = ": " ++ msg+  show (EvalErr l msg) = "(line " ++ show l ++ "):\n" ++ msg++translate :: [Topl] -> [(String, String)] -> Either EvalError [Topl]+translate toplevels initial_map =+  fmap fst $ execRWST (resolve_toplevels toplevels) (eval_map Map.empty initial_map) []+  where+  -- evaluate items in the initial map+  eval_map :: Map.Map String Expr -> [(String, String)] -> Map.Map String Expr+  eval_map map [] = map+  eval_map map ((n,v):ds) = eval_map (Map.insert n+                                           (evaluate map "initial variables" v) map) ds++  -- this keeps a state of all collected blocks.+  -- it returns (Left error) or (Right ([evaluated blocks], ()))+  resolve_toplevels :: [Topl] -> EvalMonad+  resolve_toplevels (Block line sels items : ts) = do+    resolve_block line sels items+    resolve_toplevels ts+  resolve_toplevels (Import line exprseq : ts) = do+    exprs <- eval_exprseq exprseq+    case exprs of+      CSSFunc "url" u -> modify (Import line [CSSFunc "url" u] : )+      v -> throwError $ EvalErr line $+           "invalid thing to import, should be url(): " ++ show v+    resolve_toplevels ts+  resolve_toplevels (Assign how line name exprseq : ts) = do+    ispresent <- asks (Map.member name)+    if ispresent && how == IfNotAssigned then resolve_toplevels ts else do+      exprs <- eval_exprseq exprseq+      case exprs of+        Error err -> throwError $ EvalErr line err+        _         -> local (Map.insert name exprs) (resolve_toplevels ts)+  resolve_toplevels [] = return ()+    +  resolve_block line sels items = do+    props <- mapM (resolve_item sels) items+    modify (Block line sels (concat props) : )++  resolve_item _ (Property line name exprseq) = do+    exprs <- eval_exprseq exprseq+    case exprs of+      Error err -> throwError $ EvalErr line err+      _         -> return [Property line name [exprs]]+  resolve_item sels (SubBlock line subsels items) =+    resolve_block line (combine_sels sels subsels) items >> return []+  resolve_item _ (SubGroup _ name items) = mapM (resolve_group name) items++  resolve_group name (Property line prop exprs) =+    fmap head $ resolve_item [] (Property line (name ++ "-" ++ prop) exprs)+  resolve_group _ _ = error "impossible item in group"++  combine_sels sels subsels = [comb s1 s2 | s1 <- sels, s2 <- subsels]+    where comb s1 s2 = maybe (s1 ++ " " ++ s2)+                       (\i -> (take i s2) ++ s1 ++ (drop (i+1) s2))+                       (findIndex (=='&') s2)++  eval_exprseq []  = return $ String ""+  eval_exprseq [e] = asks id >>= return . (flip eval e)+  eval_exprseq seq = do+    varmap <- asks id+    return $ findError (Bare . joinShow " ") $ map (eval varmap) seq++  -- evaluate an Expr+  eval varmap exp = let eval' = eval varmap in case exp of+    Var a -> case Map.lookup a varmap of+      Just val -> val+      Nothing -> Error $ "variable " ++ a ++ " is not defined" +    Plus a b -> case (eval' a, eval' b) of+      (String s, String t) -> String (s ++ t)+      (Number n, Number m) -> Number (n + m)+      (Dim n, Dim m) | Just (n1, m1, w) <- unitconv n m -> Dim (n1 + m1, w)+      (Dim (n, u), Number m) -> Dim (n + m, u)+      (Number m, Dim (n, u)) -> Dim (m + n, u)+      (Color col, Number n) -> Color $ Right $ modifyChannels (+) (rgbColor col) n+      (CSSFunc "url" (String url), String s) -> CSSFunc "url" (String $ url ++ s)+      (e@(Error _), _) -> e+      (_, e@(Error _)) -> e+      (x, y) -> Error ("cannot add " ++ show x ++ " and " ++ show y)+    Minus a b -> case (eval' a, eval' b) of+      (Number n, Number m) -> Number (n - m)+      (Dim n, Dim m) | Just (n1, m1, w) <- unitconv n m -> Dim (n1 - m1, w)+      (Dim (n, u), Number m) -> Dim (n - m, u)+      (Number m, Dim (n, u)) -> Dim (m - n, u)+      (Color col, Number n) -> Color $ Right $ modifyChannels (-) (rgbColor col) n+      (e@(Error _), _) -> e+      (_, e@(Error _)) -> e+      (x, y) -> Error ("cannot subtract " ++ show x ++ " and " ++ show y)+    Mul a b -> case (eval' a, eval' b) of+      (String s, Number n) -> String $ concat (replicate (floor n) s)+      (Number n, String s) -> String $ concat (replicate (floor n) s)+      (Number n, Number m) -> Number (n * m)+      (Dim (n, u), Number m) -> Dim (n * m, u)+      (Number m, Dim (n, u)) -> Dim (m * n, u)+      (e@(Error _), _) -> e+      (_, e@(Error _)) -> e+      (x, y) -> Error ("cannot multiply " ++ show x ++ " and " ++ show y)+    Divide a b -> case (eval' a, eval' b) of+      (Number n, Number m) -> case m of+                                    0 -> Error "divide by zero"+                                    m -> Number (n / m)+      (Dim (n, u), Number m) -> case m of+                                        0 -> Error "divide by zero"+                                        m -> Dim (n / m, u)+      (e@(Error _), _) -> e+      (_, e@(Error _)) -> e+      (x, y) -> Error ("cannot divide " ++ show x ++ " by " ++ show y)+    Modulo a b -> case (eval' a, eval' b) of+      (Number n, Number m) -> case m of+                                    0 -> Error "modulo by zero"+                                    m -> Number (n `ratMod` m)+      (Dim (n, u), Number m) -> case m of+                                        0 -> Error "modulo by zero"+                                        m -> Dim (n `ratMod` m, u)+      (e@(Error _), _) -> e+      (_, e@(Error _)) -> e+      (x, y) -> Error ("cannot calculate modulus of " ++ show x ++ " and " ++ show y)+    ExprListCons a b -> case (eval' a, eval' b) of+      (_, e@(Error _)) -> e+      (e@(Error _), _) -> e+      (e, ExprList es) -> ExprList (e:es)+      (e1, e2) -> ExprList [e1, e2]+    Subseq es -> findError Subseq (map eval' es)+    CSSFunc name args -> case (name, eval' args) of+      ("url", String url) -> CSSFunc "url" (String url)+      ("attr", args) -> CSSFunc "attr" args+      ("counter", args) -> CSSFunc "counter" args+      (name, args) -> Error $ printf "invalid CSS function: %s(%s)" name (show args)+    Call exp name arg -> case (name, eval' exp, fmap eval' arg) of+      (_, e@(Error _), _) -> e+      (_, _, Just e@(Error _)) -> e+      -- String methods+      ("bare", String s, Nothing) -> Bare s+      ("string", String s, Nothing) -> String s+      ("string", v, Nothing) -> String (show v)+      ("length", String s, Nothing) -> Number $ toRational (length s)+      ("upper", String s, Nothing) -> String (map toUpper s)+      ("lower", String s, Nothing) -> String (map toLower s)+      ("strip", String s, Nothing) -> String (trim s)+      ("split", String s, Just (String delim)) ->+        ExprList (map String (split delim s))+      ("eval", String s, Nothing) -> evaluate varmap "evaled string" s+      -- Number methods+      ("round", Number n, Just (Number p)) -> Number (roundRat n p)+      ("round", Number n, Nothing) -> Number (roundRat n 0)+      ("round", Dim (n, u), Just (Number p)) -> Dim (roundRat n p, u)+      ("round", Dim (n, u), Nothing) -> Dim (roundRat n 0, u)+      ("abs", Number n, Nothing) -> Number (abs n)+      ("abs", Dim (n, u), Nothing) -> Dim (abs n, u)+      -- List and sequence methods+      ("length", ExprList l, Nothing) -> Number $ toRational (length l)+      ("length", Subseq l, Nothing) -> Number $ toRational (length l)+      ("join", ExprList l, Nothing) -> String $ joinShow ", " l+      ("join", Subseq l, Nothing) -> String $ joinShow " " l+      ("join", ExprList l, Just (String delim)) -> String $ joinShow delim l+      ("join", Subseq l, Just (String delim)) -> String $ joinShow delim l+      ("list", l@(ExprList _), Nothing) -> l+      ("list", Subseq l, Nothing) -> ExprList l+      ("seq", l@(Subseq _), Nothing) -> l+      ("seq", ExprList l, Nothing) -> Subseq l+      -- Color methods+      ("brighten", Color col, arg) ->+        Color $ Right $ brightenColor (rgbColor col) (getAmount arg)+      ("darken", Color col, arg) ->+        Color $ Right $ darkenColor (rgbColor col) (getAmount arg)+      -- All else is invalid+      (name, exp, arg) ->+        Error $ printf "cannot call method %s(%s) on %s" name (show arg) (show exp)+    Rgb r g b -> case (eval' r, eval' g, eval' b) of+      (Number r', Number g', Number b') -> Color $ Right (cx r', cx g', cx b')+      (Dim (r', "%"), Dim (g', "%"), Dim (b', "%")) ->+        Color $ Right (cx (r' * 2.55), cx (g' * 2.55), cx (b' * 2.55))+      _ -> Error "rgb() arguments must be numbers or percentages"+      where cx = inrange 0 255 . floor+    -- all other cases are primitive+    atom -> atom++  -- evaluate a string+  evaluate varmap source string = case runParser exprseq [] "" string of+    Left err  -> Error $ showWithoutPos ("in "++source++":") err+    Right []  -> String ""+    Right [e] -> eval varmap e+    Right seq -> findError Subseq $ map (eval varmap) seq++  -- return either the first Error in xs, or else (cons xs)+  findError cons xs = head $ [Error e | Error e <- xs] ++ [cons xs]++  rgbColor = either (colors Map.!) id++  getAmount arg = case arg of+    Nothing -> 0.1+    Just (Number am) -> (fromRational am) / 100+    Just (Dim (am, "%")) -> (fromRational am) / 100+    _ -> 0++------------------------------------------------------------------------------------------+-- main conversion function++format :: [Topl] -> String+format blocks = concatMap format_block blocks where+  format_block (Block _ sels props) =+    joinStr ", " sels ++ " {\n" ++ unlines (map format_prop props) ++ "}\n\n"+  format_block (Import _ exprs) = "@import " ++ joinShow " " exprs ++ ";\n"+  format_block (Assign _ _ _ _) = error "remaining assignment in eval result"+  format_prop (Property _ name [val]) = "    " ++ name ++  ": " ++ show val ++ ";"+  format_prop (Property _ _ _) = error "property has not exactly one value" +  format_prop _ = error "remaining subitems in block" ++cleverCSSConvert :: SourceName -> String -> [(String, String)] -> Either String String+cleverCSSConvert name input initial_map =+  case runParser parser [0] name (preprocess input) of+      Left err    -> Left $ "Parse error " ++ show err+      Right parse -> case translate parse initial_map of+        Left evalerr -> Left $ "Evaluation error " ++ show evalerr+        Right blocks -> Right $ format (reverse blocks)
+ Text/CSS/CleverCSSUtil.hs view
@@ -0,0 +1,346 @@+------------------------------------------------------------------------------------------+-- CleverCSS in Haskell, (c) 2007 Georg Brandl. Licensed under the BSD license.+--+-- CCUtil module: utilities.+------------------------------------------------------------------------------------------ ++module Text.CSS.CleverCSSUtil (+             (+++), (+:+), (~>>), varCount, perhaps,+             Color, HLSColor, colors, reverse_colors,+             hexToColor, brightenColor, darkenColor, modifyChannels,+             unitconv, inrange, readNum, readDim,+             trim, ltrim, rtrim, split, joinStr, joinShow,+             preprocess, hexToString, cssShow, showWithoutPos,+             ratMod, roundRat,+            ) where++import Control.Arrow ((&&&))+import Control.Monad (msum)+import Data.Char+import Data.List hiding (partition)+import Data.Ratio (Ratio, (%), numerator, denominator)+import Numeric (readFloat)+import Text.Printf (printf)+import Text.ParserCombinators.Parsec (choice, count, try, option, GenParser)+import Text.ParserCombinators.Parsec.Error+import qualified Data.Map as Map++-- Monad combinator helpers++type P tok = GenParser tok [Int]++infixl 1 +++, ~>>+infixr 1 +:++-- return the concatenation of the actions' result lists+{-# INLINE (+++) #-}+(+++) :: P tok [a] -> P tok [a] -> P tok [a]+x +++ y = do { rx <- x; ry <- y; return $ rx ++ ry }+-- return a cons of the actions' results+{-# INLINE (+:+) #-}+(+:+) :: P tok a -> P tok [a] -> P tok [a]+x +:+ y = do { rx <- x; ry <- y; return $ rx:ry }+-- return the result of the first action+{-# INLINE (~>>) #-}+(~>>) :: P tok a -> P tok b -> P tok a+x ~>> y = do { rx <- x; y; return rx }++varCount low high p = choice [try $ count x p | x <- [high,high-1..low]]+perhaps c = option "" (count 1 c)++-- Color types and utilities++type Color = (Int, Int, Int) -- range 0..255+type HLSColor = (Double, Double, Double) -- range 0..1++-- | Convert HLS to RGB.+hls_to_rgb :: HLSColor -> Color+hls_to_rgb (_, l, 0) = (l', l', l') where l' = round (255 * l)+hls_to_rgb (h, l, s) =+  let m2 = if l <= 0.5 then l * (s+1) else l + s - (l*s)+      m1 = 2*l - m2+  in (v m1 m2 (h + 1/3), v m1 m2 h, v m1 m2 (h - 1/3))+  where+    v m1' m2' hue' = round (255 * (v' m1' m2' hue')) where+      v' m1 m2 hue =+        let phue = snd $ properFraction (hue + 2) in+        if      phue < 1/6 then m1 + (m2-m1) * phue * 6+        else if phue < 1/2 then m2+        else if phue < 2/3 then m1 + (m2-m1) * (2/3 - phue) * 6+                           else m1++-- | Convert RGB to HLS.+rgb_to_hls :: Color -> HLSColor+rgb_to_hls (r', g', b') =+  let r    = fromIntegral r' / 255+      g    = fromIntegral g' / 255+      b    = fromIntegral b' / 255+      maxc = max (max r g) b+      minc = min (min r g) b+      mami = maxc - minc+      l    = (minc + maxc) / 2+      s    = if l <= 0.5 then mami / (maxc+minc)+                         else mami / (2-maxc-minc)+      rc   = (maxc-r) / mami+      gc   = (maxc-g) / mami+      bc   = (maxc-b) / mami+      h'   = if      r == maxc then bc - gc+             else if g == maxc then 2 + rc - bc+                               else 4 + gc - rc+      h    = snd $ properFraction (h'/6)+  in if minc == maxc then (0.0, l, 0.0)+     else (h, l, s)+++-- | A map of standard color names and their Hex counterparts.+colors = Map.fromList $ map (fst &&& hexToColor . snd) [+   ("aliceblue", "#f0f8ff"),+   ("antiquewhite", "#faebd7"),+   ("aqua", "#00ffff"),+   ("aquamarine", "#7fffd4"),+   ("azure", "#f0ffff"),+   ("beige", "#f5f5dc"),+   ("bisque", "#ffe4c4"),+   ("black", "#000000"),+   ("blanchedalmond", "#ffebcd"),+   ("blue", "#0000ff"),+   ("blueviolet", "#8a2be2"),+   ("brown", "#a52a2a"),+   ("burlywood", "#deb887"),+   ("cadetblue", "#5f9ea0"),+   ("chartreuse", "#7fff00"),+   ("chocolate", "#d2691e"),+   ("coral", "#ff7f50"),+   ("cornflowerblue", "#6495ed"),+   ("cornsilk", "#fff8dc"),+   ("crimson", "#dc143c"),+   ("cyan", "#00ffff"),+   ("darkblue", "#00008b"),+   ("darkcyan", "#008b8b"),+   ("darkgoldenrod", "#b8860b"),+   ("darkgray", "#a9a9a9"),+   ("darkgreen", "#006400"),+   ("darkkhaki", "#bdb76b"),+   ("darkmagenta", "#8b008b"),+   ("darkolivegreen", "#556b2f"),+   ("darkorange", "#ff8c00"),+   ("darkorchid", "#9932cc"),+   ("darkred", "#8b0000"),+   ("darksalmon", "#e9967a"),+   ("darkseagreen", "#8fbc8f"),+   ("darkslateblue", "#483d8b"),+   ("darkslategray", "#2f4f4f"),+   ("darkturquoise", "#00ced1"),+   ("darkviolet", "#9400d3"),+   ("deeppink", "#ff1493"),+   ("deepskyblue", "#00bfff"),+   ("dimgray", "#696969"),+   ("dodgerblue", "#1e90ff"),+   ("firebrick", "#b22222"),+   ("floralwhite", "#fffaf0"),+   ("forestgreen", "#228b22"),+   ("fuchsia", "#ff00ff"),+   ("gainsboro", "#dcdcdc"),+   ("ghostwhite", "#f8f8ff"),+   ("gold", "#ffd700"),+   ("goldenrod", "#daa520"),+   ("gray", "#808080"),+   ("green", "#008000"),+   ("greenyellow", "#adff2f"),+   ("honeydew", "#f0fff0"),+   ("hotpink", "#ff69b4"),+   ("indianred", "#cd5c5c"),+   ("indigo", "#4b0082"),+   ("ivory", "#fffff0"),+   ("khaki", "#f0e68c"),+   ("lavender", "#e6e6fa"),+   ("lavenderblush", "#fff0f5"),+   ("lawngreen", "#7cfc00"),+   ("lemonchiffon", "#fffacd"),+   ("lightblue", "#add8e6"),+   ("lightcoral", "#f08080"),+   ("lightcyan", "#e0ffff"),+   ("lightgoldenrodyellow", "#fafad2"),+   ("lightgreen", "#90ee90"),+   ("lightgrey", "#d3d3d3"),+   ("lightpink", "#ffb6c1"),+   ("lightsalmon", "#ffa07a"),+   ("lightseagreen", "#20b2aa"),+   ("lightskyblue", "#87cefa"),+   ("lightslategray", "#778899"),+   ("lightsteelblue", "#b0c4de"),+   ("lightyellow", "#ffffe0"),+   ("lime", "#00ff00"),+   ("limegreen", "#32cd32"),+   ("linen", "#faf0e6"),+   ("magenta", "#ff00ff"),+   ("maroon", "#800000"),+   ("mediumaquamarine", "#66cdaa"),+   ("mediumblue", "#0000cd"),+   ("mediumorchid", "#ba55d3"),+   ("mediumpurple", "#9370db"),+   ("mediumseagreen", "#3cb371"),+   ("mediumslateblue", "#7b68ee"),+   ("mediumspringgreen", "#00fa9a"),+   ("mediumturquoise", "#48d1cc"),+   ("mediumvioletred", "#c71585"),+   ("midnightblue", "#191970"),+   ("mintcream", "#f5fffa"),+   ("mistyrose", "#ffe4e1"),+   ("moccasin", "#ffe4b5"),+   ("navajowhite", "#ffdead"),+   ("navy", "#000080"),+   ("oldlace", "#fdf5e6"),+   ("olive", "#808000"),+   ("olivedrab", "#6b8e23"),+   ("orange", "#ffa500"),+   ("orangered", "#ff4500"),+   ("orchid", "#da70d6"),+   ("palegoldenrod", "#eee8aa"),+   ("palegreen", "#98fb98"),+   ("paleturquoise", "#afeeee"),+   ("palevioletred", "#db7093"),+   ("papayawhip", "#ffefd5"),+   ("peachpuff", "#ffdab9"),+   ("peru", "#cd853f"),+   ("pink", "#ffc0cb"),+   ("plum", "#dda0dd"),+   ("powderblue", "#b0e0e6"),+   ("purple", "#800080"),+   ("red", "#ff0000"),+   ("rosybrown", "#bc8f8f"),+   ("royalblue", "#4169e1"),+   ("saddlebrown", "#8b4513"),+   ("salmon", "#fa8072"),+   ("sandybrown", "#f4a460"),+   ("seagreen", "#2e8b57"),+   ("seashell", "#fff5ee"),+   ("sienna", "#a0522d"),+   ("silver", "#c0c0c0"),+   ("skyblue", "#87ceeb"),+   ("slateblue", "#6a5acd"),+   ("slategray", "#708090"),+   ("snow", "#fffafa"),+   ("springgreen", "#00ff7f"),+   ("steelblue", "#4682b4"),+   ("tan", "#d2b48c"),+   ("teal", "#008080"),+   ("thistle", "#d8bfd8"),+   ("tomato", "#ff6347"),+   ("turquoise", "#40e0d0"),+   ("violet", "#ee82ee"),+   ("wheat", "#f5deb3"),+   ("white", "#ffffff"),+   ("whitesmoke", "#f5f5f5"),+   ("yellow", "#ffff00"),+   ("yellowgreen", "#9acd32")]++reverse_colors = Map.fromList $ map (snd &&& fst) $ (Map.toList colors)++hexToColor [h1,h2,h3,h4,h5,h6] = (hx [h1,h2], hx [h3,h4], hx [h5,h6])+  where hx x = read ("0x" ++ x) :: Int+hexToColor [h1,h2,h3] = hexToColor [h1,h1,h2,h2,h3,h3]+hexToColor ('#':hs) = hexToColor hs+hexToColor _ = error "invalid hex color string"++brightenColor = modifyColor (\l a -> l*(1+a))+darkenColor = modifyColor (\l a -> l*(1-a))+modifyColor fun col am = hls_to_rgb (h, inrange 0.0 1.0 (fun l am), s)+  where (h, l, s) = rgb_to_hls col++modifyChannels :: (Rational -> Rational -> Rational) -> (Int, Int, Int) ->+                  Rational -> (Int, Int, Int)+modifyChannels op (r, g, b) am = (m r, m g, m b)+  where m x = inrange 0 255 $ floor $ op (fromInteger (toInteger x)) am++inrange low high val = min high (max low val)++-- Unit utilities++units = [[("mm", 1), ("cm", 10), ("in", 254%10), ("pt", 254%720), ("pc", 254%60)],+         [("ms", 1), ("s", 1000)],+         [("Hz", 1), ("kHz", 1000)]]++unitconv :: (Rational, String) -> (Rational, String) -> Maybe (Rational, Rational, String)+unitconv (x, u) (y, v)+  | u == v    = Just (x, y, v)+  | otherwise = msum $ map (ratio u v) units+  where ratio u v list = case (lookup u list, lookup v list) of+          (Just du, Just dv) -> if du < dv then Just (x, dv/du * y, u)+                                           else Just (du/dv * x, y, v)+          _ -> Nothing++readNum x = case readWithSign 1 x of (sign, res) -> sign * fst res+readDim x = case readWithSign 1 x of+              (sign, res) -> (sign * fst res, trim (snd res))++readWithSign _ ('-':num) = readWithSign (-1) num+readWithSign sign num = (sign, head (readFloat num :: [(Rational, String)]))++-- String utilities++ltrim (c:cs) | c `elem` " \t\v\f\r\n" = ltrim cs+ltrim cs = cs++rtrim = reverse . ltrim . reverse++trim = ltrim . rtrim++preprocess :: String -> String+preprocess []        = ['\n']  -- be sure to have always a newline at the end+preprocess ('\t':xs) = ' ':' ':' ':' ':' ':' ':' ':' ' : preprocess xs+preprocess ('\f':xs) = '\n' : preprocess xs+preprocess ('\r':xs) = preprocess xs+preprocess (x:xs)    = x : preprocess xs++spanList :: ([a] -> Bool) -> [a] -> ([a], [a])+spanList _ [] = ([],[])+spanList func list@(x:xs) =+    if func list+       then (x:ys,zs)+       else ([],list)+    where (ys,zs) = spanList func xs++breakList :: ([a] -> Bool) -> [a] -> ([a], [a])+breakList func = spanList (not . func)++split :: String -> String -> [String] +split _ [] = []+split delim str =+    let (firstline, remainder) = breakList (isPrefixOf delim) str in +    firstline : case remainder of+                  [] -> []+                  x -> if x == delim then [] : []+                       else               split delim (drop (length delim) x)++{-# INLINE joinStr #-}+joinStr d x = concat (intersperse d x)+{-# INLINE joinShow #-} +joinShow d x = joinStr d (map show x)++hexToString :: String -> Char+hexToString x = toEnum (read $ "0x" ++ x)++cssShow s = '"':cssShow' s where+  cssShow' ('"':cs) = '\\':'"':cssShow' cs+  cssShow' (c:cs) | c `elem` [' '..'~'] = c:cssShow' cs+                  | otherwise = printf "\\%x " (fromEnum c) ++ cssShow' cs+  cssShow' [] = ['"']++-- show a Parsec error without position, but with an additional message+showWithoutPos msg err = msg ++ showErrorMessages "or" "unknown parse error"+                         "expecting" "unexpected" "end of input" (errorMessages err)++-- Ratio arithmetic++ratMod :: Rational -> Rational -> Rational+ratMod x y = (nx `mod` ny) % d where+  dx = denominator x+  dy = denominator y+  d  = lcm dx dy+  nx = numerator x * (d `div` dx)+  ny = numerator y * (d `div` dy)++roundRat :: Rational -> Rational -> Rational+roundRat num places = +    let exp = round places :: Integer in+    (round (num * (10^exp))) % (10^exp) -- XXX todo
+ clevercss.cabal view
@@ -0,0 +1,21 @@+Name: clevercss+Version: 0.1+Category: Text+Synopsis: A CSS preprocessor+Description: CleverCSS is a CSS preprocessing library that allows defining variables and nesting selectors so that you don't need to Repeat Yourself.+License: BSD3+License-File: LICENSE+Author: Georg Brandl+Maintainer: georg@python.org+Homepage: http://sandbox.pocoo.org/clevercss-hs/+Stability: experimental+Build-Depends: base, parsec, mtl, haskell98+Extra-Source-Files: documentation.html, example.ccs+Extensions: PatternGuards+GHC-Options: -O1 -funbox-strict-fields+Exposed-Modules: Text.CSS.CleverCSS+Other-Modules: Text.CSS.CleverCSSUtil++Executable: clevercss+Main-is: CCMain.hs+
+ documentation.html view
@@ -0,0 +1,450 @@+<?xml version="1.0" encoding="utf-8" ?>+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">+<head>+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />+<meta name="generator" content="Docutils 0.4: http://docutils.sourceforge.net/" />+<title>CleverCSS (Haskell) Documentation</title>+<style type="text/css">++body {+    margin: 0.0;+    padding: 0.0 10.0% 0.0 10.0%;+    background-color: #5985de;+    font-family: "Bitstream Vera Sans", sans-serif;+}++.document {+    background-color: white;+    padding: 1.0px 20.0px 1.0px 20.0px;+    border-left: 5.0px solid #aaaaff;+    border-right: 5.0px solid #aaaaff;+}++h1 a, h2 a, h3 a, h4 a, h5 a, h6 a {+    color: #002277;+}++h1, h2, h3, h4, h5, h6 {+    font-family: "Arial", sans-serif;+    margin-top: 1.0em;+}++h1.title {+    font-size: 2.5em;+    color: #333333;+    margin-top: 10.0px;+    margin-left: -20.0px;+    margin-right: -20.0px;+    padding-left: 20.0px;+    padding-right: 20.0px;+    padding-bottom: 10.0px;+    border-bottom: 2.0px solid #cccccc;+}++pre {+    background-color: #d8f5c0;+    padding: 5.0px;+    border-top: 1.0px solid #cccccc;+    border-bottom: 1.0px solid #cccccc;+}++a {+    color: #003399;+}++table td {+    padding: 2.0px;+}++table {+    border-collapse: collapse;+    border-color: #999999;+}+++</style>+</head>+<body>+<div class="document" id="clevercss-haskell-documentation">+<h1 class="title">CleverCSS (Haskell) Documentation</h1>+<div class="section">+<h1><a id="introduction" name="introduction">Introduction</a></h1>+<p>CleverCSS is a system for writing templates that are translated into CSS,+allowing to build style sheets in a clean and structured way, following the DRY+(don't repeat yourself) principle.</p>+<p>The syntax is slightly different from CSS in that it relies on indentation+instead of braces to indicate grouping, like the Python language does.</p>+<p>The two things that enable DRY are <em>variables</em> and <em>nesting</em>.  Variables are+names for CSS values; nesting prevents repeating selectors all over.  Here is an+example template file:</p>+<pre class="literal-block">+bgcolor = #f0f0e4++ul#comments, ol#comments:+   background-color: $bgcolor++   li:+      background-color: $bgcolor+      font-size: 1.2em+</pre>+<p>It would translate to (an equivalent of) this CSS stylesheet:</p>+<pre class="literal-block">+ul#comments, ol#comments {+   background-color: #f0f0e4;+}++ul#comments li, ol#comments li {+   background-color: #f0f0e4;+   font-size: 1.2em;+}+</pre>+<p>You can already see that the template doesn't repeat the <tt class="docutils literal"><span class="pre">ul#comments</span></tt> and+<tt class="docutils literal"><span class="pre">ol#comments</span></tt> selectors.  Also, should the desired background color ever+change, you won't need to replace a zillion references to it, but only one+variable assignment.</p>+<p>Other than that, CleverCSS allows expressions involving CSS values as well as+grouping of similar property names, as shown below.</p>+</div>+<div class="section">+<h1><a id="syntax" name="syntax">Syntax</a></h1>+<p>As you have already seen, you use indentation and colons to express grouping.+There are also other small syntactic differences to CSS that make writing+templates less pain:</p>+<ul class="simple">+<li>Semicolons at line ends are optional.</li>+<li>There are no <tt class="docutils literal"><span class="pre">/*</span> <span class="pre">...</span> <span class="pre">*/</span></tt> multiline comments, but Java-style <tt class="docutils literal"><span class="pre">//</span></tt> line+comments.</li>+<li>A line consisting only of <tt class="docutils literal"><span class="pre">__END__</span></tt> means &quot;end of template&quot;.  Everything+after that line is completely ignored by CleverCSS.</li>+</ul>+</div>+<div class="section">+<h1><a id="constructs" name="constructs">Constructs</a></h1>+<div class="section">+<h2><a id="variable-assignments" name="variable-assignments">Variable assignments</a></h2>+<p>You can assign to variables with an equals sign.  Variable assignments are not+allowed inside blocks, only at the toplevel.  Variables can be assigned to+multiple times.</p>+<pre class="literal-block">+foo = 1px+body:+   margin: $foo+foo = 2px+p:+   margin: $foo+</pre>+<p>would result in <tt class="docutils literal"><span class="pre">body</span> <span class="pre">{</span> <span class="pre">margin:</span> <span class="pre">1px</span> <span class="pre">}</span></tt> and <tt class="docutils literal"><span class="pre">p</span> <span class="pre">{</span> <span class="pre">margin:</span> <span class="pre">2px</span> <span class="pre">}</span></tt>.  Referencing+variables before they are defined is an error.</p>+<p>There's also another assignment operator, <tt class="docutils literal"><span class="pre">?=</span></tt>.  It only has an effect if the+variable is not assigned to yet.  This is helpful to provide defaults that can+be overridden by e.g. command line definitions.  For example, after</p>+<pre class="literal-block">+foo = 1px+bar = 1px+foo = 2px+bar ?= 2px+</pre>+<p><tt class="docutils literal"><span class="pre">$foo</span></tt> would be replaced by <tt class="docutils literal"><span class="pre">2px</span></tt>, while <tt class="docutils literal"><span class="pre">$bar</span></tt> would be replaced by+<tt class="docutils literal"><span class="pre">1px</span></tt>.</p>+</div>+<div class="section">+<h2><a id="selectors" name="selectors">Selectors</a></h2>+<p>CleverCSS does not process selectors in a special way, but as shown above you+can nest selector blocks instead of repeating parent selectors in individual+blocks:</p>+<pre class="literal-block">+ul, ol:+   foo+   li, p:+      bar+      strong, em:+         baz+</pre>+<p>would result in</p>+<pre class="literal-block">+ul, ol { foo }++ul li, ul p, ol li, ol p { bar }++ul li strong, ul li em, ul p strong, ul p em,+ol li strong, ol li em, ol p strong, ol p em  { baz }+</pre>+<p>To achieve this, the selectors are currently bluntly split at commas, so+extended selectors involving string matching with a comma will be handled+incorrectly at the moment.</p>+<p>As you see, the above handles basic parent-child relations by joining parent and+child selectors with a space.  However, you can also explicitly determine where+to put the parent selector, using the <tt class="docutils literal"><span class="pre">&amp;</span></tt> character:</p>+<pre class="literal-block">+strong, em:+   a &amp;, #&amp;:+      bar+</pre>+<p>would result in</p>+<pre class="literal-block">+a strong, #strong, a em, #em { bar }+</pre>+<p>Using this technique, you can construct selectors quite freely.  Multiple+occurrences of the ampersand are replaced.</p>+</div>+<div class="section">+<h2><a id="properties" name="properties">Properties</a></h2>+<p>Property specifications work like in CSS: just put a colon after the property+name.  You can use expressions or variable references (see below) only in+property values, not in property names.</p>+</div>+<div class="section">+<h2><a id="property-groups" name="property-groups">Property groups</a></h2>+<p>Since CSS has many property names with common prefixes, CleverCSS includes one+more shortening notation, best described by an example:</p>+<pre class="literal-block">+#main p:+   font-&gt;+      family: Verdana, sans-serif+      size: 1.1em+      style: italic+</pre>+<p>would result in</p>+<pre class="literal-block">+#main p {+   font-family: Verdana, sans-serif;+   font-size: 1.1em;+   font-style: italic;+}+</pre>+<p>The <tt class="docutils literal"><span class="pre">-&gt;</span></tt> symbol, followed by a block of properties, concatenates the name+before it with each of the property names in the block.</p>+</div>+</div>+<div class="section">+<h1><a id="values-and-expressions" name="values-and-expressions">Values and expressions</a></h1>+<p>CleverCSS property values are of multiple types which also exist in CSS:</p>+<table border="1" class="docutils">+<colgroup>+<col width="51%" />+<col width="42%" />+<col width="7%" />+</colgroup>+<thead valign="bottom">+<tr><th class="head">Type</th>+<th class="head">Example property</th>+<th class="head">Note</th>+</tr>+</thead>+<tbody valign="top">+<tr><td>barewords (also called identifiers)</td>+<td><tt class="docutils literal"><span class="pre">font-size:</span> <span class="pre">small</span></tt></td>+<td>&nbsp;</td>+</tr>+<tr><td>strings (double or single quoted)</td>+<td><tt class="docutils literal"><span class="pre">font-family:</span> <span class="pre">&quot;Times&quot;</span></tt></td>+<td>&nbsp;</td>+</tr>+<tr><td>numbers (integral or floating)</td>+<td><tt class="docutils literal"><span class="pre">line-height:</span> <span class="pre">2</span></tt></td>+<td>&nbsp;</td>+</tr>+<tr><td>dimensions (number + unit)</td>+<td><tt class="docutils literal"><span class="pre">margin-left:</span> <span class="pre">2px</span></tt></td>+<td>&nbsp;</td>+</tr>+<tr><td>hexadecimal colors</td>+<td><tt class="docutils literal"><span class="pre">color:</span> <span class="pre">#f0f0f0</span></tt></td>+<td>&nbsp;</td>+</tr>+<tr><td>colors as color names</td>+<td><tt class="docutils literal"><span class="pre">color:</span> <span class="pre">black</span></tt></td>+<td>(1)</td>+</tr>+<tr><td>colors via the RGB function</td>+<td><tt class="docutils literal"><span class="pre">color:</span> <span class="pre">rgb(10%,</span> <span class="pre">20%,</span> <span class="pre">30%)</span></tt></td>+<td>&nbsp;</td>+</tr>+<tr><td>value sequences (separated by whitespace)</td>+<td><tt class="docutils literal"><span class="pre">margin:</span> <span class="pre">2px</span> <span class="pre">0</span> <span class="pre">2px</span> <span class="pre">0</span></tt></td>+<td>&nbsp;</td>+</tr>+<tr><td>value lists (separated by commas)</td>+<td><tt class="docutils literal"><span class="pre">font-family:</span> <span class="pre">&quot;Times&quot;,</span> <span class="pre">serif</span></tt></td>+<td>(2)</td>+</tr>+<tr><td>function calls</td>+<td><tt class="docutils literal"><span class="pre">content:</span> <span class="pre">attr(id)</span></tt></td>+<td>(3)</td>+</tr>+</tbody>+</table>+<p>Notes:</p>+<ol class="arabic simple">+<li>Color names are also valid identifiers.  CleverCSS recognizes the 140 common+Netscape color names and treats them as values of type color, but does not+convert them to RGB format until you do arithmetic with them.  That way, you+can have barewords that are color names without a problem.</li>+<li>This is only used in CSS for the <tt class="docutils literal"><span class="pre">font-family</span></tt> property, but you are free+to use value lists anywhere and convert them to other values using their+methods, see below.</li>+<li>The functions recognized by CleverCSS, in addition to <tt class="docutils literal"><span class="pre">rgb</span></tt>, are <tt class="docutils literal"><span class="pre">attr</span></tt>,+<tt class="docutils literal"><span class="pre">counter</span></tt> and <tt class="docutils literal"><span class="pre">url</span></tt>.</li>+</ol>+<p>CleverCSS extends CSS in that it allows writing not only these literal values,+but also expressions involving these values.  These expressions can contain+these elements, in addition to the literal expressions described above:</p>+<table border="1" class="docutils">+<colgroup>+<col width="48%" />+<col width="45%" />+<col width="7%" />+</colgroup>+<thead valign="bottom">+<tr><th class="head">Type</th>+<th class="head">Example(s)</th>+<th class="head">Note</th>+</tr>+</thead>+<tbody valign="top">+<tr><td>Arithmetic on numbers and values;+operators are <tt class="docutils literal"><span class="pre">+</span></tt>, <tt class="docutils literal"><span class="pre">-</span></tt>, <tt class="docutils literal"><span class="pre">*</span></tt>, <tt class="docutils literal"><span class="pre">/</span></tt>+and <tt class="docutils literal"><span class="pre">%</span></tt> (modulo)</td>+<td><tt class="docutils literal"><span class="pre">4</span> <span class="pre">%</span> <span class="pre">3</span> <span class="pre">=</span> <span class="pre">1</span></tt>, <tt class="docutils literal"><span class="pre">2px</span> <span class="pre">+</span> <span class="pre">4px</span> <span class="pre">=</span> <span class="pre">6px</span></tt>,+<tt class="docutils literal"><span class="pre">2</span> <span class="pre">*</span> <span class="pre">2px</span> <span class="pre">=</span> <span class="pre">4px</span></tt></td>+<td>(1)</td>+</tr>+<tr><td>Arithmetic on colors with <tt class="docutils literal"><span class="pre">+</span></tt> and <tt class="docutils literal"><span class="pre">-</span></tt></td>+<td><tt class="docutils literal"><span class="pre">#f0f000</span> <span class="pre">+</span> <span class="pre">#000030</span> <span class="pre">=</span> <span class="pre">#f0f030</span></tt>,+<tt class="docutils literal"><span class="pre">#808080</span> <span class="pre">+</span> <span class="pre">16</span> <span class="pre">=</span> <span class="pre">#909090</span></tt></td>+<td>(2)</td>+</tr>+<tr><td>Concatenation of strings with <tt class="docutils literal"><span class="pre">+</span></tt></td>+<td><tt class="docutils literal"><span class="pre">&quot;hello</span> <span class="pre">&quot;</span> <span class="pre">+</span> <span class="pre">&quot;world&quot;</span> <span class="pre">=</span> <span class="pre">&quot;hello</span> <span class="pre">world&quot;</span></tt></td>+<td>(3)</td>+</tr>+<tr><td>String multiplication</td>+<td><tt class="docutils literal"><span class="pre">&quot;a</span> <span class="pre">&quot;</span> <span class="pre">*</span> <span class="pre">3</span> <span class="pre">=</span> <span class="pre">&quot;a</span> <span class="pre">a</span> <span class="pre">a</span> <span class="pre">&quot;</span></tt></td>+<td>&nbsp;</td>+</tr>+<tr><td>Expression grouping with parentheses</td>+<td><tt class="docutils literal"><span class="pre">(2</span> <span class="pre">+</span> <span class="pre">3)</span> <span class="pre">*</span> <span class="pre">5px</span></tt></td>+<td>&nbsp;</td>+</tr>+<tr><td>Method calls</td>+<td><tt class="docutils literal"><span class="pre">#303030.brighten(40%)</span> <span class="pre">=</span> <span class="pre">#434343</span></tt>,+<tt class="docutils literal"><span class="pre">&quot;hello&quot;.bare()</span> <span class="pre">=</span> <span class="pre">hello</span></tt></td>+<td>(4)</td>+</tr>+<tr><td>Variable references</td>+<td><tt class="docutils literal"><span class="pre">$foo</span> <span class="pre">=</span> <span class="pre">&lt;whatever</span> <span class="pre">foo</span> <span class="pre">was</span> <span class="pre">assigned&gt;</span></tt></td>+<td>&nbsp;</td>+</tr>+</tbody>+</table>+<p>More explanations:</p>+<ol class="arabic">+<li><p class="first">Arithmetic on numbers works as expected.</p>+<p>You can mix one number and one value in arithmetic expressions, the result+will automatically be given the unit of the value.  This is natural with+multiplication and division but can feel weird with addition and subtraction.</p>+<p>You can add and subtract two dimensions provided their units are the same or+convertable to one another, but you cannot multiply or divide them.</p>+</li>+<li><p class="first">If two colors are added or subtracted, their individual channels will be+added or subtracted.  If one operand is a number, it will be applied to all+channels.</p>+</li>+<li><p class="first">Barewords cannot be added, but you can convert strings to barewords with the+<tt class="docutils literal"><span class="pre">bare()</span></tt> method afterwards.</p>+</li>+<li><p class="first">For a list of available methods, see below.</p>+</li>+</ol>+<div class="section">+<h2><a id="methods" name="methods">Methods</a></h2>+<p>On values of all types:</p>+<ul class="simple">+<li><strong>string()</strong>: convert to a string.</li>+</ul>+<p>On strings:</p>+<ul class="simple">+<li><strong>bare()</strong>: convert the string to a bareword.  It is not checked that it has the+required format!</li>+<li><strong>length()</strong>: return the string's length.</li>+<li><strong>upper()</strong>, <strong>lower()</strong>: convert the string to uppercase/lowercase.</li>+<li><strong>strip()</strong>: return the string with all trailing and leading whitespace removed.</li>+<li><strong>split(delim)</strong>: return a list with substrings, split at the string <em>delim</em>.</li>+<li><strong>eval()</strong>: evaluate the contents as a CleverCSS expression and return the result.</li>+</ul>+<p>On numbers and dimensions:</p>+<ul class="simple">+<li><strong>round([places])</strong>: return the number or dimension rounded to <em>places</em> decimal+places; <em>places</em> defaults to 0.</li>+<li><strong>abs()</strong>: return the absolute value.</li>+</ul>+<p>On colors:</p>+<ul class="simple">+<li><strong>brighten([amount])</strong>: return the color brightened by the specified amount,+which should be a percent dimension.  <em>amount</em> defaults to 10%.</li>+<li><strong>darken([amount])</strong>: return the color darkened by the specified amount, which+should be a percent dimension.  <em>amount</em> defaults to 10%.</li>+</ul>+<p>On lists and sequences:</p>+<ul class="simple">+<li><strong>length()</strong>: return the list or sequence's length.</li>+<li><strong>join([delim])</strong>: return a string consisting the items converted to strings+and joined by <em>delim</em>, which defaults to <tt class="docutils literal"><span class="pre">&quot;,</span> <span class="pre">&quot;</span></tt> for lists and <tt class="docutils literal"><span class="pre">&quot;</span> <span class="pre">&quot;</span></tt> for+sequences.</li>+<li><strong>list()</strong>: return the sequence as a list, or the list unchanged.</li>+<li><strong>seq()</strong>: return the list as a sequence, or the sequence unchanged.</li>+</ul>+</div>+</div>+<div class="section">+<h1><a id="library-usage" name="library-usage">Library usage</a></h1>+<p>Using the CleverCSS library is straightforward, just import <tt class="docutils literal"><span class="pre">Text.CSS.CleverCSS</span></tt>+and use the <tt class="docutils literal"><span class="pre">cleverCSSConvert</span></tt> function, which is defined as</p>+<pre class="literal-block">+cleverCSSConvert :: SourceName -&gt; String -&gt; [(String, String)] -&gt; Either String String+</pre>+<p>The arguments are:</p>+<ul class="simple">+<li>name of input (normally file name, only used for error messages)</li>+<li>input template</li>+<li>initial variable assignments as <tt class="docutils literal"><span class="pre">(name,</span> <span class="pre">value)</span></tt> pairs; the value is evaluated+as a CleverCSS expression when used</li>+</ul>+<p>The return value is either <tt class="docutils literal"><span class="pre">Left</span> <span class="pre">errormessage</span></tt> or <tt class="docutils literal"><span class="pre">Right</span> <span class="pre">stylesheet</span></tt>.</p>+</div>+<div class="section">+<h1><a id="command-line-usage" name="command-line-usage">Command-line usage</a></h1>+<p>CleverCSS also can be compiled as a standalone command-line program.  It can be+called with no arguments, in which case it will convert standard input to+standard output, or with file names as arguments, in which case it will convert+the files named to CSS and store them in a file with the same name, but the+extension replaced with <tt class="docutils literal"><span class="pre">.css</span></tt> (e.g., <tt class="docutils literal"><span class="pre">example.clevercss</span></tt> is converted to+<tt class="docutils literal"><span class="pre">example.css</span></tt>).</p>+<p>You can use the <tt class="docutils literal"><span class="pre">-D</span> <span class="pre">name=value</span></tt> command line option to assign initial+variables.  The value is evaluated as a CleverCSS expression when used.</p>+</div>+<div class="section">+<h1><a id="how-to-get-and-install-it" name="how-to-get-and-install-it">How to get and install it</a></h1>+<p>CleverCSS can be downloaded from+<a class="reference" href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/clevercss">Hackage</a>+or checked out from Mercurial at &lt;<a class="reference" href="http://dev.pocoo.org/hg/clevercss-hs-main">http://dev.pocoo.org/hg/clevercss-hs-main</a>&gt;.+It is a cabalized package, so the usual</p>+<pre class="literal-block">+runhaskell Setup.lhs configure+runhaskell Setup.lhs build+sudo runhaskell Setup.lhs install+</pre>+<p>should be enough to get the <tt class="docutils literal"><span class="pre">clevercss</span></tt> binary and the <tt class="docutils literal"><span class="pre">Text.CSS.CleverCSS</span></tt>+library installed.</p>+</div>+<div class="section">+<h1><a id="authors" name="authors">Authors</a></h1>+<p>The Haskell CleverCSS library is written by Georg Brandl &lt;<a class="reference" href="mailto:georg&#64;python.org">georg&#64;python.org</a>&gt;.+Bug reports and suggestions are welcome!</p>+<p>The CleverCSS template language was initially devised and implemented in Python+by Armin Ronacher, see &lt;<a class="reference" href="http://sandbox.pocoo.org/clevercss">http://sandbox.pocoo.org/clevercss</a>&gt;.</p>+</div>+</div>+</body>+</html>
+ example.ccs view
@@ -0,0 +1,55 @@+// This is an example CleverCSS template file.++base_url = "http://www.example.com"+base_padding = 20px+background_color = #eee // this is a comment+text_color = #111+link_color = #ff0000++@import url($base_url + "/styles.css");++body:+    font-family: 'Verdana', 'Times New Roman', serif+    color: $text_color+    padding->+	top: $base_padding + 2+	right: $base_padding + 3+	left: $base_padding + 3+	bottom: $base_padding + 2+    margin: $supply_me_in_default_variables+    background-color: $background_color++div.foo:+    width: "Hello World".length() * 20px+    foo: (foo, bar, baz, 42).join('/')++a, b:+    color: $link_color+    &:hover, &:link:+	color: $link_color.darken(30%)+    &:active:+	color: $link_color.brighten(10%)++base_padding = $base_padding + 4px;++div.navigation:+    height: 1.2em;+    padding: 0.2cm + 1mm;+    color: rgb(40, 50, 7 * 24) // this is a comment too+    background-color: #606060.brighten(30%)+    ul:+	margin: 0+	padding: $base_padding+	list-style: none+	li:+	    float: left+	    height: 1.2em+	    a, strong, em:+		display: block+		height: 1em+		padding: 0.1em+    foo: (1 2 3).join("-").bare()++__END__++This is completely ignored by CleverCSS.