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	james	63	--
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	james	62
8	james	63	-- 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	james	62	import List
19	james	61	import Tokeniser
20			import Parser
21			import CSS
22
23			main = do
24			s <- getContents
25			-- print (alexScanTokens s)
26	james	62	-- (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