source/factorcss/FactorCSS.hs

-- Factor a CSS stylesheet

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