/[james]/factorcss/FactorCSS.hs
ViewVC logotype

Diff of /factorcss/FactorCSS.hs

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 62 by james, Mon Dec 27 19:11:07 2004 UTC revision 69 by james, Fri Jan 7 21:54:20 2005 UTC
# Line 1  Line 1 
1  -- Factor a CSS stylesheet  --
2    -- This file is part of FactorCSS
3    -- Licensed under the MIT License,
4    --                http://www.opensource.org/licenses/mit-license
5    -- Copyright 2004 James Bursa <james@semichrome.net>
6    --
7    
8    -- Factor a CSS stylesheet.
9    --
10    -- This tool takes a CSS stylesheet on input and produces an almost equivalent
11    -- stylesheet on output, but with rulesets split, combined, and reordered to
12    -- "factor out" common declarations. This helps reveal shared components. The
13    -- resulting stylesheet may also be smaller.
14    --
15    -- The only known case where the output is not equivalent to the input is when
16    -- the stylesheet depends on the order of rules (see CSS 2.1 6.4.1).
17    
18  import List  import List
19    import System
20  import Tokeniser  import Tokeniser
21  import Parser  import Parser
22  import CSS  import CSS
23    
24    -- Program entry function.
25    main :: IO ()
26  main = do  main = do
27          s <- getContents          args <- getArgs
28  --      print (alexScanTokens s)          interact (run args)
29  --      (print . process . parser . alexScanTokens) s  
30          (putStr . unlines . show_stylesheet . process .  -- Produce output from arguments and input.
31                          parser . alexScanTokens) s  run :: [String] -> String -> String
32    run args input
33            | argument "help" args          = usage
34            | null args                     = go factor
35            | argument "factor" args        = go factor
36            | argument "explode" args       = go (concatMap explode)
37            | argument "identity" args      = go id
38            | argument "lex" args           = show (alexScanTokens input)
39            | argument "tree" args          = show stylesheet ++ "\n"
40            | argument "statistics" args    = stats stylesheet ++ "\n"
41            | otherwise                     = usage
42            where   go f = (unlines . show_stylesheet . process f) stylesheet
43                    stylesheet = (parser . alexScanTokens) input
44    
45    -- Check an argument list for an argument in short or long form.
46    argument :: String -> [String] -> Bool
47    argument long args = elem short shorts || elem ("--" ++ long) args
48                    where   short = head long
49                            shorts = (concat . filter is_short) args
50                            is_short ('-':'-':_) = False
51                            is_short ('-':_) = True
52                            is_short _ = False
53    
54    -- Usage help string.
55    usage :: String
56    usage = unlines ["Usage: factorcss [OPTION]... <FILE",
57                    "\"Factor out\" common declarations in a CSS stylesheet by splitting, reordering,",
58                    "and combining rulesets.",
59                    "The stylesheet is read from standard input, and the result is produced on",
60                    "standard output.",
61                    "",
62                    "Output mode:",
63                    "  -f, --factor      factor out common declarations (default)",
64                    "  -e, --explode     produce rulesets with one selector and declaration each",
65                    "  -i, --identity    just parse and output unmodified",
66                    "  -t, --tree        parse and display parse tree",
67                    "  -s, --statistics  count rulesets, selectors, and declarations",
68                    "",
69                    "  -h, --help        display this help and exit"]
70    
71  -- Process a Stylesheet.  -- Process a Stylesheet.
72  process :: Stylesheet -> Stylesheet  process :: ([Statement] -> [Statement]) -> Stylesheet -> Stylesheet
73  process (Stylesheet charset imports stmts) =  process f (Stylesheet charset imports stmts) =
74                  Stylesheet charset imports (process_stmts stmts)                  Stylesheet charset imports (process_stmts f stmts)
75    
76  -- Process a list of Statements.  -- Process a list of Statements.
77  process_stmts :: [Statement] -> [Statement]  process_stmts :: ([Statement] -> [Statement]) -> [Statement] -> [Statement]
78  process_stmts stmts = (factor . filter is_ruleset) stmts ++  process_stmts f stmts = (f . filter is_ruleset) stmts ++
79                  (map process_media . filter is_media) stmts ++                  (map (process_media f) . filter is_media) stmts ++
80                  filter is_page stmts                  filter is_page stmts
81    
82  -- Process a Media Statement.  -- Process a Media Statement.
83  process_media :: Statement -> Statement  process_media :: ([Statement] -> [Statement]) -> Statement -> Statement
84  process_media (Media media stmts) = Media media (factor stmts)  process_media f (Media media stmts) = Media media (f stmts)
85    
86  -- Factor a list of Ruleset Statements.  -- Factor a list of Ruleset Statements.
87  factor :: [Statement] -> [Statement]  factor :: [Statement] -> [Statement]
# Line 72  cmp_decl (Ruleset sels0 (decl0:decls0)) Line 128  cmp_decl (Ruleset sels0 (decl0:decls0))
128  eq_sel :: Statement -> Statement -> Bool  eq_sel :: Statement -> Statement -> Bool
129  eq_sel z = (== EQ) . cmp_sel z  eq_sel z = (== EQ) . cmp_sel z
130    
131  -- Compare two Ruleset Statements for equality by the first declaration in each.  -- Compare two Ruleset Statements for equality by the first declaration in
132    -- each.
133  eq_decl :: Statement -> Statement -> Bool  eq_decl :: Statement -> Statement -> Bool
134  eq_decl z = (== EQ) . cmp_decl z  eq_decl z = (== EQ) . cmp_decl z
135    
# Line 86  eq_decl z = (== EQ) . cmp_decl z Line 143  eq_decl z = (== EQ) . cmp_decl z
143  implode_sel :: [Statement] -> Statement  implode_sel :: [Statement] -> Statement
144  implode_sel ((Ruleset sels decls):stmts) =  implode_sel ((Ruleset sels decls):stmts) =
145                  Ruleset sels (concat (decls:(map declarations stmts)))                  Ruleset sels (concat (decls:(map declarations stmts)))
         where   declarations :: Statement -> [Declaration]  
                 declarations (Ruleset s d) = d  
