hasmin 0.3.2.4 → 0.3.3

raw patch · 19 files changed

+234/−177 lines, 19 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−0
• Main.hs +17/−29
• hasmin.cabal +3/−3
• src/Hasmin.hs +3/−2
• src/Hasmin/Parser/Internal.hs +1/−0
• src/Hasmin/Parser/Value.hs +27/−27
• src/Hasmin/Properties.hs +1/−1
• src/Hasmin/Types/Declaration.hs +43/−37
• src/Hasmin/Types/FilterFunction.hs +3/−0
• src/Hasmin/Types/Gradient.hs +8/−2
• src/Hasmin/Types/PercentageLength.hs +4/−2
• src/Hasmin/Types/Position.hs +26/−26
• src/Hasmin/Types/String.hs +2/−2
• src/Hasmin/Types/Stylesheet.hs +31/−10
• src/Hasmin/Types/TransformFunction.hs +1/−0
• src/Hasmin/Types/Value.hs +21/−20
• src/Hasmin/Utils.hs +4/−13
• tests/Hasmin/TestUtils.hs +3/−1
• tests/Hasmin/Types/StylesheetSpec.hs +18/−2

@@ -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). 

@@ -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 <gradient> minification")+                    <> short 'g' <> help "Disable <gradient> 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

@@ -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 <cristianontivero@gmail.com>
@@ -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

@@ -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).

@@ -11,6 +11,7 @@ module Hasmin.Parser.Internal (       stylesheet     , atRule+    , rule     , declaration     , declarations     , selector

@@ -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)))  {-

@@ -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

@@ -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 <length>) -- 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

@@ -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

@@ -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

@@ -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

@@ -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 

@@ -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

@@ -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

@@ -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)

@@ -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 <bg-size>-           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 <bg-size>-           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 <bg-size>+           in handlePosition cannotRemovePos pos+      r <- handleRepeatStyle rst+      a <- handleAttachment att+      pure (i,s,p,r,a)

@@ -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?

@@ -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)

@@ -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