diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,23 @@ # Changelog +## 0.3.3 +Added a simple merging of adjacent media queries (`@media` rules), e.g.: +```css +@media all and (min-width: 24rem) { + a { font-size: 1.2rem; } +} +@media all and (min-width: 24rem) { + b { padding-left: .25rem; padding-right: .25rem; } +} +``` +Gets merged into into: +```css +@media all and (min-width: 24rem) { + a { font-size: 1.2rem; } + b { padding-left: .25rem; padding-right: .25rem; } +} +``` + ## 0.3.2.4 * Relaxed doctest upper bound once more, see [stackage issue 2663](https://github.com/fpco/stackage/issues/2663#issuecomment-319880160). diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -11,10 +11,9 @@ module Main where import Codec.Compression.Hopfli -import Control.Monad.Reader +import Control.Applicative (liftA2) import Data.Monoid ((<>)) -import Data.Attoparsec.Text (parseOnly) -import Data.Text.Lazy.Builder (toLazyText) +import Data.Text (Text) import Options.Applicative hiding (command) import Data.Version (showVersion) import Development.GitRev (gitHash) @@ -22,19 +21,15 @@ import qualified Data.ByteString as B import qualified Data.Text.Encoding as TE import qualified Data.Text.IO as TIO -import qualified Data.Text.Lazy as TL import System.Exit (die) import Hasmin.Config -import Hasmin.Parser.Internal -import Hasmin.Types.Class -import Hasmin.Types.Stylesheet +import Hasmin command :: Parser Commands -command = Commands <$> switch (long "beautify" - <> short 'b' <> help "Beautify output") - <*> switch (long "zopfli" - <> short 'z' <> help "Compress result using zopfli") - <*> argument str (metavar "FILE") +command = Commands + <$> switch (long "beautify" <> short 'b' <> help "Beautify output") + <*> switch (long "zopfli" <> short 'z' <> help "Compress result using zopfli") + <*> argument str (metavar "FILE") config :: Parser Config config = Config @@ -45,8 +40,7 @@ <> short 'd' <> help "Enable normalization of absolute dimensions") <*> flag GradientMinOn GradientMinOff (long "-no-gradient-min" - <> short 'g' - <> help "Disable minification") + <> short 'g' <> help "Disable minification") <*> flag True False (long "no-property-traits" <> short 't' <> help "Disable use of property traits for declaration minification") @@ -92,7 +86,7 @@ <> help "Disable sorting properties lexicographically") instructions :: ParserInfo Instructions -instructions = info (helper <*> versionOption <*> ((,) <$> command <*> config)) +instructions = info (helper <*> versionOption <*> liftA2 (,) command config) (fullDesc <> header "Hasmin - A Haskell CSS Minifier") where versionOption = infoOption (showVersion version <> " " <> $(gitHash)) (long "version" <> help "Show version and commit hash") @@ -101,17 +95,11 @@ main = do (comm, conf) <- execParser instructions text <- TIO.readFile (file comm) - case parseOnly stylesheet text of - Right r -> process r comm conf - Left e -> die e - -process :: [Rule] -> Commands -> Config -> IO () -process r comm conf - | shouldBeautify comm = error "Currently unsupported" - | shouldCompress comm = B.writeFile "output.gz" . compressWith defaultCompressOptions GZIP . TE.encodeUtf8 $ output - | otherwise = TIO.putStr output - where sheet = let ruleList = fmap (\x -> runReader (minifyWith x) conf) r - in if shouldRemoveEmptyBlocks conf - then filter (not . isEmpty) ruleList - else ruleList - output = TL.toStrict . toLazyText $ mconcat (fmap toBuilder sheet) + case minifyCSSWith conf text of + Right rs -> process rs comm + Left e -> die e + where process :: Text -> Commands -> IO () + process ts comm + | shouldBeautify comm = error "Currently unsupported" + | shouldCompress comm = B.writeFile "output.gz" . compressWith defaultCompressOptions GZIP . TE.encodeUtf8 $ ts + | otherwise = TIO.putStr ts diff --git a/hasmin.cabal b/hasmin.cabal --- a/hasmin.cabal +++ b/hasmin.cabal @@ -1,5 +1,5 @@ name: hasmin -version: 0.3.2.4 +version: 0.3.3 license: BSD3 license-file: LICENSE author: (c) 2017 Cristian Adrián Ontivero @@ -30,7 +30,7 @@ executable hasmin default-language: Haskell2010 - ghc-options: -O2 -Wall -fwarn-tabs -fwarn-unused-do-bind -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-import-lists -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -Wredundant-constraints + ghc-options: -O2 -Wall -fwarn-tabs -fwarn-unused-do-bind -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -Wredundant-constraints main-is: Main.hs other-modules: Paths_hasmin build-depends: base >=4.9 && <5.1 @@ -50,7 +50,7 @@ library default-language: Haskell2010 hs-source-dirs: src - ghc-options: -O2 -Wall -fwarn-tabs -fwarn-unused-do-bind -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-import-lists -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -Wredundant-constraints + ghc-options: -O2 -Wall -fwarn-tabs -fwarn-unused-do-bind -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -Wredundant-constraints exposed-modules: Hasmin , Hasmin.Config , Hasmin.Types.Class diff --git a/src/Hasmin.hs b/src/Hasmin.hs --- a/src/Hasmin.hs +++ b/src/Hasmin.hs @@ -26,6 +26,7 @@ import Hasmin.Parser.Internal import Hasmin.Types.Class +import Hasmin.Types.Stylesheet import Hasmin.Config -- | Minify Text, based on a 'Config'. To just use a default set of @@ -33,8 +34,8 @@ minifyCSSWith :: Config -> Text -> Either String Text minifyCSSWith cfg t = do sheet <- parseOnly stylesheet t - pure . TL.toStrict . toLazyText . mconcat $ map f sheet - where f x = toBuilder $ runReader (minifyWith x) cfg + let rs = runReader (minifyRules sheet) cfg + pure . TL.toStrict . toLazyText . mconcat $ map toBuilder rs -- | Minify Text CSS, using a default set of configurations (with most -- minification techniques enabled). diff --git a/src/Hasmin/Parser/Internal.hs b/src/Hasmin/Parser/Internal.hs --- a/src/Hasmin/Parser/Internal.hs +++ b/src/Hasmin/Parser/Internal.hs @@ -11,6 +11,7 @@ module Hasmin.Parser.Internal ( stylesheet , atRule + , rule , declaration , declarations , selector diff --git a/src/Hasmin/Parser/Value.hs b/src/Hasmin/Parser/Value.hs --- a/src/Hasmin/Parser/Value.hs +++ b/src/Hasmin/Parser/Value.hs @@ -295,54 +295,54 @@ position = pos4 <|> pos2 <|> pos1 pos1 :: Parser Position -pos1 = (asciiCI "left" $> (f $ Just PosLeft)) - <|> (asciiCI "center" $> (f $ Just PosCenter)) - <|> (asciiCI "right" $> (f $ Just PosRight)) - <|> (asciiCI "top" $> (f $ Just PosTop)) - <|> (asciiCI "bottom" $> (f $ Just PosBottom)) +pos1 = (asciiCI "left" $> f (Just PosLeft)) + <|> (asciiCI "center" $> f (Just PosCenter)) + <|> (asciiCI "right" $> f (Just PosRight)) + <|> (asciiCI "top" $> f (Just PosTop)) + <|> (asciiCI "bottom" $> f (Just PosBottom)) <|> ((\a -> Position Nothing a Nothing Nothing) <$> (Just <$> percentageLength)) where f x = Position x Nothing Nothing Nothing pos2 :: Parser Position pos2 = firstx <|> firsty where firstx = do - a <- (asciiCI "left" $> (Position (Just PosLeft) Nothing)) - <|> (asciiCI "center" $> (Position (Just PosCenter) Nothing)) - <|> (asciiCI "right" $> (Position (Just PosRight) Nothing)) + a <- (asciiCI "left" $> Position (Just PosLeft) Nothing) + <|> (asciiCI "center" $> Position (Just PosCenter) Nothing) + <|> (asciiCI "right" $> Position (Just PosRight) Nothing) <|> ((Position Nothing . Just) <$> percentageLength) - skipComments *> ((asciiCI "top" $> (a (Just PosTop) Nothing)) - <|> (asciiCI "center" $> (a (Just PosCenter) Nothing)) - <|> (asciiCI "bottom" $> (a (Just PosBottom) Nothing)) + skipComments *> ((asciiCI "top" $> a (Just PosTop) Nothing) + <|> (asciiCI "center" $> a (Just PosCenter) Nothing) + <|> (asciiCI "bottom" $> a (Just PosBottom) Nothing) <|> ((a Nothing . Just) <$> percentageLength)) firsty = do - a <- (asciiCI "top" $> (Position (Just PosTop) Nothing)) - <|> (asciiCI "center" $> (Position (Just PosCenter) Nothing)) - <|> (asciiCI "bottom" $> (Position (Just PosBottom) Nothing)) + a <- (asciiCI "top" $> Position (Just PosTop) Nothing) + <|> (asciiCI "center" $> Position (Just PosCenter) Nothing) + <|> (asciiCI "bottom" $> Position (Just PosBottom) Nothing) <|> ((Position Nothing . Just) <$> percentageLength) - skipComments *> ((asciiCI "left" $> (a (Just PosLeft) Nothing)) - <|> (asciiCI "center" $> (a (Just PosCenter) Nothing)) - <|> (asciiCI "right" $> (a (Just PosRight) Nothing)) + skipComments *> ((asciiCI "left" $> a (Just PosLeft) Nothing) + <|> (asciiCI "center" $> a (Just PosCenter) Nothing) + <|> (asciiCI "right" $> a (Just PosRight) Nothing) <|> ((a Nothing . Just) <$> percentageLength)) pos4 :: Parser Position pos4 = firstx <|> firsty - where posTop = asciiCI "top" $> (Position (Just PosTop)) - posRight = asciiCI "right" $> (Position (Just PosRight)) - posBottom = asciiCI "bottom" $> (Position (Just PosBottom)) - posLeft = asciiCI "left" $> (Position (Just PosLeft)) + where posTop = asciiCI "top" $> Position (Just PosTop) + posRight = asciiCI "right" $> Position (Just PosRight) + posBottom = asciiCI "bottom" $> Position (Just PosBottom) + posLeft = asciiCI "left" $> Position (Just PosLeft) firstx = do - x <- (asciiCI "center" $> (Position (Just PosCenter) Nothing)) + x <- (asciiCI "center" $> Position (Just PosCenter) Nothing) <|> ((posLeft <|> posRight) <*> (skipComments *> option Nothing (Just <$> percentageLength))) _ <- skipComments - (asciiCI "center" $> (x (Just PosCenter) Nothing)) - <|> (((asciiCI "top" $> (x $ Just PosTop)) <|> (asciiCI "bottom" $> (x (Just PosBottom)))) + (asciiCI "center" $> x (Just PosCenter) Nothing) + <|> (((asciiCI "top" $> x (Just PosTop)) <|> (asciiCI "bottom" $> x (Just PosBottom))) <*> (skipComments *> option Nothing (Just <$> percentageLength))) firsty = do - x <- (asciiCI "center" $> (Position (Just PosCenter) Nothing)) + x <- (asciiCI "center" $> Position (Just PosCenter) Nothing) <|> ((posTop <|> posBottom) <*> (skipComments *> option Nothing (Just <$> percentageLength))) _ <- skipComments - (asciiCI "center" $> (x (Just PosCenter) Nothing)) - <|> (((asciiCI "left" $> (x $ Just PosLeft)) <|> (asciiCI "right" $> (x (Just PosRight)))) + (asciiCI "center" $> x (Just PosCenter) Nothing) + <|> (((asciiCI "left" $> x (Just PosLeft)) <|> (asciiCI "right" $> x (Just PosRight))) <*> (skipComments *> option Nothing (Just <$> percentageLength))) {- diff --git a/src/Hasmin/Properties.hs b/src/Hasmin/Properties.hs --- a/src/Hasmin/Properties.hs +++ b/src/Hasmin/Properties.hs @@ -15,7 +15,7 @@ ) where import Data.Attoparsec.Text (parseOnly) -import Data.Text (Text, unpack) +import Data.Text (Text) import Control.Applicative ((<|>)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map diff --git a/src/Hasmin/Types/Declaration.hs b/src/Hasmin/Types/Declaration.hs --- a/src/Hasmin/Types/Declaration.hs +++ b/src/Hasmin/Types/Declaration.hs @@ -18,9 +18,11 @@ 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.Text (Text) +import Data.Text (Text) import Data.Text.Lazy.Builder (singleton, fromText) import qualified Data.Map.Strict as Map import qualified Data.Text as T @@ -37,15 +39,15 @@ import Hasmin.Types.Value import Hasmin.Utils -data Declaration = Declaration { propertyName :: Text +data Declaration = Declaration { propertyName :: Text , valueList :: Values , isImportant :: Bool -- ends with !important , hasIEhack :: Bool -- ends with \9 } deriving (Eq, Show) instance ToText Declaration where - toBuilder (Declaration p vs i h) = fromText p <> singleton ':' + toBuilder (Declaration p vs i h) = fromText p <> singleton ':' <> toBuilder vs <> imp <> (if h then " \\9" else mempty) - where imp | i = "!important" + where imp | i = "!important" | otherwise = mempty instance Minifiable Declaration where @@ -125,7 +127,7 @@ ] -- Generic function to map some optimization to a property's values. -optimizeValues :: (Value -> Reader Config Value) +optimizeValues :: (Value -> Reader Config Value) -> Declaration -> Reader Config Declaration optimizeValues f d@(Declaration _ vs _ _) = do newV <- mapValues f vs @@ -134,7 +136,7 @@ -- converts 0% into 0 (of type ) -- Do NOT use it with height and max-height, since 0% /= 0 nullPercentageToLength :: Declaration -> Reader Config Declaration -nullPercentageToLength d = do +nullPercentageToLength d = do conf <- ask if shouldConvertNullPercentages conf then optimizeValues f d @@ -142,7 +144,7 @@ where f :: Value -> Reader Config Value f (PositionV p@(Position _ a _ b)) = pure . PositionV $ let stripPercentage Nothing = Nothing - stripPercentage (Just x) = if isZero x + stripPercentage (Just x) = if isZero x then l0 else Just x in p { offset1 = stripPercentage a, offset2 = stripPercentage b } @@ -152,8 +154,8 @@ zeroPercentageToLength x = PercentageV x f (BgSizeV (BgSize x y)) = pure . BgSizeV $ BgSize (zeroPerToLength x) (fmap zeroPerToLength y) where zeroPerToLength (Left (Left 0)) = Left $ Right (Distance 0 Q) - zeroPerToLength z = z - f x = pure x + zeroPerToLength z = z + f x = pure x -- For word-spacing, normal computes to 0. -- For vertical-align, baseline is the same as 0. @@ -163,7 +165,7 @@ replaceWithZero :: Text -> Declaration -> Reader Config Declaration replaceWithZero s d@(Declaration p (Values v vs) _ _) | not (null vs) = pure d -- Some error occured, since there should be only one value - | otherwise = + | otherwise = case Map.lookup (T.toCaseFold p) propertiesTraits of Just (iv, inhs) -> if f iv inhs == mkOther s then pure $ d { valueList = Values (DistanceV (Distance 0 Q)) [] } @@ -171,19 +173,19 @@ Nothing -> pure d where f (Just (Values x _)) inh | v == Initial || v == Unset && not inh = x - | otherwise = v + | otherwise = v f _ _ = v -- Converts the keywords "normal" and "bold" to 400 and 700, respectively. fontWeightOptimizer :: Declaration -> Reader Config Declaration -fontWeightOptimizer = optimizeValues f +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 + f x = pure x replaceForSynonym :: TextV -> Value replaceForSynonym t @@ -259,7 +261,7 @@ transformOrigin3 :: Value -> Value -> Value -> [Value] transformOrigin3 x y z - | x == Other "top" || x == Other "bottom" + | 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 @@ -268,7 +270,7 @@ -- transform-origin keyword meanings. transformOriginKeywords :: Map Text Value -transformOriginKeywords = Map.fromList +transformOriginKeywords = Map.fromList [("top", DistanceV (Distance 0 Q)) ,("right", PercentageV (Percentage 100)) ,("bottom", PercentageV (Percentage 100)) @@ -281,7 +283,7 @@ -- configurations. minifyDec :: Declaration -> Maybe Values -> Bool -> Declaration minifyDec d@(Declaration p vs _ _) mv inherits = - case mv of + case mv of -- Use the found initial values to try to reduce the declaration Just vals -> case Map.lookup (T.toCaseFold p) declarationExceptions of @@ -290,7 +292,7 @@ Just f -> f d vals inherits Nothing -> reduceDeclaration d vals inherits -- Property with no defined initial values. Try to reduce css-wide keywords - Nothing -> + Nothing -> if not inherits && vs == initial || inherits && vs == inherit then d { valueList = unset } else d @@ -319,13 +321,17 @@ combineTransformFunctions :: Declaration -> Reader Config Declaration combineTransformFunctions d@(Declaration _ vs _ _) = do - combinedFuncs <- combine $ fmap (\(TransformV x) -> x) tfuncs - let newVals = fmap TransformV combinedFuncs ++ (decValues \\ tfuncs) + combinedFuncs <- combine (toList tfValues) + let newVals = fmap TransformV combinedFuncs ++ toList otherValues pure $ d { valueList = mkValues newVals} - where decValues = valuesToList vs - tfuncs = filter isTransformFunction decValues - isTransformFunction (TransformV _) = True - isTransformFunction _ = False + 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) backgroundSizeReduce :: Declaration -> Values -> Bool -> Declaration backgroundSizeReduce d@(Declaration _ vs _ _) initVals inherits = @@ -349,7 +355,7 @@ -- property that qualifies is border-bottom, and one that doesn't is -- font-synthesis (because it isn't a shorthand). reduceDeclaration :: Declaration -> Values -> Bool -> Declaration -reduceDeclaration d@(Declaration _ vs _ _) initVals inherits = +reduceDeclaration d@(Declaration _ vs _ _) initVals inherits = case analyzeValueDifference vs initVals of Just v -> d {valueList = shortestEquiv v shortestInitialValue inherits} Nothing -> d {valueList = minVal inherits shortestInitialValue} @@ -373,13 +379,13 @@ | textualLength globalKeyword <= textualLength vs = globalKeyword | otherwise = vs where globalKeyword = mkValues [if not inherits then Unset else Initial] - + -- Substract declaration values to the property's initial value list. -- If nothing remains (i.e. every value declared was an initial one and may be -- left implicit), then just replace it with whatever initial value is the -- shortest, otherwise whatever remains is the shortest equivalent declaration. analyzeValueDifference :: Values -> Values -> Maybe Values -analyzeValueDifference vs initVals = +analyzeValueDifference vs initVals = case valuesDifference of [] -> Nothing -- every value was an initial one _ -> Just $ mkValues valuesDifference -- At least a value wasn't an initial one, or it was a css-wide keyword @@ -402,7 +408,7 @@ -- longhand later in the list, merges them. If it is a longhand overwritten by -- a shorthand, it deletes it. Otherwise, it keeps the value. In any case, it -- returns the new list to analyze and (if any) the value to keep. -solveClashes :: [Declaration] -> Declaration +solveClashes :: [Declaration] -> Declaration -> PropertyInfo -> (Maybe Declaration, [Declaration]) solveClashes ds = solveClashes' ds ds @@ -413,7 +419,7 @@ solveClashes' newDs (laterDec:ds) dec pinfo -- Do not remove vendor-prefixed values, which are probably fallbacks. | hasVendorPrefix dec = (Just dec, newDs) - | hasVendorPrefix laterDec || hasIEhack dec /= hasIEhack laterDec = + | hasVendorPrefix laterDec || hasIEhack dec /= hasIEhack laterDec = solveClashes' newDs ds dec pinfo | propertyName laterDec `elem` subproperties pinfo = attemptMerge newDs ds dec laterDec pinfo @@ -442,7 +448,7 @@ isVendorPrefixedValue _ = False attemptMerge :: [Declaration] -> [Declaration] -> Declaration - -> Declaration -> PropertyInfo + -> Declaration -> PropertyInfo -> (Maybe Declaration, [Declaration]) attemptMerge newDs ds dec laterDec pinfo = case merge dec laterDec of @@ -464,19 +470,19 @@ ,("border-color", mergeIntoTRBL) ,("border-width", mergeIntoTRBL) ,("border-style", mergeIntoTRBL) - --,("animation", + --,("animation", --,("background", - --,("background-position", + --,("background-position", --,("border", - --,("border-bottom", + --,("border-bottom", --,("border-image", - --,("border-left", + --,("border-left", --,("border-radius" --,("border-right", --,("border-top" --,("column-rule", --,("columns", - --,("flex", + --,("flex", --,("flex-flow", --,("font", --,("grid", @@ -486,10 +492,10 @@ --,("grid-row", --,("grid-template", --,("list-style", - --,("mask", + --,("mask", --,("outline", --,("padding", - --,("text-decoration", + --,("text-decoration", --,("text-emphasis" --,("transition", ] @@ -534,7 +540,7 @@ [t,r,b,l] -> reduce4 t r b l [t,r,b] -> reduce3 t r b [t,r] -> reduce2 t r - _ -> d + _ -> d where reduce4 tv rv bv lv | lv == rv = reduce3 tv rv bv | otherwise = d diff --git a/src/Hasmin/Types/FilterFunction.hs b/src/Hasmin/Types/FilterFunction.hs --- a/src/Hasmin/Types/FilterFunction.hs +++ b/src/Hasmin/Types/FilterFunction.hs @@ -86,6 +86,9 @@ then minifyPseudoShadow DropShadow a b c d else pure s +minifyPseudoShadow :: (Minifiable b, Minifiable t1, Minifiable t2, Traversable t) + => (t2 -> t1 -> Maybe Distance -> t b -> b1) + -> t2 -> t1 -> Maybe Distance -> t b -> Reader Config b1 minifyPseudoShadow constr a b c d = do x <- minifyWith a y <- minifyWith b diff --git a/src/Hasmin/Types/Gradient.hs b/src/Hasmin/Types/Gradient.hs --- a/src/Hasmin/Types/Gradient.hs +++ b/src/Hasmin/Types/Gradient.hs @@ -8,14 +8,19 @@ -- Portability : non-portable -- ----------------------------------------------------------------------------- -module Hasmin.Types.Gradient ( - Gradient(..), Side(..), ColorStop(..), Size(..), Shape(..) +module Hasmin.Types.Gradient + ( Gradient(..) + , Side(..) + , ColorStop(..) + , Size(..) + , Shape(..) ) where import Control.Monad.Reader (Reader, ask) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton) import Data.Maybe (catMaybes, fromJust, isNothing, isJust) +import Data.Either (isLeft) import Hasmin.Config import Hasmin.Types.Class import Hasmin.Types.Color @@ -295,6 +300,7 @@ handleEither (Left a) (Right s) = angleSideEq a s handleEither (Right s) (Left a) = angleSideEq a s handleEither s1 s2 = s1 == s2 + _ == _ = error "Non supported gradient comparison" angleSideEq :: Angle -> SideOrCorner -> Bool angleSideEq (Angle 0 Deg) (TopSide, Nothing) = True diff --git a/src/Hasmin/Types/PercentageLength.hs b/src/Hasmin/Types/PercentageLength.hs --- a/src/Hasmin/Types/PercentageLength.hs +++ b/src/Hasmin/Types/PercentageLength.hs @@ -8,8 +8,10 @@ -- Portability : non-portable -- ----------------------------------------------------------------------------- -module Hasmin.Types.PercentageLength ( - PercentageLength, isZero, isNonZeroPercentage +module Hasmin.Types.PercentageLength + ( PercentageLength + , isZero + , isNonZeroPercentage ) where import Hasmin.Types.Dimension diff --git a/src/Hasmin/Types/Position.hs b/src/Hasmin/Types/Position.hs --- a/src/Hasmin/Types/Position.hs +++ b/src/Hasmin/Types/Position.hs @@ -25,9 +25,9 @@ import Hasmin.Types.PercentageLength import Hasmin.Utils -data PosKeyword = PosCenter +data PosKeyword = PosCenter | PosLeft - | PosRight + | PosRight | PosTop | PosBottom deriving (Eq, Show) @@ -92,7 +92,7 @@ then Position Nothing l0 Nothing l0 else case b of Left 50 -> Position Nothing l0 Nothing Nothing - Left 100 -> Position Nothing l0 Nothing p100 + Left 100 -> Position Nothing l0 Nothing p100 _ -> p { offset1 = l0 } | isZero b = case a of Left 50 -> Position (Just PosTop) Nothing Nothing Nothing @@ -100,7 +100,7 @@ _ -> p { offset2 = l0 } | b == Left 50 = Position Nothing (Just a) Nothing Nothing | otherwise = p -minifyPosition (Position (Just x) (Just y) Nothing Nothing) = +minifyPosition (Position (Just x) (Just y) Nothing Nothing) = uncurry (\a b -> Position a b Nothing Nothing) (minAxis x y) -- 2 keywords minifyPosition p@(Position (Just x) Nothing (Just y) Nothing) = f x y @@ -118,7 +118,7 @@ f PosCenter PosTop = p { origin1 = Just PosTop, origin2 = Nothing } -- 'right top' and 'top right' == '100% 0%'. f PosRight PosTop = Position Nothing p100 Nothing l0 - f PosTop PosRight = Position Nothing p100 Nothing l0 + f PosTop PosRight = Position Nothing p100 Nothing l0 -- 'right', 'right center', 'center right' == '100% 50%'. f PosRight PosCenter = Position Nothing p100 Nothing Nothing f PosCenter PosRight = Position Nothing p100 Nothing Nothing @@ -135,40 +135,40 @@ -- keyword pl keyword syntax minifyPosition p@(Position (Just x) (Just y) (Just z) Nothing) | x == PosTop || x == PosBottom || z == PosLeft || z == PosRight = - minifyPosition $ Position (Just z) Nothing (Just x) (Just y) + minifyPosition $ Position (Just z) Nothing (Just x) (Just y) | otherwise = minifyPos3 x y z where minifyPos3 PosLeft b PosBottom - | isZero b = Position Nothing l0 Nothing p100 - | b == Left 50 = Position (Just PosBottom) Nothing Nothing Nothing - | otherwise = Position Nothing (Just b) Nothing p100 + | isZero b = Position Nothing l0 Nothing p100 + | b == Left 50 = Position (Just PosBottom) Nothing Nothing Nothing + | otherwise = Position Nothing (Just b) Nothing p100 minifyPos3 PosLeft b PosTop - | isZero b = Position Nothing l0 Nothing l0 - | b == Left 50 = Position (Just PosTop) Nothing Nothing Nothing - | otherwise = Position Nothing (Just b) Nothing l0 + | isZero b = Position Nothing l0 Nothing l0 + | b == Left 50 = Position (Just PosTop) Nothing Nothing Nothing + | otherwise = Position Nothing (Just b) Nothing l0 minifyPos3 PosLeft b PosCenter - | isZero b = Position Nothing l0 Nothing Nothing - | b == Left 50 = Position Nothing p50 Nothing Nothing - | otherwise = Position Nothing (Just b) Nothing p50 + | isZero b = Position Nothing l0 Nothing Nothing + | b == Left 50 = Position Nothing p50 Nothing Nothing + | otherwise = Position Nothing (Just b) Nothing p50 minifyPos3 PosRight b PosTop - | isZero b = Position Nothing p100 Nothing l0 - | otherwise = Position (Just PosRight) (Just b) Nothing l0 + | isZero b = Position Nothing p100 Nothing l0 + | otherwise = Position (Just PosRight) (Just b) Nothing l0 minifyPos3 PosRight b PosBottom - | isZero b = Position Nothing p100 Nothing p100 + | isZero b = Position Nothing p100 Nothing p100 | otherwise = Position (Just PosRight) (Just b) Nothing p100 minifyPos3 PosRight b PosCenter - | isZero b = Position Nothing p100 Nothing Nothing - | otherwise = Position (Just PosRight) (Just b) Nothing p50 + | isZero b = Position Nothing p100 Nothing Nothing + | otherwise = Position (Just PosRight) (Just b) Nothing p50 minifyPos3 _ _ _ = p minifyPosition p@(Position (Just c) Nothing (Just a) (Just b)) = f $ minAxis a b - where f (x, y) + where f (x, y) | c == PosLeft && x == Just PosTop && isJust y = minifyPosition $ Position Nothing l0 Nothing y | otherwise = if Just a == x && Just b == y then p else minifyPosition $ p {origin2 = x, offset2 = y } -- 4 value syntax -minifyPosition p@(Position (Just PosLeft) (Just _) (Just PosTop) (Just _)) = +minifyPosition p@(Position (Just PosLeft) (Just _) (Just PosTop) (Just _)) = minifyPosition p { origin1 = Nothing, origin2 = Nothing } -minifyPosition (Position (Just a) (Just b) (Just c) (Just d)) = +minifyPosition (Position (Just a) (Just b) (Just c) (Just d)) = minifyPos4 a b c d minifyPosition p = p @@ -192,10 +192,10 @@ minifyPos4' a b c d = Position (Just a) (Just b) (Just c) (Just d) minAxis :: PosKeyword -> PercentageLength -> (Maybe PosKeyword, Maybe PercentageLength) -minAxis PosTop x = +minAxis PosTop x = case x of Left 50 -> (Just PosCenter, Nothing) - b -> if isZero b + b -> if isZero b then (Just PosTop, Nothing) else (Just PosTop, Just x) minAxis PosLeft x = @@ -213,7 +213,7 @@ minAxis PosCenter x = (Just PosCenter, Just x) instance Eq Position where - a == b = minify a `equals` minify b + x == y = minify x `equals` minify y where equals (Position a b c d) (Position e f g h) = a == e && b == f && c == g && d == h diff --git a/src/Hasmin/Types/String.hs b/src/Hasmin/Types/String.hs --- a/src/Hasmin/Types/String.hs +++ b/src/Hasmin/Types/String.hs @@ -18,10 +18,10 @@ import Control.Applicative (liftA2) import Control.Monad.Reader (ask, Reader) -import Data.Attoparsec.Text (Parser, parse, IResult(..), maybeResult, feed) +import Data.Attoparsec.Text (Parser, parse, IResult(Done, Partial, Fail), maybeResult, feed) import Data.Monoid ((<>)) import Data.Text (Text) -import Data.Text.Lazy.Builder as LB +import Data.Text.Lazy.Builder (singleton, fromText, toLazyText) import qualified Data.Attoparsec.Text as A import qualified Data.Char as C import qualified Data.Text as T diff --git a/src/Hasmin/Types/Stylesheet.hs b/src/Hasmin/Types/Stylesheet.hs --- a/src/Hasmin/Types/Stylesheet.hs +++ b/src/Hasmin/Types/Stylesheet.hs @@ -17,17 +17,19 @@ , SupportsCondition(..) , SupportsCondInParens(..) , isEmpty + , minifyRules ) where -import Control.Monad.Reader (Reader, ask) import Control.Applicative (liftA2) +import Control.Monad ((>=>)) +import Control.Monad.Reader (Reader, ask) import Data.Monoid ((<>)) import Data.Text (Text) import Data.Text.Lazy.Builder (singleton, fromText, Builder) import Data.List (sortBy, (\\)) import Data.Map.Strict (Map) -import Data.List.NonEmpty (NonEmpty((:|))) -import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty (NonEmpty) +import Data.Foldable (toList) import qualified Data.Map.Strict as Map import qualified Data.Set as S import qualified Data.Text as T @@ -39,7 +41,6 @@ import Hasmin.Types.Declaration import Hasmin.Types.String import Hasmin.Types.Numeric -import Hasmin.Types.Dimension import Hasmin.Utils -- | Data type for media queries. For the syntax, see @@ -114,7 +115,7 @@ | AtBlockWithRules Text [Rule] | AtBlockWithDec Text [Declaration] | StyleRule [Selector] [Declaration] - deriving (Show) + deriving (Eq, Show) instance ToText Rule where toBuilder (AtMedia mqs rs) = "@media " <> mconcatIntersperse toBuilder (singleton ',') mqs <> singleton '{' <> mconcat (fmap toBuilder rs) <> singleton '}' @@ -257,7 +258,7 @@ | And SupportsCondInParens (NonEmpty SupportsCondInParens) | Or SupportsCondInParens (NonEmpty SupportsCondInParens) | Parens SupportsCondInParens - deriving (Show) + deriving (Eq, Show) instance ToText SupportsCondition where toBuilder (Not x) = "not " <> toBuilder x toBuilder (And x y) = appendWith " and " x y @@ -279,7 +280,7 @@ ParensDec y -> (Not . ParensDec) <$> pure y appendWith :: Builder -> SupportsCondInParens -> NonEmpty SupportsCondInParens -> Builder -appendWith s x y = toBuilder x <> s <> mconcatIntersperse toBuilder s (NE.toList y) +appendWith s x y = toBuilder x <> s <> mconcatIntersperse toBuilder s (toList y) -- Note that "general_enclosed" is not included, because, per the spec: -- @@ -291,7 +292,7 @@ -- parenthesized expressions that can evaluate to true. data SupportsCondInParens = ParensCond SupportsCondition | ParensDec Declaration - deriving (Show) + deriving (Eq, Show) instance ToText SupportsCondInParens where toBuilder (ParensDec x) = "(" <> toBuilder x <> ")" toBuilder (ParensCond x) = "(" <> toBuilder x <> ")" @@ -299,8 +300,28 @@ minifyWith (ParensDec x) = ParensDec <$> minifyWith x minifyWith (ParensCond x) = ParensCond <$> minifyWith x -data GeneralEnclosed = GEFunction - deriving (Show) +combineAdjacentMediaQueries :: [Rule] -> [Rule] +combineAdjacentMediaQueries (a@(AtMedia mqs es) : b@(AtMedia mqs2 es2) : xs) + | mqs == mqs2 = combineAdjacentMediaQueries (AtMedia mqs (es ++ es2) : xs) + | otherwise = a : combineAdjacentMediaQueries (b:xs) +combineAdjacentMediaQueries (x:xs) = x : combineAdjacentMediaQueries xs +combineAdjacentMediaQueries [] = [] + +-- Set of functions to minify rules +minifyRules :: [Rule] -> Reader Config [Rule] +minifyRules = handleAdjacentMediaQueries + >=> handleEmptyBlocks + >=> traverse minifyWith -- minify rules individually + where handleEmptyBlocks :: [Rule] -> Reader Config [Rule] + handleEmptyBlocks rs = do + conf <- ask + pure $ if shouldRemoveEmptyBlocks conf + then filter (not . isEmpty) rs + else rs + handleAdjacentMediaQueries :: [Rule] -> Reader Config [Rule] + handleAdjacentMediaQueries rs = do + conf <- ask + pure $ combineAdjacentMediaQueries rs {- supports_rule diff --git a/src/Hasmin/Types/TransformFunction.hs b/src/Hasmin/Types/TransformFunction.hs --- a/src/Hasmin/Types/TransformFunction.hs +++ b/src/Hasmin/Types/TransformFunction.hs @@ -20,6 +20,7 @@ import Control.Monad.Reader (mapReader, Reader, ask, local) import Control.Applicative (liftA2) import Data.Monoid ((<>)) +import Data.Either (isRight) import qualified Data.Text as T import Data.Number.FixedFunctions (sin, cos, acos, tan, atan) import Prelude hiding (sin, cos, acos, tan, atan) diff --git a/src/Hasmin/Types/Value.hs b/src/Hasmin/Types/Value.hs --- a/src/Hasmin/Types/Value.hs +++ b/src/Hasmin/Types/Value.hs @@ -192,13 +192,8 @@ minifyWith (ShadowV s) = ShadowV <$> minifyWith s minifyWith (ShadowText l1 l2 ml mc) = minifyPseudoShadow ShadowText l1 l2 ml mc minifyWith (BgLayer img pos sz rst att b1 b2) = do - conf <- ask - i <- handleImage img - s <- handleBgSize sz - p <- let cannotRemovePos = isJust s -- can only be removed if there is no later - in handlePosition cannotRemovePos pos - r <- handleRepeatStyle rst - a <- handleAttachment att + -- conf <- ask + (i,s,p,r,a) <- minifyBgLayer img pos sz rst att (bgOrigin, bgClip) <- handleBoxes b1 b2 pure $ if isNothing i && isNothing p && isNothing s && isNothing r && isNothing a && isNothing bgOrigin && isNothing bgClip @@ -207,13 +202,8 @@ then BgLayer (Just $ mkOther "none") p s r a bgOrigin bgClip else BgLayer i p s r a bgOrigin bgClip minifyWith (FinalBgLayer img pos sz rst att b1 b2 col) = do - conf <- ask - i <- handleImage img - s <- handleBgSize sz - p <- let cannotRemovePos = isJust s -- can only be removed if there is no later - in handlePosition cannotRemovePos pos - r <- handleRepeatStyle rst - a <- handleAttachment att + -- conf <- ask + (i,s,p,r,a) <- minifyBgLayer img pos sz rst att c <- handleColor col (bgOrigin, bgClip) <- handleBoxes b1 b2 pure $ if isNothing i && isNothing p && isNothing s && isNothing r @@ -348,16 +338,16 @@ handlePosition :: Bool -> Maybe Position -> Reader Config (Maybe Position) handlePosition _ Nothing = pure Nothing -handlePosition cannotRemovePos (Just x) - | cannotRemovePos = Just <$> minifyWith x +handlePosition cannotRemovePos (Just p) + | cannotRemovePos = Just <$> minifyWith p | otherwise = do conf <- ask - mx <- minifyWith x - pure $ if mx == Position Nothing l0 Nothing l0 + mp <- minifyWith p + pure $ if mp == Position Nothing l0 Nothing l0 then Nothing else Just $ if True {- shouldMinifyPosition conf -} - then mx - else x + then mp + else p data Values = Values Value [(Separator, Value)] deriving (Show, Eq) @@ -439,3 +429,14 @@ else StringV ffamily optimizeFontFamily x = pure x +minifyBgLayer :: Maybe Value -> Maybe Position -> Maybe BgSize + -> Maybe RepeatStyle -> Maybe TextV + -> Reader Config (Maybe Value, Maybe BgSize, Maybe Position, Maybe RepeatStyle, Maybe TextV) +minifyBgLayer img pos sz rst att = do + i <- handleImage img + s <- handleBgSize sz + p <- let cannotRemovePos = isJust s -- can only be removed if there is no later + in handlePosition cannotRemovePos pos + r <- handleRepeatStyle rst + a <- handleAttachment att + pure (i,s,p,r,a) diff --git a/src/Hasmin/Utils.hs b/src/Hasmin/Utils.hs --- a/src/Hasmin/Utils.hs +++ b/src/Hasmin/Utils.hs @@ -9,9 +9,7 @@ -- ----------------------------------------------------------------------------- module Hasmin.Utils - ( isRight - , isLeft - , epsilon + ( epsilon , eps , fromLeft' , fromRight' @@ -40,8 +38,9 @@ | otherwise = y <> mconcatIntersperse toMonoid y xs replaceAt :: Int -> a -> [a] -> [a] -replaceAt i v ls = let (a, _:vs) = splitAt i ls - in a ++ (v:vs) +replaceAt i v ls = case splitAt i ls of + (xs, _:vs) -> xs ++ (v:vs) + (xs, []) -> xs fromRight' :: Either a b -> b fromRight' (Right x) = x @@ -50,14 +49,6 @@ fromLeft' :: Either a b -> a fromLeft' (Left x) = x fromLeft' _ = error "fromLeft'" - -isRight :: Either a b -> Bool -isRight Right{} = True -isRight _ = False - -isLeft :: Either a b -> Bool -isLeft Left{} = True -isLeft _ = False -- TODO: Find out how precise is enough. -- Can we use double and round when printing? diff --git a/tests/Hasmin/TestUtils.hs b/tests/Hasmin/TestUtils.hs --- a/tests/Hasmin/TestUtils.hs +++ b/tests/Hasmin/TestUtils.hs @@ -4,6 +4,7 @@ module Hasmin.TestUtils , module Test.QuickCheck , module Test.Hspec + , module Test.Hspec.Attoparsec ) where import Test.Hspec @@ -39,7 +40,8 @@ matchSpec :: ToText a => Parser a -> (Text, Text) -> Spec matchSpec parser (textToParse, expectedResult) = - it (unpack textToParse) $ (toText <$> (textToParse ~> parser)) `parseSatisfies` (== expectedResult) + it (unpack textToParse) $ + (toText <$> (textToParse ~> parser)) `parseSatisfies` (== expectedResult) mkGen :: [a] -> Gen a mkGen xs = (xs !!) <$> choose (0, length xs - 1) diff --git a/tests/Hasmin/Types/StylesheetSpec.hs b/tests/Hasmin/Types/StylesheetSpec.hs --- a/tests/Hasmin/Types/StylesheetSpec.hs +++ b/tests/Hasmin/Types/StylesheetSpec.hs @@ -2,12 +2,26 @@ module Hasmin.Types.StylesheetSpec where -import Data.Text (Text) +import Data.Text (Text, unpack) import Hasmin.Parser.Internal import Hasmin.TestUtils import Hasmin.Types.Class +import Hasmin.Utils +import Hasmin +combineAdjacentMediaQueriesTests :: Spec +combineAdjacentMediaQueriesTests = + describe "Combines adjacent @media rules" $ + mapM_ f combineAdjacentMediaQueriesTestsInfo + where f (t1, t2) = it (unpack t1) $ minifyCSS t1 `parseSatisfies` (== t2) + +combineAdjacentMediaQueriesTestsInfo :: [(Text, Text)] +combineAdjacentMediaQueriesTestsInfo = + [("@media all and (min-width:24rem){.Fz\\(s2\\)\\@xs{font-size:1.2rem;}}@media all and (min-width: 24rem){.Px\\(s04\\)\\@xs{padding-left:.25rem; padding-right:.25rem;}}", + "@media all and (min-width:24rem){.Fz\\(s2\\)\\@xs{font-size:1.2rem}.Px\\(s04\\)\\@xs{padding-left:.25rem;padding-right:.25rem}}") + ] + atRuleTests :: Spec atRuleTests = do describe "at rules parsing and printing" $ @@ -75,7 +89,9 @@ ] spec :: Spec -spec = atRuleTests +spec = do atRuleTests + combineAdjacentMediaQueriesTests + main :: IO () main = hspec spec