157fef5 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Optimise CSS compression

157fef5Bergi9 years ago

lib/Hakyll/Core/Util/String.hs+1−1

compare with master

unifiedsplit

@@ -27,7 +27,7 @@ trim = reverse . trim' . reverse . trim'

27--------------------------------------------------------------------------------

28-- | A simple (but inefficient) regex replace funcion

29replaceAll :: String -- ^ Pattern

30− -> (String -> String) -- ^ Replacement (called on capture)

30+ -> (String -> String) -- ^ Replacement (called on match)

31 -> String -- ^ Source string

32 -> String -- ^ Result

33replaceAll pattern f source = replaceAll' source

lib/Hakyll/Web/CompressCss.hs+59−62

@@ -1,7 +1,6 @@

1--------------------------------------------------------------------------------

2-- | Module used for CSS compression. The compression is currently in a simple

3-- state, but would typically reduce the number of bytes by about 25%.

4−{-# LANGUAGE PatternGuards #-}

5module Hakyll.Web.CompressCss

4module Hakyll.Web.CompressCss

6 ( compressCssCompiler

5 ( compressCssCompiler

7 , compressCss

6 , compressCss

@@ -9,12 +8,14 @@ module Hakyll.Web.CompressCss

11--------------------------------------------------------------------------------

10--------------------------------------------------------------------------------

11+import Data.Char (isSpace)

12−import Data.List (isPrefixOf)

12+import Data.List (dropWhileEnd, isPrefixOf)

15--------------------------------------------------------------------------------

16import Hakyll.Core.Compiler

17import Hakyll.Core.Item

18+import Hakyll.Core.Util.String

20--------------------------------------------------------------------------------

21--------------------------------------------------------------------------------

@@ -26,79 +27,75 @@ compressCssCompiler = fmap compressCss <$> getResourceString

26--------------------------------------------------------------------------------

27--------------------------------------------------------------------------------

27-- | Compress CSS to speed up your site.

28-- | Compress CSS to speed up your site.

28compressCss :: String -> String

29compressCss :: String -> String

29−compressCss = compressSeparators . stripComments . compressWhitespace

30+compressCss = withoutStrings (handleCalcExpressions compressSeparators . compressWhitespace)

31+ . dropWhileEnd isSpace

32+ . dropWhile isSpace

33+ . stripComments

32--------------------------------------------------------------------------------

36--------------------------------------------------------------------------------

33-- | Compresses certain forms of separators.

37-- | Compresses certain forms of separators.

34compressSeparators :: String -> String

38compressSeparators :: String -> String

35−compressSeparators [] = []

39+compressSeparators =

36−compressSeparators str

40+ replaceAll "; *}" (const "}") .

37− | isConstant = head str : retainConstants compressSeparators (head str) (drop 1 str)

41+ replaceAll ";+" (const ";") .

38− | isPrefixOf "calc( " str = "calc(" ++ compressCalcSeparators 1 (drop 6 str)

42+ replaceAll " *[{};,>+~!] *" (take 1 . dropWhile isSpace) .

39− | isPrefixOf "calc(" str = "calc(" ++ compressCalcSeparators 1 (drop 5 str)

43+ replaceAll ": *" (take 1) -- not destroying pseudo selectors (#323)

40− | stripFirst = compressSeparators (drop 1 str)

44+

41− | stripSecond = compressSeparators (head str : (drop 2 str))

45+-- | Uses `compressCalcExpression` on all parenthesised calc expressions

42− | otherwise = head str : compressSeparators (drop 1 str)

46+-- and applies `transform` to all parts outside of them

43− where

47+handleCalcExpressions :: (String -> String) -> String -> String

44− isConstant = or $ map (isOfPrefix str) ["\"", "'"]

48+handleCalcExpressions transform = top transform

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)

60 where

49 where

61− stripFirst = or $ map (isOfPrefix str) $ map (\c -> " " ++ c) ["*", "/", ")"]

50+ top f "" = f ""

62− stripSecond = or $ map (isOfPrefix str) $ map (\c -> c ++ " ") ["*", "/", "("]

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)

64--------------------------------------------------------------------------------

70--------------------------------------------------------------------------------

65-- | Compresses all whitespace.

71-- | Compresses all whitespace.

66compressWhitespace :: String -> String

72compressWhitespace :: String -> String

67−compressWhitespace [] = []

73+compressWhitespace = replaceAll "[ \t\n\r]+" (const " ")

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", " "]

78--------------------------------------------------------------------------------

75--------------------------------------------------------------------------------

79−-- | Function that strips CSS comments away.

76+-- | Function that strips CSS comments away (outside of strings).

80stripComments :: String -> String

77stripComments :: String -> String

81−stripComments [] = []

78+stripComments "" = ""

82−stripComments str

79+stripComments ('/':'*':str) = stripComments $ eatComment str

83− | isConstant = head str : retainConstants stripComments (head str) (drop 1 str)

80+stripComments (x:xs) | x `elem` "\"'" = retainString x xs stripComments

84− | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str

81+ | otherwise = x : stripComments xs

85− | otherwise = head str : stripComments (drop 1 str)

82+

86− where

83+eatComment :: String -> String

87− isConstant = or $ map (isOfPrefix str) ["\"", "'"]

84+eatComment "" = ""

88− eatComments str'

85+eatComment ('*':'/':str) = str

89− | null str' = []

86+eatComment (_:str) = eatComment str

90− | isPrefixOf "*/" str' = drop 2 str'

91− | otherwise = eatComments $ drop 1 str'

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)

100

101--------------------------------------------------------------------------------

89--------------------------------------------------------------------------------

102−-- | Helper function to determine whether a string is a substring.

90+-- | Helper functions to handle string tokens correctly.

103−isOfPrefix :: String -> String -> Bool

91+

104−isOfPrefix = flip isPrefixOf

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

tests/Hakyll/Web/CompressCss/Tests.hs+9−9

@@ -20,9 +20,9 @@ tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat

20 [ fromAssertions "compressCss"

21 [

22 -- compress whitespace

23− " something something " @=?

23+ "something something" @=?

24 compressCss " something \n\t\r something "

25− -- do not compress whitespace in constants

25+ -- do not compress whitespace in string tokens

26 , "abc \" \t\n\r \" xyz" @=?

27 compressCss "abc \" \t\n\r \" xyz"

28 , "abc ' \t\n\r ' xyz" @=?

@@ -30,7 +30,7 @@ tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat

31 -- strip comments

32 , "before after" @=? compressCss "before /* abc { } ;; \n\t\r */ after"

33− -- don't strip comments inside constants

33+ -- don't strip comments inside string tokens

34 , "before \"/* abc { } ;; \n\t\r */\" after"

35 @=? compressCss "before \"/* abc { } ;; \n\t\r */\" after"

@@ -45,19 +45,19 @@ tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat

45 , "calc(1px + 100%/(5 + 3) - (3px + 2px)*5)" @=? compressCss "calc( 1px + 100% / ( 5 + 3) - calc( 3px + 2px ) * 5 )"

46 -- compress whitespace even after this curly brace

47 , "}" @=? compressCss "; } "

48− -- but do not compress separators inside of constants

48+ -- but do not compress separators inside string tokens

49 , "\" { } ; , \"" @=? compressCss "\" { } ; , \""

50− -- don't compress separators at the start or end of constants

50+ -- don't compress separators at the start or end of string tokens

51 , "\" }\"" @=? compressCss "\" }\""

52 , "\"{ \"" @=? compressCss "\"{ \""

53− -- don't get irritated by the wrong constant terminator

53+ -- don't get irritated by the wrong token delimiter

54 , "\" ' \"" @=? compressCss "\" ' \""

55 , "' \" '" @=? compressCss "' \" '"

56− -- don't compress whitespace around separators in constants in the middle of a string

56+ -- don't compress whitespace in the middle of a string

57 , "abc '{ '" @=? compressCss "abc '{ '"

58 , "abc \"{ \"" @=? compressCss "abc \"{ \""

59− -- compress whitespace around colons

59+ -- compress whitespace after colons (but not before)

60− , "abc:xyz" @=? compressCss "abc : xyz"

60+ , "abc :xyz" @=? compressCss "abc : xyz"

61 -- compress multiple semicolons

62 , ";" @=? compressCss ";;;;;;;"

63 ]