source/factorcss/FactorCSS.hs

--
-- This file is part of FactorCSS
-- Licensed under the MIT License,
--                http://www.opensource.org/licenses/mit-license
-- Copyright 2004 James Bursa <james@semichrome.net>
--

-- Factor a CSS stylesheet.
--
-- This tool takes a CSS stylesheet on input and produces an almost equivalent
-- stylesheet on output, but with rulesets split, combined, and reordered to
-- "factor out" common declarations. This helps reveal shared components. The
-- resulting stylesheet may also be smaller.
--
-- The only known case where the output is not equivalent to the input is when
-- the stylesheet depends on the order of rules (see CSS 2.1 6.4.1).

import List
import System
import Tokeniser
import Parser
import CSS

-- Program entry function.
main :: IO ()
main = do
        args <- getArgs
        interact (run args)

-- Produce output from arguments and input.
run :: [String] -> String -> String
run args input
        | argument "help" args          = usage
        | null args                     = go factor
        | argument "factor" args        = go factor
        | argument "explode" args       = go (concatMap explode)
        | otherwise                     = usage
        where   go f = (unlines . show_stylesheet . process f .
                                parser . alexScanTokens) input

-- Check an argument list for an argument in short or long form.
argument :: String -> [String] -> Bool
argument long args = elem short shorts || elem ("--" ++ long) args
                where   short = head long
                        shorts = (concat . filter is_short) args
                        is_short ('-':'-':_) = False
                        is_short ('-':_) = True
                        is_short _ = False

-- Usage help string.
usage :: String
usage = unlines ["Usage: factorcss [OPTION]... <FILE",
                "\"Factor out\" common declarations in a CSS stylesheet by splitting, reordering,",
                "and combining rulesets.",
                "The stylesheet is read from standard input, and the result is produced on",
                "standard output.",
                "",
                "Output mode:",
                "  -f, --factor   factor out common declarations (default)",
                "  -e, --explode  produce rulesets with one selector and declaration each",
                "",
                "  -h, --help     display this help and exit"]

-- Process a Stylesheet.
process :: ([Statement] -> [Statement]) -> Stylesheet -> Stylesheet
process f (Stylesheet charset imports stmts) =
                Stylesheet charset imports (process_stmts f stmts)

-- Process a list of Statements.
process_stmts :: ([Statement] -> [Statement]) -> [Statement] -> [Statement]
process_stmts f stmts = (f . filter is_ruleset) stmts ++
                (map (process_media f) . filter is_media) stmts ++
                filter is_page stmts

-- Process a Media Statement.
process_media :: ([Statement] -> [Statement]) -> Statement -> Statement
process_media f (Media media stmts) = Media media (f stmts)

-- Factor a list of Ruleset Statements.
factor :: [Statement] -> [Statement]
factor = map implode_sel . groupBy eq_sel .
                sortBy cmp_sel .
                map implode_decl . groupBy eq_decl .
                sortBy cmp_decl . sortBy cmp_sel .
                concat . map explode

-- Explode a Ruleset Statement into an equivalent list of Ruleset Statements
-- with one Selector and one Declaration per Ruleset.
--
-- For example (in CSS syntax),
--   explode "h1, em { color: red; background-color: blue }" =
--       "h1 { color: red }
--        h1 { background-color: blue }
--        em { color: red }
--        em { background-color: blue }"
--
-- [length (explode (Ruleset sels decls)) == length sels * length decls]
explode :: Statement -> [Statement]
explode (Ruleset sels decls) =
                concat (map (\s -> map (\d -> Ruleset [s] [d]) decls) sels)

-- Compare two Ruleset Statements by the Selectors in each.
cmp_sel :: Statement -> Statement -> Ordering
cmp_sel (Ruleset sels0 decls0) (Ruleset sels1 decls1)
        | a < b         = LT
        | a == b        = EQ
        | a > b         = GT
        where   a = show_selectors sels0
                b = show_selectors sels1

-- Compare two Ruleset Statements by the first Declaration in each.
cmp_decl :: Statement -> Statement -> Ordering
cmp_decl (Ruleset sels0 (decl0:decls0)) (Ruleset sels1 (decl1:decls1))
        | a < b         = LT
        | a == b        = EQ
        | a > b         = GT
        where   a = show_declaration decl0
                b = show_declaration decl1

-- Compare two Ruleset Statements for equality by the Selectors in each.
eq_sel :: Statement -> Statement -> Bool
eq_sel z = (== EQ) . cmp_sel z

-- Compare two Ruleset Statements for equality by the first declaration in
-- each.
eq_decl :: Statement -> Statement -> Bool
eq_decl z = (== EQ) . cmp_decl z

-- Implode a list of Ruleset Statements with equal lists of Selectors to a
-- single equivalent Ruleset Statement.
--
-- For example,
--   implode_sel "h1, em { color: red }
--        h1, em { background-color: blue }" =
--       "h1, em { color: red; background-color: blue }"
implode_sel :: [Statement] -> Statement
implode_sel ((Ruleset sels decls):stmts) =
                Ruleset sels (concat (decls:(map declarations stmts)))
        where   declarations :: Statement -> [Declaration]
                declarations (Ruleset s d) = d

