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

Contents of /factorcss/FactorCSS.hs

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69 - (show annotations) (download) (as text)
Fri Jan 7 21:54:20 2005 UTC (19 years, 9 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 --
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
19 import System
20 import Tokeniser
21 import Parser
22 import CSS
23
24 -- Program entry function.
25 main :: IO ()
26 main = do
27 args <- getArgs
28 interact (run args)
29
30 -- 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 | 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.
72 process :: ([Statement] -> [Statement]) -> Stylesheet -> Stylesheet
73 process f (Stylesheet charset imports stmts) =
74 Stylesheet charset imports (process_stmts f stmts)
75
76 -- Process a list of Statements.
77 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 filter is_page stmts
81
82 -- Process a Media Statement.
83 process_media :: ([Statement] -> [Statement]) -> Statement -> Statement
84 process_media f (Media media stmts) = Media media (f stmts)
85
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 -- Compare two Ruleset Statements for equality by the first declaration in
132 -- each.
133 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
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