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
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
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
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)
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
nested :: Int -> (String -> String) -> String -> String
nested :: Int -> (String -> String) -> String -> String
nested _ f :: String -> String
f "" = String -> String
f ""
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
_ -> 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
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)
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 " ")
stripComments :: String -> String
"" = ""
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 ('*':'/':str :: String
str) = String
str
eatComment (_:str :: String
str) = String -> String
eatComment String
str
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