{-# LANGUAGE OverloadedStrings #-}
module Hasmin.Types.Declaration
( Declaration(..)
, clean
) where
import Control.Monad.Reader (Reader, ask)
import Control.Arrow (first)
import Control.Monad ((>=>))
import Data.Map.Strict (Map)
import Data.Monoid ((<>))
import Data.Foldable (toList)
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq, (|>))
import Data.List (find, delete, minimumBy, (\\))
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import Data.Text.Lazy.Builder (singleton, fromText)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Hasmin.Config
import Hasmin.Properties
import Hasmin.Types.BgSize
import Hasmin.Class
import Hasmin.Types.Dimension
import Hasmin.Types.Numeric
import Hasmin.Types.PercentageLength
import Hasmin.Types.Position
import Hasmin.Types.TransformFunction
import Hasmin.Types.Value
import Hasmin.Utils
data Declaration = Declaration
{ propertyName :: Text
, valueList :: Values
, isImportant :: Bool
, hasIEhack :: Bool
} deriving (Eq, Show)
instance ToText Declaration where
toBuilder (Declaration p vs i h) = fromText p <> singleton ':'
<> toBuilder vs <> imp <> iehack
where imp = if i then "!important" else mempty
iehack = if h then "\\9" else mempty
instance Ord Declaration where
d1 <= d2 = toText d1 <= toText d2
instance Minifiable Declaration where
minify d@(Declaration p vs _ _) = do
minifiedValues <- minify vs
conf <- ask
let name = case letterCase conf of
Lowercase -> T.toLower p
Original -> p
newDec = d {propertyName = name, valueList = minifiedValues }
case Map.lookup (T.toCaseFold p) propertyOptimizations of
Just f -> propertyTraits newDec >>= f
Nothing -> propertyTraits newDec
propertyTraits :: Declaration -> Reader Config Declaration
propertyTraits d@(Declaration p _ _ _) = do
conf <- ask
pure $ if shouldUsePropertyTraits conf
then case Map.lookup (T.toCaseFold p) propertiesTraits of
(Just (PropertyInfo vals inhs _ _)) -> minifyDec d vals inhs
Nothing -> d
else d
propertyOptimizations :: Map Text (Declaration -> Reader Config Declaration)
propertyOptimizations = Map.fromList
[("transform", combineTransformFunctions)
,("-webkit-transform", combineTransformFunctions)
,("-moz-transform", combineTransformFunctions)
,("font-family", optimizeValues optimizeFontFamily)
,("font-weight", fontWeightOptimizer)
,("background-size", nullPercentageToLength)
,("width", nullPercentageToLength)
,("perspective-origin", nullPercentageToLength)
,("-o-perspective-origin", nullPercentageToLength)
,("-moz-perspective-origin", nullPercentageToLength)
,("-webkit-perspective-origin", nullPercentageToLength)
,("background-position", nullPercentageToLength)
,("top", nullPercentageToLength)
,("right", nullPercentageToLength)
,("bottom", nullPercentageToLength)
,("left", nullPercentageToLength)
,("border-color", pure . reduceTRBLDec)
,("border-width", pure . reduceTRBLDec)
,("border-style", pure . reduceTRBLDec)
,("padding", nullPercentageToLength >=> pure . reduceTRBLDec)
,("padding-top", nullPercentageToLength)
,("padding-right", nullPercentageToLength)
,("padding-bottom", nullPercentageToLength)
,("padding-left", nullPercentageToLength)
,("margin-top", nullPercentageToLength)
,("margin-right", nullPercentageToLength)
,("margin-bottom", nullPercentageToLength)
,("margin-left", nullPercentageToLength)
,("margin", nullPercentageToLength >=> pure . reduceTRBLDec)
,("grid-row-gap", nullPercentageToLength)
,("grid-column-gap", nullPercentageToLength)
,("line-height", nullPercentageToLength)
,("min-height", nullPercentageToLength)
,("max-width", nullPercentageToLength)
,("min-width", nullPercentageToLength)
,("text-indent", nullPercentageToLength)
,("text-transform", nullPercentageToLength)
,("font-size", nullPercentageToLength)
,("word-spacing", nullPercentageToLength >=> replaceWithZero "normal")
,("vertical-align", nullPercentageToLength >=> replaceWithZero "baseline")
,("transform-origin", optimizeTransformOrigin >=> nullPercentageToLength)
,("-o-transform-origin", optimizeTransformOrigin >=> nullPercentageToLength)
,("-moz-transform-origin", optimizeTransformOrigin >=> nullPercentageToLength)
,("-ms-transform-origin", optimizeTransformOrigin >=> nullPercentageToLength)
,("-webkit-transform-origin", optimizeTransformOrigin >=> nullPercentageToLength)
]
optimizeValues :: (Value -> Reader Config Value)
-> Declaration -> Reader Config Declaration
optimizeValues f d@(Declaration _ vs _ _) = do
newV <- mapValues f vs
pure $ d {valueList = newV }
nullPercentageToLength :: Declaration -> Reader Config Declaration
nullPercentageToLength d = do
conf <- ask
if shouldConvertNullPercentages conf
then optimizeValues f d
else pure d
where f :: Value -> Reader Config Value
f (PositionV p@(Position _ a _ b)) = pure . PositionV $
let stripPercentage Nothing = Nothing
stripPercentage (Just x) = if isZero x
then l0
else Just x
in p { offset1 = stripPercentage a, offset2 = stripPercentage b }
f (PercentageV p) = pure $ zeroPercentageToLength p
where zeroPercentageToLength :: Percentage -> Value
zeroPercentageToLength 0 = LengthV NullLength
zeroPercentageToLength x = PercentageV x
f (BgSizeV bgsz) = pure . BgSizeV $
case bgsz of
BgSize1 x -> BgSize1 (zeroPerToLength x)
BgSize2 x y -> BgSize2 (zeroPerToLength x) (zeroPerToLength y)
x -> x
where zeroPerToLength (Left (Left 0)) = Left $ Right NullLength
zeroPerToLength z = z
f x = pure x
replaceWithZero :: Text -> Declaration -> Reader Config Declaration
replaceWithZero s d@(Declaration p (Values v vs) _ _)
| not (null vs) = pure d
| otherwise = pure $
case Map.lookup (T.toCaseFold p) propertiesTraits of
Just (PropertyInfo iv inhs _ _) ->
if f iv inhs == mkOther s
then d { valueList = Values (LengthV NullLength) [] }
else d
Nothing -> d
where f (Just (Values x _)) inh
| v == Initial || v == Unset && inh == NonInherited = x
| otherwise = v
f _ _ = v
fontWeightOptimizer :: Declaration -> Reader Config Declaration
fontWeightOptimizer = optimizeValues f
where f :: Value -> Reader Config Value
f x@(Other t) = do
conf <- ask
pure $ case fontweightSettings conf of
FontWeightMinOn -> replaceForSynonym t
FontWeightMinOff -> x
f x = pure x
replaceForSynonym :: TextV -> Value
replaceForSynonym t
| t == "normal" = NumberV 400
| t == "bold" = NumberV 700
| otherwise = Other t
optimizeTransformOrigin :: Declaration -> Reader Config Declaration
optimizeTransformOrigin d@(Declaration _ vals _ _) = do
conf <- ask
pure $ if shouldMinifyTransformOrigin conf
then d { valueList = optimizeTransformOrigin' vals}
else d
where
optimizeTransformOrigin' :: Values -> Values
optimizeTransformOrigin' v =
mkValues $ case valuesToList v of
[x, y, z] -> if isZeroVal z
then transformOrigin2 x y
else transformOrigin3 x y z
[x, y] -> transformOrigin2 x y
[x] -> transformOrigin1 x
x -> x
transformOrigin1 :: Value -> [Value]
transformOrigin1 (Other "top") = [Other "top"]
transformOrigin1 (Other "bottom") = [Other "bottom"]
transformOrigin1 (Other "right") = [PercentageV (Percentage 100)]
transformOrigin1 (Other "left") = [LengthV NullLength]
transformOrigin1 (Other "center") = [PercentageV (Percentage 50)]
transformOrigin1 (PercentageV 0) = [LengthV NullLength]
transformOrigin1 x = [x]
transformOrigin2 :: Value -> Value -> [Value]
transformOrigin2 x y
| equalsCenter x = firstIsCenter
| equalsCenter y = secondIsCenter
| isYoffsetKeyword x = fmap convertValue [y,x]
| isXoffsetKeyword y = fmap convertValue [y,x]
| otherwise = fmap convertValue [x,y]
where
firstIsCenter
| equalsCenter y = [per50]
| isYoffsetKeyword y = [y]
| y == per100 = [Other "bottom"]
| isZeroVal y = [Other "top"]
| isPercentageOrLength y = [per50, y]
| otherwise = transformOrigin1 y
secondIsCenter
| equalsCenter x = [per50]
| isYoffsetKeyword x || isPercentageOrLength x = [x]
| otherwise = transformOrigin1 x
isPercentageOrLength (PercentageV _) = True
isPercentageOrLength (LengthV _) = True
isPercentageOrLength _ = False
equalsCenter a = a == Other "center" || a == per50
isXoffsetKeyword a = a == Other "left" || a == Other "right"
isYoffsetKeyword a = a == Other "top" || a == Other "bottom"
per50 = PercentageV $ Percentage 50
per100 = PercentageV $ Percentage 100
convertValue (Other t) = fromMaybe (Other t) (Map.lookup (getText t) transformOriginKeywords)
convertValue n@(PercentageV p)
| p == 0 = LengthV NullLength
| otherwise = n
convertValue i = i
transformOrigin3 :: Value -> Value -> Value -> [Value]
transformOrigin3 x y z
| x == Other "top" || x == Other "bottom"
|| y == Other "left" || y == Other "right" = fmap replaceKeywords [y, x, z]
| otherwise = fmap replaceKeywords [x, y, z]
where
replaceKeywords :: Value -> Value
replaceKeywords (Other t) = fromMaybe x (Map.lookup (getText t) transformOriginKeywords)
replaceKeywords e = e
isZeroVal :: Value -> Bool
isZeroVal (LengthV (Length 0 _)) = True
isZeroVal (LengthV NullLength) = True
isZeroVal (NumberV (Number 0)) = True
isZeroVal (PercentageV 0) = True
isZeroVal _ = False
transformOriginKeywords :: Map Text Value
transformOriginKeywords = Map.fromList
[("top", LengthV NullLength)
,("right", PercentageV (Percentage 100))
,("bottom", PercentageV (Percentage 100))
,("left", LengthV NullLength)
,("center", PercentageV (Percentage 50))]
minifyDec :: Declaration -> Maybe Values -> Inheritance -> Declaration
minifyDec d@(Declaration p vs _ _) mv inhs =
case mv of
Just initialVals ->
case Map.lookup (T.toCaseFold p) declarationExceptions of
Just f -> f d initialVals inhs
Nothing -> reduceDeclaration d initialVals inhs
Nothing ->
if inhs == NonInherited && vs == initial || inhs == Inherited && vs == inherit
then d { valueList = unset }
else d
unset :: Values
unset = Values Unset mempty
initial :: Values
initial = Values Initial mempty
inherit :: Values
inherit = Values Inherit mempty
declarationExceptions :: Map Text (Declaration -> Values -> Inheritance -> Declaration)
declarationExceptions = Map.fromList $ map (first T.toCaseFold)
[("background-size", backgroundSizeReduce)
,("-webkit-background-size", backgroundSizeReduce)
,("border-bottom-left-radius", reduceDefaultingToFirst)
,("border-bottom-right-radius", reduceDefaultingToFirst)
,("border-top-left-radius", reduceDefaultingToFirst)
,("border-top-right-radius", reduceDefaultingToFirst)
,("font-synthesis", reduceTwoKeywordInitial)
,("overflow", reduceDefaultingToFirst)
,("overscroll-behavior", reduceDefaultingToFirst)
,("text-emphasis-position", reduceTwoKeywordInitial)
,("text-shadow", \d _ _ -> d)
]
where
reduceTwoKeywordInitial :: Declaration -> Values -> Inheritance -> Declaration
reduceTwoKeywordInitial d@(Declaration _ vs _ _) initVals inhs =
case valuesToList initVals \\ valuesToList vs of
[] -> d {valueList = shortestEquiv initial initVals inhs}
_ -> d {valueList = shortestEquiv vs initVals inhs}
reduceDefaultingToFirst :: Declaration -> Values -> Inheritance -> Declaration
reduceDefaultingToFirst d@(Declaration _ vs _ _) initVals inhs =
case valuesToList vs of
[v1,v2] -> if v1 == v2
then reduceDeclaration (d { valueList = mkValues [v1] }) initVals inhs
else d
_ -> reduceDeclaration d initVals inhs
backgroundSizeReduce :: Declaration -> Values -> Inheritance -> Declaration
backgroundSizeReduce d@(Declaration _ vs _ _) initVals inhs =
case valuesToList vs of
[v1,v2] -> if v2 == mkOther "auto"
then d { valueList = mkValues [v1] }
else d
_ -> d { valueList = shortestEquiv vs initVals inhs }
combineTransformFunctions :: Declaration -> Reader Config Declaration
combineTransformFunctions d@(Declaration _ vs _ _) = do
combinedFuncs <- combine (toList tfValues)
let newVals = fmap TransformV combinedFuncs ++ toList otherValues
pure $ d { valueList = mkValues newVals}
where
decValues = valuesToList vs
(tfValues, otherValues) = splitValues decValues
splitValues = splitValues' (mempty, mempty)
where
splitValues' :: (Seq TransformFunction, Seq Value) -> [Value]
-> (Seq TransformFunction, Seq Value)
splitValues' (ts, os) (TransformV x:xs) = splitValues' (ts |> x, os) xs
splitValues' (ts, os) (x:xs) = splitValues' (ts, os |> x) xs
splitValues' (ts, os) [] = (ts, os)
reduceDeclaration :: Declaration -> Values -> Inheritance -> Declaration
reduceDeclaration d@(Declaration _ vs _ _) initVals inhs =
case analyzeValueDifference vs initVals of
Just v -> d {valueList = shortestEquiv v shortestInitialValue inhs}
Nothing -> d {valueList = minVal inhs shortestInitialValue}
where
charLen x y = compare (textualLength x) (textualLength y)
shortestInitialValue = mkValues [minimumBy charLen (valuesToList initVals)]
shortestEquiv :: Values -> Values -> Inheritance -> Values
shortestEquiv vs siv i
| i == Inherited && vs == inherit = unset
| i == NonInherited && vs == unset || vs == initial = minVal i siv
| otherwise = vs
minVal :: Inheritance -> Values -> Values
minVal inhs vs
| textualLength globalKeyword <= textualLength vs = globalKeyword
| otherwise = vs
where globalKeyword = mkValues [if inhs == NonInherited then Unset else Initial]
analyzeValueDifference :: Values -> Values -> Maybe Values
analyzeValueDifference vs initVals =
case valuesDifference of
[] -> Nothing
_ -> Just $ mkValues valuesDifference
where valuesDifference = valuesToList vs \\ valuesToList initVals
clean :: [Declaration] -> [Declaration]
clean [] = []
clean (d:ds) =
let (newD, newDs) = solveClashes ds d pinfo
in case newD of
Just x -> x : clean newDs
Nothing -> clean newDs
where pinfo = fromMaybe (PropertyInfo Nothing NonInherited mempty mempty)
(Map.lookup (propertyName d) propertiesTraits)
solveClashes :: [Declaration] -> Declaration
-> PropertyInfo -> (Maybe Declaration, [Declaration])
solveClashes ds = solveClashes' ds ds
solveClashes' :: [Declaration] -> [Declaration] -> Declaration
-> PropertyInfo -> (Maybe Declaration, [Declaration])
solveClashes' newDs [] dec _ = (Just dec, newDs)
solveClashes' newDs (laterDec:ds) dec pinfo
| hasVendorPrefix dec = (Just dec, newDs)
| hasVendorPrefix laterDec || hasIEhack dec /= hasIEhack laterDec =
solveClashes' newDs ds dec pinfo
| propertyName laterDec `elem` subproperties pinfo =
attemptMerge newDs ds dec laterDec pinfo
| propertyName laterDec `elem` overwrittenBy pinfo =
if isImportant dec && (not . isImportant) laterDec
then solveClashes' newDs ds dec pinfo
else (Nothing, newDs)
| propertyName dec == propertyName laterDec =
if isImportant dec && (not . isImportant) laterDec
then solveClashes' (delete laterDec newDs) ds dec pinfo
else (Nothing, newDs)
| otherwise = solveClashes' newDs ds dec pinfo
hasVendorPrefix :: Declaration -> Bool
hasVendorPrefix (Declaration _ vs _ _) = any isVendorPrefixedValue $ valuesToList vs
where isVendorPrefixedValue :: Value -> Bool
isVendorPrefixedValue (Other t) = T.isPrefixOf "-" $ getText t
isVendorPrefixedValue (GradientV t _) = T.isPrefixOf "-" t
isVendorPrefixedValue (GenericFunc t _) = T.isPrefixOf "-" t
isVendorPrefixedValue _ = False
attemptMerge :: [Declaration] -> [Declaration] -> Declaration
-> Declaration -> PropertyInfo
-> (Maybe Declaration, [Declaration])
attemptMerge newDs ds dec laterDec pinfo =
case merge dec laterDec of
Just m -> (Nothing, m : delete dec (delete laterDec newDs))
Nothing -> solveClashes' newDs ds dec pinfo
merge :: Declaration -> Declaration -> Maybe Declaration
merge d1@(Declaration p1 _ _ _) d2@Declaration{} = do
mergeFunction <- Map.lookup p1 propertyMergers
mergeFunction d1 d2
where propertyMergers :: Map Text (Declaration -> Declaration -> Maybe Declaration)
propertyMergers = Map.fromList [("margin", mergeIntoTRBL)
,("padding", mergeIntoTRBL)
,("border-color", mergeIntoTRBL)
,("border-width", mergeIntoTRBL)
,("border-style", mergeIntoTRBL)
]
mergeIntoTRBL :: Declaration
-> Declaration
-> Maybe Declaration
mergeIntoTRBL d1@(Declaration _ (Values v1 vs) i1 h1) d2@(Declaration p2 (Values v2 _) i2 h2)
| h1 || h2 = Nothing
| i1 && not i2 = Just $ reduceTRBLDec d1
| not i1 && i2 = Nothing
| otherwise = do
(_,index) <- find (\(x,_) -> T.isInfixOf x (T.toCaseFold p2)) indexTable
let mkDec ys = d1 {valueList = mkValues $ replaceAt index v2 ys}
retDec ys = let mergedDec = reduceTRBLDec (mkDec ys)
in if textualLength mergedDec <= originalLength
then Just mergedDec
else Nothing
case trblValues of
[_,_,_,_] -> retDec trblValues
[t,r,b] -> retDec [t,r,b,r]
[t,r] -> retDec [t,r,t,r]
[t] -> retDec [t,t,t,t]
_ -> Nothing
where originalLength = textualLength d1 + textualLength d2 + 1
trblValues = v1 : map snd vs
indexTable = zip ["top", "right", "bottom", "left"] [0..]
reduceTRBLDec :: Declaration -> Declaration
reduceTRBLDec d@(Declaration _ (Values v1 vs) _ _) =
d { valueList = mkValues . NE.toList $ reduceTRBL (v1:|map snd vs) }
mapValues :: (Value -> Reader Config Value) -> Values -> Reader Config Values
mapValues f (Values v1 vs) = do
x <- f v1
xs <- (mapM . mapM) f vs
pure $ Values x xs