146    
147  -- Implode a list of Ruleset Statements with equal lists of Declarations to a  -- Implode a list of Ruleset Statements with equal lists of Declarations to a
148  -- single equivalent Ruleset Statement.  -- single equivalent Ruleset Statement.
# Line 99  implode_sel ((Ruleset sels decls):stmts) Line 154  implode_sel ((Ruleset sels decls):stmts)
154  implode_decl :: [Statement] -> Statement  implode_decl :: [Statement] -> Statement
155  implode_decl ((Ruleset sels decls):stmts) =  implode_decl ((Ruleset sels decls):stmts) =
156                  Ruleset (concat (sels:(map selectors stmts))) decls                  Ruleset (concat (sels:(map selectors stmts))) decls
157          where   selectors :: Statement -> [Selector]  
158                  selectors (Ruleset s d) = s  -- Count rulesets, selectors, and declarations in a Stylesheet.
159    stats :: Stylesheet -> String
160    stats (Stylesheet charset imports stmts)
161            | n == 0        = "0 rulesets"
162            | otherwise     = "rulesets " ++ show n ++
163                              ", selectors min " ++ show s0 ++
164                              " max " ++ show s1 ++
165                              " mean " ++ take 5 (
166                                    show (fromIntegral sn / fromIntegral n)) ++
167                              ", declarations min " ++ show d0 ++
168                              " max " ++ show d1 ++
169                              " mean " ++ take 5 (
170                                    show (fromIntegral dn / fromIntegral n))
171            where [n, s0, s1, sn, d0, d1, dn] = stats_stmts stmts
172    
173    -- Count rulesets, selectors, and declarations in a list of Statements.
174    stats_stmts :: [Statement] -> [Int]
175    stats_stmts stmts = stats_rulesets (filter is_ruleset stmts ++
176                    (concatMap get_stmts (filter is_media stmts)))
177                    where   get_stmts (Media media stmts) = stmts
178    
179    -- Count rulesets, selectors, and declarations in a list of Ruleset Statements.
180    stats_rulesets :: [Statement] -> [Int]
181    stats_rulesets stmts = [length stmts,
182                    minimum sel_lengths, maximum sel_lengths, sum sel_lengths,
183                    minimum decl_lengths, maximum decl_lengths, sum decl_lengths]
184                    where   sel_lengths = map (length . selectors) stmts
185                            decl_lengths = map (length . declarations) stmts
186    
187    -- Extract the list of Selectors from a Ruleset Statement.
188    selectors :: Statement -> [Selector]
189    selectors (Ruleset s d) = s
190    
191    -- Extract the list of Declarations from a Ruleset Statement.
192    declarations :: Statement -> [Declaration]
193    declarations (Ruleset s d) = d
Legend:
Removed from v.62  
changed lines
  Added in v.69
  ViewVC Help
Powered by ViewVC 1.1.26