@@ -1,7 +1,6 @@
11--------------------------------------------------------------------------------
22-- | Module used for CSS compression. The compression is currently in a simple
33-- state, but would typically reduce the number of bytes by about 25%.
4−{-# LANGUAGE PatternGuards #-}
54module Hakyll.Web.CompressCss
65 ( compressCssCompiler
76 , compressCss
@@ -9,12 +8,14 @@ module Hakyll.Web.CompressCss
98
109
1110--------------------------------------------------------------------------------
12−import Data.List (isPrefixOf)
11+import Data.Char (isSpace)
12+import Data.List (dropWhileEnd, isPrefixOf)
1313
1414
1515--------------------------------------------------------------------------------
1616import Hakyll.Core.Compiler
1717import Hakyll.Core.Item
18+import Hakyll.Core.Util.String
1819
1920
2021--------------------------------------------------------------------------------
@@ -26,79 +27,75 @@ compressCssCompiler = fmap compressCss <$> getResourceString
2627--------------------------------------------------------------------------------
2728-- | Compress CSS to speed up your site.
2829compressCss :: String -> String
29−compressCss = compressSeparators . stripComments . compressWhitespace
30+compressCss = withoutStrings (handleCalcExpressions compressSeparators . compressWhitespace)
31+ . dropWhileEnd isSpace
32+ . dropWhile isSpace
33+ . stripComments
3034
3135
3236--------------------------------------------------------------------------------
3337-- | Compresses certain forms of separators.
3438compressSeparators :: String -> String
35−compressSeparators [] = []
36−compressSeparators str
37− | isConstant = head str : retainConstants compressSeparators (head str) (drop 1 str)
38− | isPrefixOf "calc( " str = "calc(" ++ compressCalcSeparators 1 (drop 6 str)
39− | isPrefixOf "calc(" str = "calc(" ++ compressCalcSeparators 1 (drop 5 str)
40− | stripFirst = compressSeparators (drop 1 str)
41− | stripSecond = compressSeparators (head str : (drop 2 str))
42− | otherwise = head str : compressSeparators (drop 1 str)
43− where
44− isConstant = or $ map (isOfPrefix str) ["\"", "'"]
45− stripFirst = or $ map (isOfPrefix str) $ [";;", ";}"] ++ (map (\c -> " " ++ c) separators)
46− stripSecond = or $ map (isOfPrefix str) $ map (\c -> c ++ " ") separators
47− separators = [" ", "{", "}", ":", ";", ",", ">", "+", "!"]
48−
49−-- | Compresses separators when starting inside calc().
50−compressCalcSeparators :: Int -> String -> String
51−compressCalcSeparators 0 str = compressSeparators str
52−compressCalcSeparators depth str
53− | stripFirst = compressCalcSeparators depth (tail str)
54− | stripSecond = compressCalcSeparators depth (head str : (drop 2 str))
55− | ('(' : xs) <- str = '(' : compressCalcSeparators (depth + 1) xs
56− | isPrefixOf "calc( " str = compressCalcSeparators depth ("calc(" ++ (drop 6 str))
57− | isPrefixOf "calc(" str = '(' : compressCalcSeparators (depth + 1) (drop 5 str)
58− | (')' : xs) <- str = ')' : compressCalcSeparators (depth - 1) xs
59− | otherwise = head str : compressCalcSeparators depth (tail str)
39+compressSeparators =
40+ replaceAll "; *}" (const "}") .
41+ replaceAll ";+" (const ";") .
42+ replaceAll " *[{};,>+~!] *" (take 1 . dropWhile isSpace) .
43+ replaceAll ": *" (take 1) -- not destroying pseudo selectors (#323)
44+
45+-- | Uses `compressCalcExpression` on all parenthesised calc expressions
46+-- and applies `transform` to all parts outside of them
47+handleCalcExpressions :: (String -> String) -> String -> String
48+handleCalcExpressions transform = top transform
6049 where
61− stripFirst = or $ map (isOfPrefix str) $ map (\c -> " " ++ c) ["*", "/", ")"]
62− stripSecond = or $ map (isOfPrefix str) $ map (\c -> c ++ " ") ["*", "/", "("]
50+ top f "" = f ""
51+ top f str | "calc(" `isPrefixOf` str = f "calc" ++ nested 0 compressCalcExpression (drop 4 str)
52+ top f (x:xs) = top (f . (x:)) xs
53+
54+ -- when called with depth=0, the first character must be a '('
55+ nested :: Int -> (String -> String) -> String -> String
56+ nested _ f "" = f "" -- shouldn't happen, mismatched nesting
57+ nested depth f str | "calc(" `isPrefixOf` str = nested depth f (drop 4 str)
58+ nested 1 f (')':xs) = f ")" ++ top transform xs
59+ nested depth f (x:xs) = nested (case x of
60+ '(' -> depth + 1
61+ ')' -> depth - 1 -- assert: depth > 1
62+ _ -> depth
63+ ) (f . (x:)) xs
64+
65+-- | does not remove whitespace around + and -, which is important in calc() expressions
66+compressCalcExpression :: String -> String
67+compressCalcExpression =
68+ replaceAll " *[*/] *| *\\)|\\( *" (take 1 . dropWhile isSpace)
6369
6470--------------------------------------------------------------------------------
6571-- | Compresses all whitespace.
6672compressWhitespace :: String -> String
67−compressWhitespace [] = []
68−compressWhitespace str
69− | isConstant = head str : retainConstants compressWhitespace (head str) (drop 1 str)
70− | replaceOne = compressWhitespace (' ' : (drop 1 str))
71− | replaceTwo = compressWhitespace (' ' : (drop 2 str))
72− | otherwise = head str : compressWhitespace (drop 1 str)
73− where
74− isConstant = or $ map (isOfPrefix str) ["\"", "'"]
75− replaceOne = or $ map (isOfPrefix str) ["\t", "\n", "\r"]
76− replaceTwo = or $ map (isOfPrefix str) [" \t", " \n", " \r", " "]
73+compressWhitespace = replaceAll "[ \t\n\r]+" (const " ")
7774
7875--------------------------------------------------------------------------------
79−-- | Function that strips CSS comments away.
76+-- | Function that strips CSS comments away (outside of strings).
8077stripComments :: String -> String
81−stripComments [] = []
82−stripComments str
83− | isConstant = head str : retainConstants stripComments (head str) (drop 1 str)
84− | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str
85− | otherwise = head str : stripComments (drop 1 str)
86− where
87− isConstant = or $ map (isOfPrefix str) ["\"", "'"]
88− eatComments str'
89− | null str' = []
90− | isPrefixOf "*/" str' = drop 2 str'
91− | otherwise = eatComments $ drop 1 str'
78+stripComments "" = ""
79+stripComments ('/':'*':str) = stripComments $ eatComment str
80+stripComments (x:xs) | x `elem` "\"'" = retainString x xs stripComments
81+ | otherwise = x : stripComments xs
82+
83+eatComment :: String -> String
84+eatComment "" = ""
85+eatComment ('*':'/':str) = str
86+eatComment (_:str) = eatComment str
9287
93−--------------------------------------------------------------------------------
94−-- | Helper function to handle string constants correctly.
95−retainConstants :: (String -> String) -> Char -> String -> String
96−retainConstants f delim str
97− | null str = []
98− | isPrefixOf [delim] str = head str : f (drop 1 str)
99− | otherwise = head str : retainConstants f delim (drop 1 str)
10088
10189--------------------------------------------------------------------------------
102−-- | Helper function to determine whether a string is a substring.
103−isOfPrefix :: String -> String -> Bool
104−isOfPrefix = flip isPrefixOf
90+-- | Helper functions to handle string tokens correctly.
91+
92+-- TODO: handle backslash escapes
93+withoutStrings :: (String -> String) -> String -> String
94+withoutStrings f str = case span (`notElem` "\"'") str of
95+ (text, "") -> f text
96+ (text, d:rest) -> f text ++ retainString d rest (withoutStrings f)
97+
98+retainString :: Char -> String -> (String -> String) -> String
99+retainString delim str cont = case span (/= delim) str of
100+ (val, "") -> delim : val
101+ (val, _:rest) -> delim : val ++ delim : cont rest