1 |
-- Factor a CSS stylesheet |
-- |
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 |
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 . process . parser . alexScanTokens) s |
|
30 |
(putStr . unlines . show_stylesheet . process . |
-- Produce output from arguments and input. |
31 |
parser . alexScanTokens) s |
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. |
-- Process a Stylesheet. |
65 |
process :: Stylesheet -> Stylesheet |
process :: ([Statement] -> [Statement]) -> Stylesheet -> Stylesheet |
66 |
process (Stylesheet charset imports stmts) = |
process f (Stylesheet charset imports stmts) = |
67 |
Stylesheet charset imports (process_stmts stmts) |
Stylesheet charset imports (process_stmts f stmts) |
68 |
|
|
69 |
-- Process a list of Statements. |
-- Process a list of Statements. |
70 |
process_stmts :: [Statement] -> [Statement] |
process_stmts :: ([Statement] -> [Statement]) -> [Statement] -> [Statement] |
71 |
process_stmts stmts = (factor . filter is_ruleset) stmts ++ |
process_stmts f stmts = (f . filter is_ruleset) stmts ++ |
72 |
(map process_media . filter is_media) stmts ++ |
(map (process_media f) . filter is_media) stmts ++ |
73 |
filter is_page stmts |
filter is_page stmts |
74 |
|
|
75 |
-- Process a Media Statement. |
-- Process a Media Statement. |
76 |
process_media :: Statement -> Statement |
process_media :: ([Statement] -> [Statement]) -> Statement -> Statement |
77 |
process_media (Media media stmts) = Media media (factor stmts) |
process_media f (Media media stmts) = Media media (f stmts) |
78 |
|
|
79 |
-- Factor a list of Ruleset Statements. |
-- Factor a list of Ruleset Statements. |
80 |
factor :: [Statement] -> [Statement] |
factor :: [Statement] -> [Statement] |
121 |
eq_sel :: Statement -> Statement -> Bool |
eq_sel :: Statement -> Statement -> Bool |
122 |
eq_sel z = (== EQ) . cmp_sel z |
eq_sel z = (== EQ) . cmp_sel z |
123 |
|
|
124 |
-- Compare two Ruleset Statements for equality by the first declaration in each. |
-- Compare two Ruleset Statements for equality by the first declaration in |
125 |
|
-- each. |
126 |
eq_decl :: Statement -> Statement -> Bool |
eq_decl :: Statement -> Statement -> Bool |
127 |
eq_decl z = (== EQ) . cmp_decl z |
eq_decl z = (== EQ) . cmp_decl z |
128 |
|
|