-- Implode a list of Ruleset Statements with equal lists of Declarations to a
-- single equivalent Ruleset Statement.
--
-- For example,
--   implode_decl "h1 { color: red }
--        em { color: red }" =
--       "h1, em { color: red }"
implode_decl :: [Statement] -> Statement
implode_decl ((Ruleset sels decls):stmts) =
                Ruleset (concat (sels:(map selectors stmts))) decls
        where   selectors :: Statement -> [Selector]
                selectors (Ruleset s d) = s
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	\| otherwise = usage
38	where go f = (unlines . show_stylesheet . process f .
39	parser . alexScanTokens) input
40
41	-- Check an argument list for an argument in short or long form.
42	argument :: String -> [String] -> Bool
43	argument long args = elem short shorts \|\| elem ("--" ++ long) args
44	where short = head long
45	shorts = (concat . filter is_short) args
46	is_short ('-':'-':_) = False
47	is_short ('-':_) = True
48	is_short _ = False
49
50	-- Usage help string.
51	usage :: String
52	usage = unlines ["Usage: factorcss [OPTION]... <FILE",
53	"\"Factor out\" common declarations in a CSS stylesheet by splitting, reordering,",
54	"and combining rulesets.",
55	"The stylesheet is read from standard input, and the result is produced on",
56	"standard output.",
57	"",
58	"Output mode:",
59	" -f, --factor factor out common declarations (default)",
60	" -e, --explode produce rulesets with one selector and declaration each",
61	"",
62	" -h, --help display this help and exit"]
63
64	-- Process a Stylesheet.
65	process :: ([Statement] -> [Statement]) -> Stylesheet -> Stylesheet
66	process f (Stylesheet charset imports stmts) =
67	Stylesheet charset imports (process_stmts f stmts)
68
69	-- Process a list of Statements.
70	process_stmts :: ([Statement] -> [Statement]) -> [Statement] -> [Statement]
71	process_stmts f stmts = (f . filter is_ruleset) stmts ++
72	(map (process_media f) . filter is_media) stmts ++
73	filter is_page stmts
74
75	-- Process a Media Statement.
76	process_media :: ([Statement] -> [Statement]) -> Statement -> Statement
77	process_media f (Media media stmts) = Media media (f stmts)
78
79	-- Factor a list of Ruleset Statements.
80	factor :: [Statement] -> [Statement]
81	factor = map implode_sel . groupBy eq_sel .
82	sortBy cmp_sel .
83	map implode_decl . groupBy eq_decl .
84	sortBy cmp_decl . sortBy cmp_sel .
85	concat . map explode
86
87	-- Explode a Ruleset Statement into an equivalent list of Ruleset Statements
88	-- with one Selector and one Declaration per Ruleset.
89	--
90	-- For example (in CSS syntax),
91	-- explode "h1, em { color: red; background-color: blue }" =
92	-- "h1 { color: red }
93	-- h1 { background-color: blue }
94	-- em { color: red }
95	-- em { background-color: blue }"
96	--
97	-- [length (explode (Ruleset sels decls)) == length sels * length decls]
98	explode :: Statement -> [Statement]
99	explode (Ruleset sels decls) =
100	concat (map (\s -> map (\d -> Ruleset [s] [d]) decls) sels)
101
102	-- Compare two Ruleset Statements by the Selectors in each.
103	cmp_sel :: Statement -> Statement -> Ordering
104	cmp_sel (Ruleset sels0 decls0) (Ruleset sels1 decls1)
105	\| a < b = LT
106	\| a == b = EQ
107	\| a > b = GT
108	where a = show_selectors sels0
109	b = show_selectors sels1
110
111	-- Compare two Ruleset Statements by the first Declaration in each.
112	cmp_decl :: Statement -> Statement -> Ordering
113	cmp_decl (Ruleset sels0 (decl0:decls0)) (Ruleset sels1 (decl1:decls1))
114	\| a < b = LT
115	\| a == b = EQ
116	\| a > b = GT
117	where a = show_declaration decl0
118	b = show_declaration decl1
119
120	-- Compare two Ruleset Statements for equality by the Selectors in each.
121	eq_sel :: Statement -> Statement -> Bool
122	eq_sel z = (== EQ) . cmp_sel z
123
124	-- Compare two Ruleset Statements for equality by the first declaration in
125	-- each.
126	eq_decl :: Statement -> Statement -> Bool
127	eq_decl z = (== EQ) . cmp_decl z
128
129	-- Implode a list of Ruleset Statements with equal lists of Selectors to a
130	-- single equivalent Ruleset Statement.
131	--
132	-- For example,
133	-- implode_sel "h1, em { color: red }
134	-- h1, em { background-color: blue }" =
135	-- "h1, em { color: red; background-color: blue }"
136	implode_sel :: [Statement] -> Statement
137	implode_sel ((Ruleset sels decls):stmts) =
138	Ruleset sels (concat (decls:(map declarations stmts)))
139	where declarations :: Statement -> [Declaration]
140	declarations (Ruleset s d) = d
141
142	-- Implode a list of Ruleset Statements with equal lists of Declarations to a
143	-- single equivalent Ruleset Statement.
144	--
145	-- For example,
146	-- implode_decl "h1 { color: red }
147	-- em { color: red }" =
148	-- "h1, em { color: red }"
149	implode_decl :: [Statement] -> Statement
150	implode_decl ((Ruleset sels decls):stmts) =
151	Ruleset (concat (sels:(map selectors stmts))) decls
152	where selectors :: Statement -> [Selector]
153	selectors (Ruleset s d) = s