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 Tokeniser
import Parser
import CSS

main = do
        s <- getContents
--      print (alexScanTokens s)
--      (print . process . parser . alexScanTokens) s
        (putStr . unlines . show_stylesheet . process .
                        parser . alexScanTokens) s

-- Process a Stylesheet.
process :: Stylesheet -> Stylesheet
process (Stylesheet charset imports stmts) =
                Stylesheet charset imports (process_stmts stmts)

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

-- Process a Media Statement.
process_media :: Statement -> Statement
process_media (Media media stmts) = Media media (factor 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 Tokeniser
20	import Parser
21	import CSS
22
23	main = do
24	s <- getContents
25	-- print (alexScanTokens s)
26	-- (print . process . parser . alexScanTokens) s
27	(putStr . unlines . show_stylesheet . process .
28	parser . alexScanTokens) s
29
30	-- Process a Stylesheet.
31	process :: Stylesheet -> Stylesheet
32	process (Stylesheet charset imports stmts) =
33	Stylesheet charset imports (process_stmts stmts)
34
35	-- Process a list of Statements.
36	process_stmts :: [Statement] -> [Statement]
37	process_stmts stmts = (factor . filter is_ruleset) stmts ++
38	(map process_media . filter is_media) stmts ++
39	filter is_page stmts
40
41	-- Process a Media Statement.
42	process_media :: Statement -> Statement
43	process_media (Media media stmts) = Media media (factor stmts)
44
45	-- Factor a list of Ruleset Statements.
46	factor :: [Statement] -> [Statement]
47	factor = map implode_sel . groupBy eq_sel .
48	sortBy cmp_sel .
49	map implode_decl . groupBy eq_decl .
50	sortBy cmp_decl . sortBy cmp_sel .
51	concat . map explode
52
53	-- Explode a Ruleset Statement into an equivalent list of Ruleset Statements
54	-- with one Selector and one Declaration per Ruleset.
55	--
56	-- For example (in CSS syntax),
57	-- explode "h1, em { color: red; background-color: blue }" =
58	-- "h1 { color: red }
59	-- h1 { background-color: blue }
60	-- em { color: red }
61	-- em { background-color: blue }"
62	--
63	-- [length (explode (Ruleset sels decls)) == length sels * length decls]
64	explode :: Statement -> [Statement]
65	explode (Ruleset sels decls) =
66	concat (map (\s -> map (\d -> Ruleset [s] [d]) decls) sels)
67
68	-- Compare two Ruleset Statements by the Selectors in each.
69	cmp_sel :: Statement -> Statement -> Ordering
70	cmp_sel (Ruleset sels0 decls0) (Ruleset sels1 decls1)
71	\| a < b = LT
72	\| a == b = EQ
73	\| a > b = GT
74	where a = show_selectors sels0
75	b = show_selectors sels1
76
77	-- Compare two Ruleset Statements by the first Declaration in each.
78	cmp_decl :: Statement -> Statement -> Ordering
79	cmp_decl (Ruleset sels0 (decl0:decls0)) (Ruleset sels1 (decl1:decls1))
80	\| a < b = LT
81	\| a == b = EQ
82	\| a > b = GT
83	where a = show_declaration decl0
84	b = show_declaration decl1
85
86	-- Compare two Ruleset Statements for equality by the Selectors in each.
87	eq_sel :: Statement -> Statement -> Bool
88	eq_sel z = (== EQ) . cmp_sel z
89
90	-- Compare two Ruleset Statements for equality by the first declaration in each.
91	eq_decl :: Statement -> Statement -> Bool
92	eq_decl z = (== EQ) . cmp_decl z
93
94	-- Implode a list of Ruleset Statements with equal lists of Selectors to a
95	-- single equivalent Ruleset Statement.
96	--
97	-- For example,
98	-- implode_sel "h1, em { color: red }
99	-- h1, em { background-color: blue }" =
100	-- "h1, em { color: red; background-color: blue }"
101	implode_sel :: [Statement] -> Statement
102	implode_sel ((Ruleset sels decls):stmts) =
103	Ruleset sels (concat (decls:(map declarations stmts)))
104	where declarations :: Statement -> [Declaration]
105	declarations (Ruleset s d) = d
106
107	-- Implode a list of Ruleset Statements with equal lists of Declarations to a
108	-- single equivalent Ruleset Statement.
109	--
110	-- For example,
111	-- implode_decl "h1 { color: red }
112	-- em { color: red }" =
113	-- "h1, em { color: red }"
114	implode_decl :: [Statement] -> Statement
115	implode_decl ((Ruleset sels decls):stmts) =
116	Ruleset (concat (sels:(map selectors stmts))) decls
117	where selectors :: Statement -> [Selector]
118	selectors (Ruleset s d) = s