/[james]/factorcss/FactorCSS.hs
ViewVC logotype

Diff of /factorcss/FactorCSS.hs

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 61 by james, Sun Dec 19 22:10:41 2004 UTC revision 71 by james, Sat Jan 8 00:04:50 2005 UTC
# Line 1  Line 1 
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  import Tokeniser
21  import Parser  import Parser
22  import CSS  import CSS
23    
24    -- Program entry function.
25    main :: IO ()
26  main = do  main = do
27          s <- getContents          args <- getArgs
28  --      print (alexScanTokens s)          interact (run args)
29  --      print (parser (alexScanTokens s))  
30          putStr (unlines (show_stylesheet (parser (alexScanTokens s))))  -- 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            | argument "identity" args      = go id
38            | argument "lex" args           = show (alexScanTokens input) ++ "\n"
39            | argument "tree" args          = show stylesheet ++ "\n"
40            | argument "statistics" args    = stats stylesheet ++ "\n"
41            | otherwise                     = usage
42            where   go f = (unlines . show_stylesheet . process f) stylesheet
43                    stylesheet = (parser . alexScanTokens) input
44    
45    -- Check an argument list for an argument in short or long form.
46    argument :: String -> [String] -> Bool
47    argument long args = elem short shorts || elem ("--" ++ long) args
48                    where   short = head long
49                            shorts = (concat . filter is_short) args
50                            is_short ('-':'-':_) = False
51                            is_short ('-':_) = True
52                            is_short _ = False
53    
54    -- Usage help string.
55    usage :: String
56    usage = unlines ["Usage: factorcss [OPTION]... <FILE",
57                    "\"Factor out\" common declarations in a CSS stylesheet by splitting, reordering,",
58                    "and combining rulesets.",
59                    "The stylesheet is read from standard input, and the result is produced on",
60                    "standard output.",
61                    "",
62                    "Output mode:",
63                    "  -f, --factor      factor out common declarations (default)",
64                    "  -e, --explode     produce rulesets with one selector and declaration each",
65                    "  -i, --identity    just parse and output unmodified",
66                    "  -l, --lex         tokenise and display token stream",
67                    "  -t, --tree        parse and display parse tree",
68                    "  -s, --statistics  count rulesets, selectors, and declarations",
69                    "",
70                    "  -h, --help        display this help and exit"]
71    
72    -- Process a Stylesheet.
73    process :: ([Statement] -> [Statement]) -> Stylesheet -> Stylesheet
74    process f (Stylesheet charset imports stmts) =
75                    Stylesheet charset imports (process_stmts f stmts)
76    
77    -- Process a list of Statements.
78    process_stmts :: ([Statement] -> [Statement]) -> [Statement] -> [Statement]
79    process_stmts f stmts = (f . filter is_ruleset) stmts ++
80                    (map (process_media f) . filter is_media) stmts ++
81                    filter is_page stmts
82    
83    -- Process a Media Statement.
84    process_media :: ([Statement] -> [Statement]) -> Statement -> Statement
85    process_media f (Media media stmts) = Media media (f stmts)
86    
87    -- Factor a list of Ruleset Statements.
88    factor :: [Statement] -> [Statement]
89    factor = map implode_sel . groupBy eq_sel .
90                    sortBy cmp_sel .
91                    map implode_decl . groupBy eq_decl .
92                    sortBy cmp_decl . sortBy cmp_sel .
93                    concat . map explode
94    
95    -- Explode a Ruleset Statement into an equivalent list of Ruleset Statements
96    -- with one Selector and one Declaration per Ruleset.
97    --
98    -- For example (in CSS syntax),
99    --   explode "h1, em { color: red; background-color: blue }" =
100    --       "h1 { color: red }
101    --        h1 { background-color: blue }
102    --        em { color: red }
103    --        em { background-color: blue }"
104    --
105    -- [length (explode (Ruleset sels decls)) == length sels * length decls]
106    explode :: Statement -> [Statement]
107    explode (Ruleset sels decls) =
108                    concat (map (\s -> map (\d -> Ruleset [s] [d]) decls) sels)
109    
110    -- Compare two Ruleset Statements by the Selectors in each.
111    cmp_sel :: Statement -> Statement -> Ordering
112    cmp_sel (Ruleset sels0 decls0) (Ruleset sels1 decls1)
113            | a < b         = LT
114            | a == b        = EQ
115            | a > b         = GT
116            where   a = show_selectors sels0
117                    b = show_selectors sels1
118    
119    -- Compare two Ruleset Statements by the first Declaration in each.
120    cmp_decl :: Statement -> Statement -> Ordering
121    cmp_decl (Ruleset sels0 (decl0:decls0)) (Ruleset sels1 (decl1:decls1))
122            | a < b         = LT
123            | a == b        = EQ
124            | a > b         = GT
125            where   a = show_declaration decl0
126                    b = show_declaration decl1
127    
128    -- Compare two Ruleset Statements for equality by the Selectors in each.
129    eq_sel :: Statement -> Statement -> Bool
130    eq_sel z = (== EQ) . cmp_sel z
131    
132    -- Compare two Ruleset Statements for equality by the first declaration in
133    -- each.
134    eq_decl :: Statement -> Statement -> Bool
135    eq_decl z = (== EQ) . cmp_decl z
136    
137    -- Implode a list of Ruleset Statements with equal lists of Selectors to a
138    -- single equivalent Ruleset Statement.
139    --
140    -- For example,
141    --   implode_sel "h1, em { color: red }
142    --        h1, em { background-color: blue }" =
143    --       "h1, em { color: red; background-color: blue }"
144    implode_sel :: [Statement] -> Statement
145    implode_sel ((Ruleset sels decls):stmts) =
146                    Ruleset sels (concat (decls:(map declarations stmts)))
147    
148    -- Implode a list of Ruleset Statements with equal lists of Declarations to a
149    -- single equivalent Ruleset Statement.
150    --
151    -- For example,
152    --   implode_decl "h1 { color: red }
153    --        em { color: red }" =
154    --       "h1, em { color: red }"
155    implode_decl :: [Statement] -> Statement
156    implode_decl ((Ruleset sels decls):stmts) =
157                    Ruleset (concat (sels:(map selectors stmts))) decls
158    
159    -- Count rulesets, selectors, and declarations in a Stylesheet.
160    stats :: Stylesheet -> String
161    stats (Stylesheet charset imports stmts)
162            | n == 0        = "0 rulesets"
163            | otherwise     = "rulesets " ++ show n ++
164                              ", selectors min " ++ show s0 ++
165                              " max " ++ show s1 ++
166                              " mean " ++ take 5 (
167                                    show (fromIntegral sn / fromIntegral n)) ++
168                              ", declarations min " ++ show d0 ++
169                              " max " ++ show d1 ++
170                              " mean " ++ take 5 (
171                                    show (fromIntegral dn / fromIntegral n))
172            where [n, s0, s1, sn, d0, d1, dn] = stats_stmts stmts
173    
174    -- Count rulesets, selectors, and declarations in a list of Statements.
175    stats_stmts :: [Statement] -> [Int]
176    stats_stmts stmts = stats_rulesets (filter is_ruleset stmts ++
177                    (concatMap get_stmts (filter is_media stmts)))
178                    where   get_stmts (Media media stmts) = stmts
179    
180    -- Count rulesets, selectors, and declarations in a list of Ruleset Statements.
181    stats_rulesets :: [Statement] -> [Int]
182    stats_rulesets stmts = [length stmts,
183                    minimum sel_lengths, maximum sel_lengths, sum sel_lengths,
184                    minimum decl_lengths, maximum decl_lengths, sum decl_lengths]
185                    where   sel_lengths = map (length . selectors) stmts
186                            decl_lengths = map (length . declarations) stmts
187    
188    -- Extract the list of Selectors from a Ruleset Statement.
189    selectors :: Statement -> [Selector]
190    selectors (Ruleset s d) = s
191    
192    -- Extract the list of Declarations from a Ruleset Statement.
193    declarations :: Statement -> [Declaration]
194    declarations (Ruleset s d) = d
Legend:
Removed from v.61  
changed lines
  Added in v.71
  ViewVC Help
Powered by ViewVC 1.1.26