/[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 66 by james, Thu Dec 30 21:22:59 2004 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            | otherwise                     = usage
38            where   go f = (unlines . show_stylesheet . process f .
39                                    parser . alexScanTokens) input
40    
41    -- Check an argument list for an argument in short or long form.
42    argument :: String -> [String] -> Bool
43    argument long args = elem short shorts || elem ("--" ++ long) args
44                    where   short = head long
45                            shorts = (concat . filter is_short) args
46                            is_short ('-':'-':_) = False
47                            is_short ('-':_) = True
48                            is_short _ = False
49    
50    -- Usage help string.
51    usage :: String
52    usage = unlines ["Usage: factorcss [OPTION]... <FILE",
53                    "\"Factor out\" common declarations in a CSS stylesheet by splitting, reordering,",
54                    "and combining rulesets.",
55                    "The stylesheet is read from standard input, and the result is produced on",
56                    "standard output.",
57                    "",
58                    "Output mode:",
59                    "  -f, --factor   factor out common declarations (default)",
60                    "  -e, --explode  produce rulesets with one selector and declaration each",
61                    "",
62                    "  -h, --help     display this help and exit"]
63    
64    -- Process a Stylesheet.
65    process :: ([Statement] -> [Statement]) -> Stylesheet -> Stylesheet
66    process f (Stylesheet charset imports stmts) =
67                    Stylesheet charset imports (process_stmts f stmts)
68    
69    -- Process a list of Statements.
70    process_stmts :: ([Statement] -> [Statement]) -> [Statement] -> [Statement]
71    process_stmts f stmts = (f . filter is_ruleset) stmts ++
72                    (map (process_media f) . filter is_media) stmts ++
73                    filter is_page stmts
74    
75    -- Process a Media Statement.
76    process_media :: ([Statement] -> [Statement]) -> Statement -> Statement
77    process_media f (Media media stmts) = Media media (f stmts)
78    
79    -- Factor a list of Ruleset Statements.
80    factor :: [Statement] -> [Statement]
81    factor = map implode_sel . groupBy eq_sel .
82                    sortBy cmp_sel .
83                    map implode_decl . groupBy eq_decl .
84                    sortBy cmp_decl . sortBy cmp_sel .
85                    concat . map explode
86    
87    -- Explode a Ruleset Statement into an equivalent list of Ruleset Statements
88    -- with one Selector and one Declaration per Ruleset.
89    --
90    -- For example (in CSS syntax),
91    --   explode "h1, em { color: red; background-color: blue }" =
92    --       "h1 { color: red }
93    --        h1 { background-color: blue }
94    --        em { color: red }
95    --        em { background-color: blue }"
96    --
97    -- [length (explode (Ruleset sels decls)) == length sels * length decls]
98    explode :: Statement -> [Statement]
99    explode (Ruleset sels decls) =
100                    concat (map (\s -> map (\d -> Ruleset [s] [d]) decls) sels)
101    
102    -- Compare two Ruleset Statements by the Selectors in each.
103    cmp_sel :: Statement -> Statement -> Ordering
104    cmp_sel (Ruleset sels0 decls0) (Ruleset sels1 decls1)
105            | a < b         = LT
106            | a == b        = EQ
107            | a > b         = GT
108            where   a = show_selectors sels0
109                    b = show_selectors sels1
110    
111    -- Compare two Ruleset Statements by the first Declaration in each.
112    cmp_decl :: Statement -> Statement -> Ordering
113    cmp_decl (Ruleset sels0 (decl0:decls0)) (Ruleset sels1 (decl1:decls1))
114            | a < b         = LT
115            | a == b        = EQ
116            | a > b         = GT
117            where   a = show_declaration decl0
118                    b = show_declaration decl1
119    
120    -- Compare two Ruleset Statements for equality by the Selectors in each.
121    eq_sel :: Statement -> Statement -> Bool
122    eq_sel z = (== EQ) . cmp_sel z
123    
124    -- Compare two Ruleset Statements for equality by the first declaration in
125    -- each.
126    eq_decl :: Statement -> Statement -> Bool
127    eq_decl z = (== EQ) . cmp_decl z
128    
129    -- Implode a list of Ruleset Statements with equal lists of Selectors to a
130    -- single equivalent Ruleset Statement.
131    --
132    -- For example,
133    --   implode_sel "h1, em { color: red }
134    --        h1, em { background-color: blue }" =
135    --       "h1, em { color: red; background-color: blue }"
136    implode_sel :: [Statement] -> Statement
137    implode_sel ((Ruleset sels decls):stmts) =
138                    Ruleset sels (concat (decls:(map declarations stmts)))
139            where   declarations :: Statement -> [Declaration]
140                    declarations (Ruleset s d) = d
141    
142    -- Implode a list of Ruleset Statements with equal lists of Declarations to a
143    -- single equivalent Ruleset Statement.
144    --
145    -- For example,
146    --   implode_decl "h1 { color: red }
147    --        em { color: red }" =
148    --       "h1, em { color: red }"
149    implode_decl :: [Statement] -> Statement
150    implode_decl ((Ruleset sels decls):stmts) =
151                    Ruleset (concat (sels:(map selectors stmts))) decls
152            where   selectors :: Statement -> [Selector]
153                    selectors (Ruleset s d) = s
Legend:
Removed from v.61  
changed lines
  Added in v.66
  ViewVC Help
Powered by ViewVC 1.1.26