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

Annotation of /factorcss/FactorCSS.hs

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (hide annotations) (download) (as text)
Sat Jan 8 00:04:50 2005 UTC (19 years, 9 months ago) by james
File MIME type: text/x-haskell
File size: 7029 byte(s)
Fix and document --lex.

1 james 63 --
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 james 62
8 james 63 -- 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 james 62 import List
19 james 66 import System
20 james 61 import Tokeniser
21     import Parser
22     import CSS
23    
24 james 66 -- Program entry function.
25     main :: IO ()
26 james 61 main = do
27 james 66 args <- getArgs
28     interact (run args)
29 james 62
30 james 66 -- Produce output from arguments and input.
31     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 james 67 | argument "identity" args = go id
38 james 71 | argument "lex" args = show (alexScanTokens input) ++ "\n"
39 james 67 | argument "tree" args = show stylesheet ++ "\n"
40     | argument "statistics" args = stats stylesheet ++ "\n"
41 james 66 | otherwise = usage
42 james 67 where go f = (unlines . show_stylesheet . process f) stylesheet
43     stylesheet = (parser . alexScanTokens) input
44 james 66
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 james 67 " -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 james 71 " -l, --lex tokenise and display token stream",
67 james 67 " -t, --tree parse and display parse tree",
68     " -s, --statistics count rulesets, selectors, and declarations",
69 james 66 "",
70 james 67 " -h, --help display this help and exit"]
71 james 66
72 james 62 -- Process a Stylesheet.
73 james 66 process :: ([Statement] -> [Statement]) -> Stylesheet -> Stylesheet
74     process f (Stylesheet charset imports stmts) =
75     Stylesheet charset imports (process_stmts f stmts)
76 james 62
77     -- Process a list of Statements.
78 james 66 process_stmts :: ([Statement] -> [Statement]) -> [Statement] -> [Statement]
79     process_stmts f stmts = (f . filter is_ruleset) stmts ++
80     (map (process_media f) . filter is_media) stmts ++
81 james 62 filter is_page stmts
82    
83     -- Process a Media Statement.
84 james 66 process_media :: ([Statement] -> [Statement]) -> Statement -> Statement
85     process_media f (Media media stmts) = Media media (f stmts)
86 james 62
87     -- Factor a list of Ruleset Statements.
88     factor :: [Statement] -> [Statement]
89     factor = map implode_sel . groupBy eq_sel .
90     sortBy cmp_sel .
91     map implode_decl . groupBy eq_decl .
92     sortBy cmp_decl . sortBy cmp_sel .
93     concat . map explode
94    
95     -- Explode a Ruleset Statement into an equivalent list of Ruleset Statements
96     -- with one Selector and one Declaration per Ruleset.
97     --
98     -- For example (in CSS syntax),
99     -- explode "h1, em { color: red; background-color: blue }" =
100     -- "h1 { color: red }
101     -- h1 { background-color: blue }
102     -- em { color: red }
103     -- em { background-color: blue }"
104     --
105     -- [length (explode (Ruleset sels decls)) == length sels * length decls]
106     explode :: Statement -> [Statement]
107     explode (Ruleset sels decls) =
108     concat (map (\s -> map (\d -> Ruleset [s] [d]) decls) sels)
109    
110     -- Compare two Ruleset Statements by the Selectors in each.
111     cmp_sel :: Statement -> Statement -> Ordering
112     cmp_sel (Ruleset sels0 decls0) (Ruleset sels1 decls1)
113     | a < b = LT
114     | a == b = EQ
115     | a > b = GT
116     where a = show_selectors sels0
117     b = show_selectors sels1
118    
119     -- Compare two Ruleset Statements by the first Declaration in each.
120     cmp_decl :: Statement -> Statement -> Ordering
121     cmp_decl (Ruleset sels0 (decl0:decls0)) (Ruleset sels1 (decl1:decls1))
122     | a < b = LT
123     | a == b = EQ
124     | a > b = GT
125     where a = show_declaration decl0
126     b = show_declaration decl1
127    
128     -- Compare two Ruleset Statements for equality by the Selectors in each.
129     eq_sel :: Statement -> Statement -> Bool
130     eq_sel z = (== EQ) . cmp_sel z
131    
132 james 66 -- Compare two Ruleset Statements for equality by the first declaration in
133     -- each.
134 james 62 eq_decl :: Statement -> Statement -> Bool
135     eq_decl z = (== EQ) . cmp_decl z
136    
137     -- Implode a list of Ruleset Statements with equal lists of Selectors to a
138     -- single equivalent Ruleset Statement.
139     --
140     -- For example,
141     -- implode_sel "h1, em { color: red }
142     -- h1, em { background-color: blue }" =
143     -- "h1, em { color: red; background-color: blue }"
144     implode_sel :: [Statement] -> Statement
145     implode_sel ((Ruleset sels decls):stmts) =
146     Ruleset sels (concat (decls:(map declarations stmts)))
147    
148     -- Implode a list of Ruleset Statements with equal lists of Declarations to a
149     -- single equivalent Ruleset Statement.
150     --
151     -- For example,
152     -- implode_decl "h1 { color: red }
153     -- em { color: red }" =
154     -- "h1, em { color: red }"
155     implode_decl :: [Statement] -> Statement
156     implode_decl ((Ruleset sels decls):stmts) =
157     Ruleset (concat (sels:(map selectors stmts))) decls
158 james 67
159     -- Count rulesets, selectors, and declarations in a Stylesheet.
160     stats :: Stylesheet -> String
161     stats (Stylesheet charset imports stmts)
162     | n == 0 = "0 rulesets"
163     | otherwise = "rulesets " ++ show n ++
164     ", selectors min " ++ show s0 ++
165     " max " ++ show s1 ++
166     " mean " ++ take 5 (
167     show (fromIntegral sn / fromIntegral n)) ++
168     ", declarations min " ++ show d0 ++
169     " max " ++ show d1 ++
170     " mean " ++ take 5 (
171     show (fromIntegral dn / fromIntegral n))
172     where [n, s0, s1, sn, d0, d1, dn] = stats_stmts stmts
173    
174     -- Count rulesets, selectors, and declarations in a list of Statements.
175     stats_stmts :: [Statement] -> [Int]
176     stats_stmts stmts = stats_rulesets (filter is_ruleset stmts ++
177     (concatMap get_stmts (filter is_media stmts)))
178     where get_stmts (Media media stmts) = stmts
179    
180     -- Count rulesets, selectors, and declarations in a list of Ruleset Statements.
181     stats_rulesets :: [Statement] -> [Int]
182     stats_rulesets stmts = [length stmts,
183     minimum sel_lengths, maximum sel_lengths, sum sel_lengths,
184     minimum decl_lengths, maximum decl_lengths, sum decl_lengths]
185     where sel_lengths = map (length . selectors) stmts
186     decl_lengths = map (length . declarations) stmts
187    
188     -- Extract the list of Selectors from a Ruleset Statement.
189     selectors :: Statement -> [Selector]
190     selectors (Ruleset s d) = s
191    
192     -- Extract the list of Declarations from a Ruleset Statement.
193     declarations :: Statement -> [Declaration]
194     declarations (Ruleset s d) = d

  ViewVC Help
Powered by ViewVC 1.1.26