diff options
| -rw-r--r-- | lib/Hakyll/Core/Util/String.hs | 2 | ||||
| -rw-r--r-- | lib/Hakyll/Web/CompressCss.hs | 121 | ||||
| -rw-r--r-- | tests/Hakyll/Web/CompressCss/Tests.hs | 18 |
3 files changed, 69 insertions, 72 deletions
diff --git a/lib/Hakyll/Core/Util/String.hs b/lib/Hakyll/Core/Util/String.hs index 23bdd39..f848369 100644 --- a/lib/Hakyll/Core/Util/String.hs +++ b/lib/Hakyll/Core/Util/String.hs @@ -27,7 +27,7 @@ trim = reverse . trim' . reverse . trim' -------------------------------------------------------------------------------- -- | A simple (but inefficient) regex replace funcion replaceAll :: String -- ^ Pattern - -> (String -> String) -- ^ Replacement (called on capture) + -> (String -> String) -- ^ Replacement (called on match) -> String -- ^ Source string -> String -- ^ Result replaceAll pattern f source = replaceAll' source diff --git a/lib/Hakyll/Web/CompressCss.hs b/lib/Hakyll/Web/CompressCss.hs index af6e18a..4aa97e0 100644 --- a/lib/Hakyll/Web/CompressCss.hs +++ b/lib/Hakyll/Web/CompressCss.hs @@ -1,7 +1,6 @@ -------------------------------------------------------------------------------- -- | Module used for CSS compression. The compression is currently in a simple -- state, but would typically reduce the number of bytes by about 25%. -{-# LANGUAGE PatternGuards #-} module Hakyll.Web.CompressCss ( compressCssCompiler , compressCss @@ -9,12 +8,14 @@ module Hakyll.Web.CompressCss -------------------------------------------------------------------------------- -import Data.List (isPrefixOf) +import Data.Char (isSpace) +import Data.List (dropWhileEnd, isPrefixOf) -------------------------------------------------------------------------------- import Hakyll.Core.Compiler import Hakyll.Core.Item +import Hakyll.Core.Util.String -------------------------------------------------------------------------------- @@ -26,79 +27,75 @@ compressCssCompiler = fmap compressCss <$> getResourceString -------------------------------------------------------------------------------- -- | Compress CSS to speed up your site. compressCss :: String -> String -compressCss = compressSeparators . stripComments . compressWhitespace +compressCss = withoutStrings (handleCalcExpressions compressSeparators . compressWhitespace) + . dropWhileEnd isSpace + . dropWhile isSpace + . stripComments -------------------------------------------------------------------------------- -- | Compresses certain forms of separators. compressSeparators :: String -> String -compressSeparators [] = [] -compressSeparators str - | isConstant = head str : retainConstants compressSeparators (head str) (drop 1 str) - | isPrefixOf "calc( " str = "calc(" ++ compressCalcSeparators 1 (drop 6 str) - | isPrefixOf "calc(" str = "calc(" ++ compressCalcSeparators 1 (drop 5 str) - | stripFirst = compressSeparators (drop 1 str) - | stripSecond = compressSeparators (head str : (drop 2 str)) - | otherwise = head str : compressSeparators (drop 1 str) - where - isConstant = or $ map (isOfPrefix str) ["\"", "'"] - stripFirst = or $ map (isOfPrefix str) $ [";;", ";}"] ++ (map (\c -> " " ++ c) separators) - stripSecond = or $ map (isOfPrefix str) $ map (\c -> c ++ " ") separators - separators = [" ", "{", "}", ":", ";", ",", ">", "+", "!"] - --- | Compresses separators when starting inside calc(). -compressCalcSeparators :: Int -> String -> String -compressCalcSeparators 0 str = compressSeparators str -compressCalcSeparators depth str - | stripFirst = compressCalcSeparators depth (tail str) - | stripSecond = compressCalcSeparators depth (head str : (drop 2 str)) - | ('(' : xs) <- str = '(' : compressCalcSeparators (depth + 1) xs - | isPrefixOf "calc( " str = compressCalcSeparators depth ("calc(" ++ (drop 6 str)) - | isPrefixOf "calc(" str = '(' : compressCalcSeparators (depth + 1) (drop 5 str) - | (')' : xs) <- str = ')' : compressCalcSeparators (depth - 1) xs - | otherwise = head str : compressCalcSeparators depth (tail str) +compressSeparators = + replaceAll "; *}" (const "}") . + replaceAll ";+" (const ";") . + replaceAll " *[{};,>+~!] *" (take 1 . dropWhile isSpace) . + replaceAll ": *" (take 1) -- not destroying pseudo selectors (#323) + +-- | Uses `compressCalcExpression` on all parenthesised calc expressions +-- and applies `transform` to all parts outside of them +handleCalcExpressions :: (String -> String) -> String -> String +handleCalcExpressions transform = top transform where - stripFirst = or $ map (isOfPrefix str) $ map (\c -> " " ++ c) ["*", "/", ")"] - stripSecond = or $ map (isOfPrefix str) $ map (\c -> c ++ " ") ["*", "/", "("] + top f "" = f "" + top f str | "calc(" `isPrefixOf` str = f "calc" ++ nested 0 compressCalcExpression (drop 4 str) + top f (x:xs) = top (f . (x:)) xs + + -- when called with depth=0, the first character must be a '(' + nested :: Int -> (String -> String) -> String -> String + nested _ f "" = f "" -- shouldn't happen, mismatched nesting + nested depth f str | "calc(" `isPrefixOf` str = nested depth f (drop 4 str) + nested 1 f (')':xs) = f ")" ++ top transform xs + nested depth f (x:xs) = nested (case x of + '(' -> depth + 1 + ')' -> depth - 1 -- assert: depth > 1 + _ -> depth + ) (f . (x:)) xs + +-- | does not remove whitespace around + and -, which is important in calc() expressions +compressCalcExpression :: String -> String +compressCalcExpression = + replaceAll " *[*/] *| *\\)|\\( *" (take 1 . dropWhile isSpace) -------------------------------------------------------------------------------- -- | Compresses all whitespace. compressWhitespace :: String -> String -compressWhitespace [] = [] -compressWhitespace str - | isConstant = head str : retainConstants compressWhitespace (head str) (drop 1 str) - | replaceOne = compressWhitespace (' ' : (drop 1 str)) - | replaceTwo = compressWhitespace (' ' : (drop 2 str)) - | otherwise = head str : compressWhitespace (drop 1 str) - where - isConstant = or $ map (isOfPrefix str) ["\"", "'"] - replaceOne = or $ map (isOfPrefix str) ["\t", "\n", "\r"] - replaceTwo = or $ map (isOfPrefix str) [" \t", " \n", " \r", " "] +compressWhitespace = replaceAll "[ \t\n\r]+" (const " ") -------------------------------------------------------------------------------- --- | Function that strips CSS comments away. +-- | Function that strips CSS comments away (outside of strings). stripComments :: String -> String -stripComments [] = [] -stripComments str - | isConstant = head str : retainConstants stripComments (head str) (drop 1 str) - | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str - | otherwise = head str : stripComments (drop 1 str) - where - isConstant = or $ map (isOfPrefix str) ["\"", "'"] - eatComments str' - | null str' = [] - | isPrefixOf "*/" str' = drop 2 str' - | otherwise = eatComments $ drop 1 str' +stripComments "" = "" +stripComments ('/':'*':str) = stripComments $ eatComment str +stripComments (x:xs) | x `elem` "\"'" = retainString x xs stripComments + | otherwise = x : stripComments xs + +eatComment :: String -> String +eatComment "" = "" +eatComment ('*':'/':str) = str +eatComment (_:str) = eatComment str --------------------------------------------------------------------------------- --- | Helper function to handle string constants correctly. -retainConstants :: (String -> String) -> Char -> String -> String -retainConstants f delim str - | null str = [] - | isPrefixOf [delim] str = head str : f (drop 1 str) - | otherwise = head str : retainConstants f delim (drop 1 str) -------------------------------------------------------------------------------- --- | Helper function to determine whether a string is a substring. -isOfPrefix :: String -> String -> Bool -isOfPrefix = flip isPrefixOf +-- | Helper functions to handle string tokens correctly. + +-- TODO: handle backslash escapes +withoutStrings :: (String -> String) -> String -> String +withoutStrings f str = case span (`notElem` "\"'") str of + (text, "") -> f text + (text, d:rest) -> f text ++ retainString d rest (withoutStrings f) + +retainString :: Char -> String -> (String -> String) -> String +retainString delim str cont = case span (/= delim) str of + (val, "") -> delim : val + (val, _:rest) -> delim : val ++ delim : cont rest
\ No newline at end of file diff --git a/tests/Hakyll/Web/CompressCss/Tests.hs b/tests/Hakyll/Web/CompressCss/Tests.hs index 66922cd..ae4aba0 100644 --- a/tests/Hakyll/Web/CompressCss/Tests.hs +++ b/tests/Hakyll/Web/CompressCss/Tests.hs @@ -20,9 +20,9 @@ tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat [ fromAssertions "compressCss" [ -- compress whitespace - " something something " @=? + "something something" @=? compressCss " something \n\t\r something " - -- do not compress whitespace in constants + -- do not compress whitespace in string tokens , "abc \" \t\n\r \" xyz" @=? compressCss "abc \" \t\n\r \" xyz" , "abc ' \t\n\r ' xyz" @=? @@ -30,7 +30,7 @@ tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat -- strip comments , "before after" @=? compressCss "before /* abc { } ;; \n\t\r */ after" - -- don't strip comments inside constants + -- don't strip comments inside string tokens , "before \"/* abc { } ;; \n\t\r */\" after" @=? compressCss "before \"/* abc { } ;; \n\t\r */\" after" @@ -45,19 +45,19 @@ tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat , "calc(1px + 100%/(5 + 3) - (3px + 2px)*5)" @=? compressCss "calc( 1px + 100% / ( 5 + 3) - calc( 3px + 2px ) * 5 )" -- compress whitespace even after this curly brace , "}" @=? compressCss "; } " - -- but do not compress separators inside of constants + -- but do not compress separators inside string tokens , "\" { } ; , \"" @=? compressCss "\" { } ; , \"" - -- don't compress separators at the start or end of constants + -- don't compress separators at the start or end of string tokens , "\" }\"" @=? compressCss "\" }\"" , "\"{ \"" @=? compressCss "\"{ \"" - -- don't get irritated by the wrong constant terminator + -- don't get irritated by the wrong token delimiter , "\" ' \"" @=? compressCss "\" ' \"" , "' \" '" @=? compressCss "' \" '" - -- don't compress whitespace around separators in constants in the middle of a string + -- don't compress whitespace in the middle of a string , "abc '{ '" @=? compressCss "abc '{ '" , "abc \"{ \"" @=? compressCss "abc \"{ \"" - -- compress whitespace around colons - , "abc:xyz" @=? compressCss "abc : xyz" + -- compress whitespace after colons (but not before) + , "abc :xyz" @=? compressCss "abc : xyz" -- compress multiple semicolons , ";" @=? compressCss ";;;;;;;" ] |