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	james	62	-- Factor a CSS stylesheet
2
3			import List
4	james	61	import Tokeniser
5			import Parser
6			import CSS
7
8			main = do
9			s <- getContents
10			-- print (alexScanTokens s)
11	james	62	-- (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