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

Annotation of /factorcss/FactorCSS.hs

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69 - (hide annotations) (download) (as text)
Fri Jan 7 21:54:20 2005 UTC (19 years, 3 months ago) by james
File MIME type: text/x-haskell
File size: 6962 byte(s)
Modify tokeniser and parser to parse ancestor selectors correctly.

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 69 | argument "lex" args = show (alexScanTokens input)
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     " -t, --tree parse and display parse tree",
67     " -s, --statistics count rulesets, selectors, and declarations",
68 james 66 "",
69 james 67 " -h, --help display this help and exit"]
70 james 66
71 james 62 -- Process a Stylesheet.
72 james 66 process :: ([Statement] -> [Statement]) -> Stylesheet -> Stylesheet
73     process f (Stylesheet charset imports stmts) =
74     Stylesheet charset imports (process_stmts f stmts)
75 james 62
76     -- Process a list of Statements.
77 james 66 process_stmts :: ([Statement] -> [Statement]) -> [Statement] -> [Statement]
78     process_stmts f stmts = (f . filter is_ruleset) stmts ++
79     (map (process_media f) . filter is_media) stmts ++
80 james 62 filter is_page stmts
81    
82     -- Process a Media Statement.
83 james 66 process_media :: ([Statement] -> [Statement]) -> Statement -> Statement
84     process_media f (Media media stmts) = Media media (f stmts)
85 james 62
86     -- Factor a list of Ruleset Statements.
87     factor :: [Statement] -> [Statement]
88     factor = map implode_sel . groupBy eq_sel .
89     sortBy cmp_sel .
90     map implode_decl . groupBy eq_decl .
91     sortBy cmp_decl . sortBy cmp_sel .
92     concat . map explode
93    
94     -- Explode a Ruleset Statement into an equivalent list of Ruleset Statements
95     -- with one Selector and one Declaration per Ruleset.
96     --
97     -- For example (in CSS syntax),
98     -- explode "h1, em { color: red; background-color: blue }" =
99     -- "h1 { color: red }
100     -- h1 { background-color: blue }
101     -- em { color: red }
102     -- em { background-color: blue }"
103     --
104     -- [length (explode (Ruleset sels decls)) == length sels * length decls]
105     explode :: Statement -> [Statement]
106     explode (Ruleset sels decls) =
107     concat (map (\s -> map (\d -> Ruleset [s] [d]) decls) sels)
108    
109     -- Compare two Ruleset Statements by the Selectors in each.
110     cmp_sel :: Statement -> Statement -> Ordering
111     cmp_sel (Ruleset sels0 decls0) (Ruleset sels1 decls1)
112     | a < b = LT
113     | a == b = EQ
114     | a > b = GT
115     where a = show_selectors sels0
116     b = show_selectors sels1
117    
118     -- Compare two Ruleset Statements by the first Declaration in each.
119     cmp_decl :: Statement -> Statement -> Ordering
120     cmp_decl (Ruleset sels0 (decl0:decls0)) (Ruleset sels1 (decl1:decls1))
121     | a < b = LT
122     | a == b = EQ
123     | a > b = GT
124     where a = show_declaration decl0
125     b = show_declaration decl1
126    
127     -- Compare two Ruleset Statements for equality by the Selectors in each.
128     eq_sel :: Statement -> Statement -> Bool
129     eq_sel z = (== EQ) . cmp_sel z
130    
131 james 66 -- Compare two Ruleset Statements for equality by the first declaration in
132     -- each.
133 james 62 eq_decl :: Statement -> Statement -> Bool
134     eq_decl z = (== EQ) . cmp_decl z
135    
136     -- Implode a list of Ruleset Statements with equal lists of Selectors to a
137     -- single equivalent Ruleset Statement.
138     --
139     -- For example,
140     -- implode_sel "h1, em { color: red }
141     -- h1, em { background-color: blue }" =
142     -- "h1, em { color: red; background-color: blue }"
143     implode_sel :: [Statement] -> Statement
144     implode_sel ((Ruleset sels decls):stmts) =
145     Ruleset sels (concat (decls:(map declarations stmts)))
146    
147     -- Implode a list of Ruleset Statements with equal lists of Declarations to a
148     -- single equivalent Ruleset Statement.
149     --
150     -- For example,
151     -- implode_decl "h1 { color: red }
152     -- em { color: red }" =
153     -- "h1, em { color: red }"
154     implode_decl :: [Statement] -> Statement
155     implode_decl ((Ruleset sels decls):stmts) =
156     Ruleset (concat (sels:(map selectors stmts))) decls
157 james 67
158     -- 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

  ViewVC Help
Powered by ViewVC 1.1.26