--------------------------------------------------------------------------------
-- | 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 = (String -> String) -> Item String -> Item String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
compressCss (Item String -> Item String)
-> Compiler (Item String) -> Compiler (Item String)
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 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
compressWhitespace)
            (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace
            (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
            (String -> String) -> (String -> String) -> String -> String
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 -> String -> String
forall a b. a -> b -> a
const "}") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> (String -> String) -> String -> String
replaceAll ";+" (String -> String -> String
forall a b. a -> b -> a
const ";") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> (String -> String) -> String -> String
replaceAll " *[{};,>+~!] *" (Int -> String -> String
forall a. Int -> [a] -> [a]
take 1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> (String -> String) -> String -> String
replaceAll ": *" (Int -> String -> String
forall a. Int -> [a] -> [a]
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 :: (String -> String) -> String -> String
handleCalcExpressions transform :: String -> String
transform = (String -> String) -> String -> String
top String -> String
transform
  where
    top :: (String -> String) -> String -> String
top f :: String -> String
f ""                             = String -> String
f ""
    top f :: String -> String
f str :: String
str | "calc(" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str = String -> String
f "calc" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> (String -> String) -> String -> String
nested 0 String -> String
compressCalcExpression (Int -> String -> String
forall a. Int -> [a] -> [a]
drop 4 String
str)
    top f :: String -> String
f (x :: Char
x:xs :: String
xs)                         = (String -> String) -> String -> String
top (String -> String
f (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
xChar -> String -> String
forall 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 _     f :: String -> String
f ""                             = String -> String
f "" -- shouldn't happen, mismatched nesting
    nested depth :: Int
depth f :: String -> String
f str :: String
str | "calc(" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str = Int -> (String -> String) -> String -> String
nested Int
depth String -> String
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop 4 String
str)
    nested 1     f :: String -> String
f (')':xs :: String
xs)                       = String -> String
f ")" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String) -> String -> String
top String -> String
transform String
xs
    nested depth :: Int
depth f :: String -> String
f (x :: Char
x:xs :: String
xs)                         = Int -> (String -> String) -> String -> String
nested (case Char
x of
                                                      '(' -> Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
                                                      ')' -> Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 -- assert: depth > 1
                                                      _   -> Int
depth
                                                    ) (String -> String
f (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
xChar -> String -> String
forall 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 " *[*/] *| *\\)|\\( *" (Int -> String -> String
forall a. Int -> [a] -> [a]
take 1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
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 "[ \t\n\r]+" (String -> String -> String
forall a b. a -> b -> a
const " ")

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

eatComment :: String -> String
eatComment :: String -> String
eatComment "" = ""
eatComment ('*':'/':str :: String
str) = String
str
eatComment (_:str :: 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 f :: String -> String
f str :: String
str = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` "\"'") String
str of
    (text :: String
text, "")     -> String -> String
f String
text
    (text :: String
text, d :: Char
d:rest :: String
rest) -> String -> String
f String
text String -> String -> String
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 delim :: Char
delim str :: String
str cont :: String -> String
cont = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
delim) String
str of
    (val :: String
val, "")     -> Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: String
val
    (val :: String
val, _:rest :: String
rest) -> Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: String
val String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
cont String
rest