@@ -0,0 +1,56 @@
1+-- | Module used for CSS compression. The compression is currently in a simple
2+-- state, but would typically reduce the number of bytes by about 25%.
3+--
4+module Text.Hakyll.Internal.CompressCss
5+ ( compressCss
6+ ) where
7+
8+import Data.Char (isSpace)
9+import Data.Maybe (listToMaybe)
10+import Data.List (isPrefixOf)
11+import Text.Regex.Posix ((=~~))
12+
13+-- | A simple (but inefficient) regex replace funcion
14+--
15+replaceAll :: String -- ^ Pattern
16+ -> (String -> String) -- ^ Replacement (called on capture)
17+ -> String -- ^ Source string
18+ -> String -- ^ Result
19+replaceAll pattern f source =
20+ case listToMaybe (source =~~ pattern) of
21+ Nothing -> source
22+ Just (o, l) ->
23+ let (before, tmp) = splitAt o source
24+ (capture, after) = splitAt l tmp
25+ in before ++ f capture ++ replaceAll pattern f after
26+
27+-- | Compress CSS to speed up your site.
28+--
29+compressCss :: String -> String
30+compressCss = compressSeparators
31+ . stripComments
32+ . compressWhitespace
33+
34+-- | Compresses certain forms of separators.
35+--
36+compressSeparators :: String -> String
37+compressSeparators = replaceAll "; *}" (const "}")
38+ . replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace)
39+ . replaceAll ";;*" (const ";")
40+
41+-- | Compresses all whitespace.
42+--
43+compressWhitespace :: String -> String
44+compressWhitespace = replaceAll "[ \t\n][ \t\n]*" (const " ")
45+
46+-- | Function that strips CSS comments away.
47+--
48+stripComments :: String -> String
49+stripComments [] = []
50+stripComments str
51+ | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str
52+ | otherwise = head str : stripComments (drop 1 str)
53+ where
54+ eatComments str' | null str' = []
55+ | isPrefixOf "*/" str' = drop 2 str'
56+ | otherwise = eatComments $ drop 1 str'