diff options
| -rw-r--r-- | hakyll.cabal | 1 | ||||
| -rw-r--r-- | src/Hakyll/Web/CompressCss.hs | 44 | ||||
| -rw-r--r-- | tests/Hakyll/Web/CompressCss/Tests.hs | 59 | ||||
| -rw-r--r-- | tests/TestSuite.hs | 2 |
4 files changed, 97 insertions, 9 deletions
diff --git a/hakyll.cabal b/hakyll.cabal index 44a09e5..28f5492 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -223,6 +223,7 @@ Test-suite hakyll-tests Hakyll.Core.Store.Tests Hakyll.Core.UnixFilter.Tests Hakyll.Core.Util.String.Tests + Hakyll.Web.CompressCss.Tests Hakyll.Web.Html.RelativizeUrls.Tests Hakyll.Web.Html.Tests Hakyll.Web.Pandoc.FileType.Tests diff --git a/src/Hakyll/Web/CompressCss.hs b/src/Hakyll/Web/CompressCss.hs index 58d52b4..0371d8b 100644 --- a/src/Hakyll/Web/CompressCss.hs +++ b/src/Hakyll/Web/CompressCss.hs @@ -8,14 +8,12 @@ module Hakyll.Web.CompressCss -------------------------------------------------------------------------------- -import Data.Char (isSpace) import Data.List (isPrefixOf) -------------------------------------------------------------------------------- import Hakyll.Core.Compiler import Hakyll.Core.Item -import Hakyll.Core.Util.String -------------------------------------------------------------------------------- @@ -33,27 +31,55 @@ compressCss = compressSeparators . stripComments . compressWhitespace -------------------------------------------------------------------------------- -- | Compresses certain forms of separators. compressSeparators :: String -> String -compressSeparators = - replaceAll "; *}" (const "}") . - replaceAll " *([{};]) *" (take 1 . dropWhile isSpace) . - replaceAll ";+" (const ";") - +compressSeparators [] = [] +compressSeparators str + | isConstant = head str : retainConstants compressSeparators (head str) (drop 1 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) [" ", " {", " }", " :", ";;", ";}"] + stripSecond = or $ map (isOfPrefix str) ["{ ", "} ", ": ", "; "] -------------------------------------------------------------------------------- -- | Compresses all whitespace. compressWhitespace :: String -> String -compressWhitespace = replaceAll "[ \t\n\r]+" (const " ") - +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", " "] -------------------------------------------------------------------------------- -- | Function that strips CSS comments away. 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' + +-------------------------------------------------------------------------------- +-- | 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 diff --git a/tests/Hakyll/Web/CompressCss/Tests.hs b/tests/Hakyll/Web/CompressCss/Tests.hs new file mode 100644 index 0000000..b356388 --- /dev/null +++ b/tests/Hakyll/Web/CompressCss/Tests.hs @@ -0,0 +1,59 @@ +-------------------------------------------------------------------------------- +module Hakyll.Web.CompressCss.Tests + ( tests + ) where + + +-------------------------------------------------------------------------------- +import Data.Char (toUpper) +import Test.Framework (Test, testGroup) +import Test.HUnit (assert, (@=?)) + + +-------------------------------------------------------------------------------- +import Hakyll.Web.CompressCss +import TestSuite.Util + + +-------------------------------------------------------------------------------- +tests :: Test +tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat + [ fromAssertions "compressCss" + [ + -- compress whitespace + " something something " @=? + compressCss " something \n\t\r something " + -- do not compress whitespace in constants + , "abc \" \t\n\r \" xyz" @=? + compressCss "abc \" \t\n\r \" xyz" + , "abc ' \t\n\r ' xyz" @=? + compressCss "abc ' \t\n\r ' xyz" + + -- strip comments + , "before after" @=? compressCss "before /* abc { } ;; \n\t\r */ after" + -- don't strip comments inside constants + , "before \"/* abc { } ;; \n\t\r */\" after" + @=? compressCss "before \"/* abc { } ;; \n\t\r */\" after" + + -- compress separators + , "}" @=? compressCss "; }" + , "{};" @=? compressCss " { } ; " + -- compress whitespace even after this curly brace + , "}" @=? compressCss "; } " + -- but do not compress separators inside of constants + , "\" { } ; \"" @=? compressCss "\" { } ; \"" + -- don't compress separators at the start or end of constants + , "\" }\"" @=? compressCss "\" }\"" + , "\"{ \"" @=? compressCss "\"{ \"" + -- don't get irritated by the wrong constant terminator + , "\" ' \"" @=? compressCss "\" ' \"" + , "' \" '" @=? compressCss "' \" '" + -- don't compress whitespace around separators in constants in the middle of a string + , "abc '{ '" @=? compressCss "abc '{ '" + , "abc \"{ \"" @=? compressCss "abc \"{ \"" + -- compress whitespace after colons + , "abc:xyz" @=? compressCss "abc : xyz" + -- compress multiple semicolons + , ";" @=? compressCss ";;;;;;;" + ] + ] diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index 3622301..79eb314 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -19,6 +19,7 @@ import qualified Hakyll.Core.Runtime.Tests import qualified Hakyll.Core.Store.Tests import qualified Hakyll.Core.UnixFilter.Tests import qualified Hakyll.Core.Util.String.Tests +import qualified Hakyll.Web.CompressCss.Tests import qualified Hakyll.Web.Html.RelativizeUrls.Tests import qualified Hakyll.Web.Html.Tests import qualified Hakyll.Web.Pandoc.FileType.Tests @@ -39,6 +40,7 @@ main = defaultMain , Hakyll.Core.Store.Tests.tests , Hakyll.Core.UnixFilter.Tests.tests , Hakyll.Core.Util.String.Tests.tests + , Hakyll.Web.CompressCss.Tests.tests , Hakyll.Web.Html.RelativizeUrls.Tests.tests , Hakyll.Web.Html.Tests.tests , Hakyll.Web.Pandoc.FileType.Tests.tests |