diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Hakyll/Web/CompressCss.hs | 44 | ||||
| -rw-r--r-- | src/Hakyll/Web/Feed.hs | 8 |
2 files changed, 42 insertions, 10 deletions
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/src/Hakyll/Web/Feed.hs b/src/Hakyll/Web/Feed.hs index f40fa8a..6c6fa76 100644 --- a/src/Hakyll/Web/Feed.hs +++ b/src/Hakyll/Web/Feed.hs @@ -27,6 +27,7 @@ module Hakyll.Web.Feed import Hakyll.Core.Compiler import Hakyll.Core.Compiler.Internal import Hakyll.Core.Item +import Hakyll.Core.Util.String (replaceAll) import Hakyll.Web.Template import Hakyll.Web.Template.Context import Hakyll.Web.Template.List @@ -64,9 +65,14 @@ renderFeed feedPath itemPath config itemContext items = do feedTpl <- loadTemplate feedPath itemTpl <- loadTemplate itemPath - body <- makeItem =<< applyTemplateList itemTpl itemContext' items + protectedItems <- mapM (applyFilter protectCDATA) items + body <- makeItem =<< applyTemplateList itemTpl itemContext' protectedItems applyTemplate feedTpl feedContext body where + applyFilter :: (Monad m,Functor f) => (String -> String) -> f String -> m (f String) + applyFilter tr str = return $ fmap tr str + protectCDATA :: String -> String + protectCDATA = replaceAll "]]>" (const "]]>") -- Auxiliary: load a template from a datafile loadTemplate path = do file <- compilerUnsafeIO $ getDataFileName path |