--------------------------------------------------------------------------------
-- | Module used for CSS compression. The compression is currently in a simple
-- state, but would typically reduce the number of bytes by about 25%.
module Hakyll.Web.CompressCss
    ( compressCssCompiler
    , compressCss
    ) where


--------------------------------------------------------------------------------
import           Data.Char               (isSpace)
import           Data.List               (dropWhileEnd, isPrefixOf)


--------------------------------------------------------------------------------
import           Hakyll.Core.Compiler
import           Hakyll.Core.Item
import           Hakyll.Core.Util.String


--------------------------------------------------------------------------------
-- | Compiler form of 'compressCss'
compressCssCompiler :: Compiler (Item String)
compressCssCompiler :: Compiler (Item String)
compressCssCompiler = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
compressCss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler (Item String)
getResourceString


--------------------------------------------------------------------------------
-- | Compress CSS to speed up your site.
compressCss :: String -> String
compressCss :: String -> String
compressCss = (String -> String) -> String -> String
withoutStrings ((String -> String) -> String -> String
handleCalcExpressions String -> String
compressSeparators forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
compressWhitespace)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stripComments


--------------------------------------------------------------------------------
-- | Compresses certain forms of separators.
compressSeparators :: String -> String
compressSeparators :: String -> String
compressSeparators =
    String -> (String -> String) -> String -> String
replaceAll String
"; *}" (forall a b. a -> b -> a
const String
"}") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> (String -> String) -> String -> String
replaceAll String
";+" (forall a b. a -> b -> a
const String
";") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> (String -> String) -> String -> String
replaceAll String
" *[{};,>+~!] *" (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> (String -> String) -> String -> String
replaceAll String
": *" (forall a. Int -> [a] -> [a]
take Int
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 :: (String -> String) -> String -> String
handleCalcExpressions String -> String
transform = (String -> String) -> String -> String
top String -> String
transform
  where
    top :: (String -> String) -> String -> String
top String -> String
f String
""                             = String -> String
f String
""
    top String -> String
f String
str | String
"calc(" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str = String -> String
f String
"calc" forall a. [a] -> [a] -> [a]
++ Int -> (String -> String) -> String -> String
nested Int
0 String -> String
compressCalcExpression (forall a. Int -> [a] -> [a]
drop Int
4 String
str)
    top String -> String
f (Char
x:String
xs)                         = (String -> String) -> String -> String
top (String -> String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
xforall a. a -> [a] -> [a]
:)) String
xs
    
    -- when called with depth=0, the first character must be a '('
    nested :: Int -> (String -> String) -> String -> String
    nested :: Int -> (String -> String) -> String -> String
nested Int
_     String -> String
f String
""                             = String -> String
f String
"" -- shouldn't happen, mismatched nesting
    nested Int
depth String -> String
f String
str | String
"calc(" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str = Int -> (String -> String) -> String -> String
nested Int
depth String -> String
f (forall a. Int -> [a] -> [a]
drop Int
4 String
str)
    nested Int
1     String -> String
f (Char
')':String
xs)                       = String -> String
f String
")" forall a. [a] -> [a] -> [a]
++ (String -> String) -> String -> String
top String -> String
transform String
xs
    nested Int
depth String -> String
f (Char
x:String
xs)                         = Int -> (String -> String) -> String -> String
nested (case Char
x of
                                                      Char
'(' -> Int
depth forall a. Num a => a -> a -> a
+ Int
1
                                                      Char
')' -> Int
depth forall a. Num a => a -> a -> a
- Int
1 -- assert: depth > 1
                                                      Char
_   -> Int
depth
                                                    ) (String -> String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
xforall a. a -> [a] -> [a]
:)) String
xs

-- | does not remove whitespace around + and -, which is important in calc() expressions
compressCalcExpression :: String -> String
compressCalcExpression :: String -> String
compressCalcExpression =
    String -> (String -> String) -> String -> String
replaceAll String
" *[*/] *| *\\)|\\( *" (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace)

--------------------------------------------------------------------------------
-- | Compresses all whitespace.
compressWhitespace :: String -> String
compressWhitespace :: String -> String
compressWhitespace = String -> (String -> String) -> String -> String
replaceAll String
"[ \t\n\r]+" (forall a b. a -> b -> a
const String
" ")

--------------------------------------------------------------------------------
-- | Function that strips CSS comments away (outside of strings).
stripComments :: String -> String
stripComments :: String -> String
stripComments String
""                       = String
""
stripComments (Char
'/':Char
'*':String
str)            = String -> String
stripComments forall a b. (a -> b) -> a -> b
$ String -> String
eatComment String
str
stripComments (Char
x:String
xs) | Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\"'"  = Char -> String -> (String -> String) -> String
retainString Char
x String
xs String -> String
stripComments
                     | Bool
otherwise       = Char
x forall a. a -> [a] -> [a]
: String -> String
stripComments String
xs

eatComment :: String -> String
eatComment :: String -> String
eatComment String
"" = String
""
eatComment (Char
'*':Char
'/':String
str) = String
str
eatComment (Char
_:String
str) = String -> String
eatComment String
str


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

-- TODO: handle backslash escapes
withoutStrings :: (String -> String) -> String -> String
withoutStrings :: (String -> String) -> String -> String
withoutStrings String -> String
f String
str = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
"\"'") String
str of
    (String
text, String
"")     -> String -> String
f String
text
    (String
text, Char
d:String
rest) -> String -> String
f String
text forall a. [a] -> [a] -> [a]
++ Char -> String -> (String -> String) -> String
retainString Char
d String
rest ((String -> String) -> String -> String
withoutStrings String -> String
f)

retainString :: Char -> String -> (String -> String) -> String
retainString :: Char -> String -> (String -> String) -> String
retainString Char
delim String
str String -> String
cont = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
delim) String
str of
    (String
val, String
"")     -> Char
delim forall a. a -> [a] -> [a]
: String
val
    (String
val, Char
_:String
rest) -> Char
delim forall a. a -> [a] -> [a]
: String
val forall a. [a] -> [a] -> [a]
++ Char
delim forall a. a -> [a] -> [a]
: String -> String
cont String
rest