diff --git a/hasmin.cabal b/hasmin.cabal --- a/hasmin.cabal +++ b/hasmin.cabal @@ -1,11 +1,11 @@ name: hasmin -version: 0.3.1.3 +version: 0.3.2 license: BSD3 license-file: LICENSE author: (c) 2017 Cristian Adrián Ontivero maintainer: Cristian Adrián Ontivero synopsis: "A CSS Minifier" -homepage: https://github.com/contivero/hasmin/ +homepage: https://github.com/contivero/hasmin#readme bug-reports: https://github.com/contivero/hasmin/issues category: Text build-type: Simple @@ -13,9 +13,10 @@ cabal-version: >=1.10 description: A CSS minifier which not only aims at reducing the amount of bytes of the - output, but also at improving gzip compression. By default, the output is the - minified CSS file, but hasmin allows also its compression into gzip using - Google's Zopfli library. + output, but also at improving gzip compression. It may be used as a library, + or a stand-alone executable. For the library, refer to the Hasmin module + documentation. For the program: the output is the minified CSS file, but + hasmin allows also its compression into gzip using Google's Zopfli library. . To use it: ./hasmin input.css > output.css . @@ -37,9 +38,9 @@ , optparse-applicative >=0.11 && <0.14 , parsers >=0.12.3 && <0.13 , text >=1.2 && <1.3 - , hopfli >=0.2 && <0.3 + , hopfli >=0.2 && <0.4 , bytestring >=0.10.2.0 && <0.11 - , gitrev >=1.0.0 && <=1.2.0 + , gitrev >=1.0.0 && <1.4 , matrix >=0.3.4 && <0.4 , mtl >=2.2.1 && <2.3 , numbers >=3000.2.0.0 && <3000.3 @@ -62,19 +63,19 @@ , Hasmin.Types.Numeric , Hasmin.Types.TransformFunction , Hasmin.Types.Value + , Hasmin.Types.RepeatStyle + , Hasmin.Types.FilterFunction + , Hasmin.Types.Position + , Hasmin.Types.BgSize , Hasmin.Utils + , Hasmin.Types.TimingFunction other-modules: Hasmin.Parser.Utils , Hasmin.Properties , Hasmin.Types.Selector - , Hasmin.Types.BgSize - , Hasmin.Types.FilterFunction , Hasmin.Types.Gradient , Hasmin.Types.PercentageLength - , Hasmin.Types.Position - , Hasmin.Types.RepeatStyle , Hasmin.Types.Shadow , Hasmin.Types.String - , Hasmin.Types.TimingFunction build-depends: base >=4.9 && <5.1 , attoparsec >=0.12 && <0.14 , bytestring >=0.10.2.0 && <0.11 @@ -103,6 +104,8 @@ , Hasmin.Types.PositionSpec , Hasmin.Types.RepeatStyleSpec , Hasmin.Types.SelectorSpec + , Hasmin.Types.ValueSpec + , Hasmin.Types.BgSizeSpec , Hasmin.Types.ShadowSpec , Hasmin.Types.StringSpec , Hasmin.Types.StylesheetSpec 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 @@ -171,12 +171,12 @@ s <- option Nothing (Just <$> parseSign) x <- option mempty digits case x of - [] -> ciN *> (AB (Nwith s Nothing) <$> (skipComments *> option Nothing (Just <$> bValue))) + [] -> ciN *> skipComments *> option (A s Nothing) (AB s Nothing <$> bValue) _ -> do n <- option False (ciN $> True) let a = read x :: Int if n - then AB (Nwith s (Just a)) <$> (skipComments *> option Nothing (Just <$> bValue)) - else pure $ AB NoValue (Just $ getSign s * a) + then skipComments *> option (A s (Just a)) (AB s (Just a) <$> bValue) + else pure $ B (getSign s * a) where ciN = satisfy (\c -> c == 'N' || c == 'n') parseSign = (char '-' $> Minus) <|> (char '+' $> Plus) getSign (Just Minus) = -1 diff --git a/src/Hasmin/Types/BgSize.hs b/src/Hasmin/Types/BgSize.hs --- a/src/Hasmin/Types/BgSize.hs +++ b/src/Hasmin/Types/BgSize.hs @@ -9,11 +9,14 @@ -- ----------------------------------------------------------------------------- module Hasmin.Types.BgSize ( - BgSize(..), Auto(..) + BgSize(..) + , Auto(..) ) where + import Control.Monad.Reader (ask) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton) + import Hasmin.Types.Class import Hasmin.Types.PercentageLength @@ -26,8 +29,20 @@ data BgSize = Cover | Contain | BgSize (Either PercentageLength Auto) (Maybe (Either PercentageLength Auto)) - deriving (Eq, Show) + deriving Show +instance Eq BgSize where + Cover == Cover = True + Contain == Contain = True + BgSize a b == BgSize c d = ftsArgEq a c && b `equals` d + where equals (Just (Right Auto)) Nothing = True + equals Nothing (Just (Right Auto)) = True + equals (Just (Left x)) (Just (Left y)) = isZero x && isZero y || x == y + equals x y = x == y + ftsArgEq (Left x) (Left y) = isZero x && isZero y || x == y + ftsArgEq x y = x == y + _ == _ = False + instance ToText BgSize where toBuilder Cover = "cover" toBuilder Contain = "contain" @@ -42,11 +57,10 @@ pure $ if True {- shouldMinifyBgSize conf -} then minifyBgSize b else b - where minFirst (Left a) = Left <$> minifyWith a + where minFirst (Left a) = Left <$> minifyWith a minFirst (Right Auto) = pure (Right Auto) minifyWith x = pure x minifyBgSize :: BgSize -> BgSize minifyBgSize (BgSize l (Just (Right Auto))) = BgSize l Nothing minifyBgSize x = x - diff --git a/src/Hasmin/Types/Dimension.hs b/src/Hasmin/Types/Dimension.hs --- a/src/Hasmin/Types/Dimension.hs +++ b/src/Hasmin/Types/Dimension.hs @@ -32,7 +32,6 @@ import Control.Monad.Reader (asks) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton, fromText) -import Data.Typeable (Typeable) import Hasmin.Types.Class import Hasmin.Types.Numeric import Hasmin.Config @@ -134,13 +133,13 @@ -- the shortest equivalent representation. If there is more than one, returns -- the latest found to "normalize" values, hopefully improving gzip compression. minDim :: (Unit a, ToText a) => (Number -> a -> b) -> Number -> a -> [a] -> b +minDim constructor r u [] = constructor r u minDim constructor r u (x:xs) | currentLength < newLength = minDim constructor r u xs | otherwise = minDim constructor equivValue x xs where equivValue = convertTo x r u currentLength = textualLength r + textualLength u newLength = textualLength equivValue + textualLength x -minDim constructor r u [] = constructor r u class Unit a where convertTo :: a -> Number -> a -> Number @@ -175,7 +174,7 @@ convertTo _ = const data AngleUnit = Deg | Grad | Rad | Turn - deriving (Show, Eq, Typeable) + deriving (Show, Eq) instance ToText AngleUnit where toBuilder Deg = "deg" toBuilder Grad = "grad" @@ -254,7 +253,7 @@ toQuarterMilimeter d _ = d toPoints :: Number -> DistanceUnit -> Number -toPoints d IN = d / 72 +toPoints d IN = d * 72 toPoints d CM = d * (72 / 2.54) toPoints d MM = d * (72 / 25.4) toPoints d Q = d * (72 / 101.6) @@ -263,7 +262,7 @@ toPoints d _ = d toPica :: Number -> DistanceUnit -> Number -toPica d IN = d / 6 +toPica d IN = d * 6 toPica d CM = d * (6 / 2.54) toPica d MM = d * (6 / 25.4) toPica d Q = d * (6 / 101.6) @@ -277,7 +276,7 @@ toPixels d MM = d * (96 / 25.4) toPixels d Q = d * (96 / 101.6) toPixels d PT = d * (4 / 3) -toPixels d PC = d / 6 +toPixels d PC = d * 16 toPixels d _ = d ------------------------------------------------------------------------------ rationalPi :: Number @@ -331,9 +330,9 @@ toDpcm :: Number -> ResolutionUnit -> Number toDpcm d Dpi = d / 2.54 toDpcm d Dpcm = d -toDpcm d Dppx = d * (2.54 / 96) +toDpcm d Dppx = d * (96 / 2.54) toDppx :: Number -> ResolutionUnit -> Number toDppx d Dpi = d / 96 -toDppx d Dpcm = d * (96 / 2.54) +toDppx d Dpcm = d * (2.54 / 96) toDppx d Dppx = 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 @@ -38,8 +38,23 @@ | Sepia (Either Number Percentage) | HueRotate Angle | DropShadow Distance Distance (Maybe Distance) (Maybe Color) - deriving (Eq, Show) - + deriving (Show) +instance Eq FilterFunction where + Blur a == Blur b = a == b + Brightness a == Brightness b = filterFunctionEquality a b + Contrast a == Contrast b = filterFunctionEquality a b + Grayscale a == Grayscale b = filterFunctionEquality a b + Invert a == Invert b = filterFunctionEquality a b + Opacity a == Opacity b = filterFunctionEquality a b + Saturate a == Saturate b = filterFunctionEquality a b + Sepia a == Sepia b = filterFunctionEquality a b + HueRotate a == HueRotate b = a == b + DropShadow a b c d == DropShadow e f g h = + a == e && b == f && d == h && c `thirdValueEq` g + where thirdValueEq Nothing (Just (Distance 0 _)) = True + thirdValueEq (Just (Distance 0 _)) Nothing = True + thirdValueEq x y = x == y + _ == _ = False instance ToText FilterFunction where toBuilder (Blur d) = "blur(" <> toBuilder d <> singleton ')' toBuilder (Brightness np) = "brightness(" <> toBuilder np <> singleton ')' @@ -55,7 +70,6 @@ maybeToBuilder = maybe mempty (\x -> singleton ' ' <> toBuilder x) in "drop-shadow(" <> toBuilder l1 <> singleton ' ' <> toBuilder l2 <> maybeToBuilder ml <> maybeToBuilder mc <> singleton ')' - instance Minifiable FilterFunction where minifyWith (Blur a) = Blur <$> minifyWith a minifyWith (HueRotate a) = HueRotate <$> minifyWith a @@ -90,14 +104,18 @@ pure $ if shouldMinifyFilterFunctions conf then either convertNumber convertPercentage x else x + where convertNumber n + | 0 < n && n < 0.1 = Right $ toPercentage (n * 100) + | otherwise = Left n + convertPercentage p + | p == 0 = Left 0 + | 0 < p && p < 10 = Right p + | otherwise = Left $ toNumber (p / 100) -convertNumber :: Number -> Either Number Percentage -convertNumber x - | 0 < x && x < 0.1 = Right $ toPercentage (x * 100) - | otherwise = Left x +filterFunctionEquality :: Either Number Percentage + -> Either Number Percentage -> Bool +filterFunctionEquality (Left a) (Left b) = toRational a == toRational b +filterFunctionEquality (Right a) (Right b) = toRational a == toRational b +filterFunctionEquality (Left a) (Right b) = toRational a == toRational b/100 +filterFunctionEquality (Right a) (Left b) = toRational a/100 == toRational b -convertPercentage :: Percentage -> Either Number Percentage -convertPercentage p - | p == 0 = Left 0 - | 0 < p && p < 10 = Right p - | otherwise = Left $ toNumber (p / 100) 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 @@ -9,7 +9,11 @@ -- ----------------------------------------------------------------------------- module Hasmin.Types.Position ( - Position(..), PosKeyword(..), minifyPosition, p50, l0 + Position(..) + , PosKeyword(..) + , minifyPosition + , p50 + , l0 ) where import Data.Text (Text) @@ -21,15 +25,12 @@ import Hasmin.Types.PercentageLength import Hasmin.Utils -data Position = Position { origin1 :: Maybe PosKeyword - , offset1 :: Maybe PercentageLength - , origin2 :: Maybe PosKeyword - , offset2 :: Maybe PercentageLength - } deriving (Eq, Show) - -data PosKeyword = PosCenter | PosLeft | PosRight | PosTop | PosBottom +data PosKeyword = PosCenter + | PosLeft + | PosRight + | PosTop + | PosBottom deriving (Eq, Show) - instance ToText PosKeyword where toBuilder PosCenter = "center" toBuilder PosTop = "top" @@ -37,6 +38,13 @@ toBuilder PosBottom = "bottom" toBuilder PosLeft = "left" +-- TODO turn this into a proper algebraic type with all the cases, avoding Maybe +-- and making invalid Position values impossible. +data Position = Position { origin1 :: Maybe PosKeyword + , offset1 :: Maybe PercentageLength + , origin2 :: Maybe PosKeyword + , offset2 :: Maybe PercentageLength + } deriving (Show) instance Minifiable Position where minifyWith p = pure $ minifyPosition p @@ -203,6 +211,11 @@ | isZero x = (Just PosBottom, Nothing) | otherwise = (Just PosBottom, Just x) minAxis PosCenter x = (Just PosCenter, Just x) + +instance Eq Position where + a == b = minify a `equals` minify b + where equals (Position a b c d) (Position e f g h) = + a == e && b == f && c == g && d == h l0 :: Maybe PercentageLength l0 = Just (Right (Distance 0 Q)) diff --git a/src/Hasmin/Types/RepeatStyle.hs b/src/Hasmin/Types/RepeatStyle.hs --- a/src/Hasmin/Types/RepeatStyle.hs +++ b/src/Hasmin/Types/RepeatStyle.hs @@ -54,9 +54,13 @@ RSPair RsRepeat (Just RsRepeat) == RSPair RsRepeat (Just RsRepeat) = True RSPair x Nothing == RSPair y Nothing = x == y a@(RSPair _ Nothing) == b@(RSPair _ _) = b == a + RSPair x y == RSPair z w = x == z && y == w _ == _ = False -data RSKeyword = RsRepeat | RsSpace | RsRound | RsNoRepeat +data RSKeyword = RsRepeat + | RsSpace + | RsRound + | RsNoRepeat deriving (Eq, Show) instance ToText RSKeyword where toBuilder RsRepeat = "repeat" diff --git a/src/Hasmin/Types/Selector.hs b/src/Hasmin/Types/Selector.hs --- a/src/Hasmin/Types/Selector.hs +++ b/src/Hasmin/Types/Selector.hs @@ -16,7 +16,6 @@ , Combinator(..) , Sign(..) , AnPlusB(..) - , AValue(..) , Att(..) , specialPseudoElements ) where @@ -198,19 +197,9 @@ Left _ -> a Right s -> Lang (removeQuotes s) else a - minifyWith a@(FunctionalPseudoClass2 i n) = do - conf <- ask - pure $ if shouldMinifyMicrosyntax conf - then FunctionalPseudoClass2 i (minifyAnPlusB n) - else a - minifyWith a@(FunctionalPseudoClass3 i n cs) = do - conf <- ask - pure $ if shouldMinifyMicrosyntax conf - then FunctionalPseudoClass3 i (minifyAnPlusB n) cs - else a - minifyWith (FunctionalPseudoClass1 i cs) = do - newcs <- mapM minifyWith cs - pure $ FunctionalPseudoClass1 i newcs + minifyWith (FunctionalPseudoClass1 i cs) = FunctionalPseudoClass1 i <$> mapM minifyWith cs + minifyWith (FunctionalPseudoClass2 i n) = FunctionalPseudoClass2 i <$> minifyWith n + minifyWith (FunctionalPseudoClass3 i n cs) = FunctionalPseudoClass3 i <$> minifyWith n <*> pure cs minifyWith x = pure x data Sign = Plus | Minus @@ -225,7 +214,7 @@ toBuilder Plus = singleton '+' toBuilder Minus = singleton '-' -data AValue = Nwith (Maybe Sign) (Maybe Int) -- at least a lone 'n' +{- data AValue = Nwith (Maybe Sign) (Maybe Int) -- at least a lone 'n' | NoValue -- The "An" part is omitted. deriving (Eq, Show) instance ToText AValue where @@ -243,6 +232,7 @@ then Nothing else Just x minifyAValue NoValue = NoValue +-} -- We could maybe model the AB constructor with an Either, -- to make sure AB NoValue Nothing isn't possible (which is invalid). @@ -250,36 +240,57 @@ -- for example +6 vs 6, -0 vs 0 vs +0. data AnPlusB = Even | Odd - | AB AValue (Maybe Int) + | A (Maybe Sign) (Maybe Int) -- "sign n number", e.g. +3n, -2n, 1n. + | B Int -- "sign number", e.g. +1, +2, 3. + | AB (Maybe Sign) (Maybe Int) Int -- "sign n number sign number", e.g. 2n+1 deriving (Eq, Show) instance ToText AnPlusB where - toBuilder Even = "even" - toBuilder Odd = "odd" - toBuilder (AB a b) = toBuilder a <> bToBuilder b - where bToBuilder - | a == NoValue = maybe (singleton '0') toBuilder - | otherwise = maybe mempty (\x -> bSign x <> toBuilder x) - bSign x + toBuilder Even = "even" + toBuilder Odd = "odd" + toBuilder (B b) = toBuilder b + toBuilder (A ms mi) = an2Builder ms mi + toBuilder (AB ms mi b) = an2Builder ms mi <> bSign b <> toBuilder b + where bSign x | x < 0 = mempty | otherwise = singleton '+' +-- Used to print "An" values +an2Builder :: Maybe Sign -> Maybe Int -> Builder +an2Builder ms mi = maybeToBuilder ms <> maybeToBuilder mi <> singleton 'n' + where maybeToBuilder :: ToText a => Maybe a -> Builder + maybeToBuilder = maybe mempty toBuilder + +instance Minifiable AnPlusB where + minifyWith x = do + conf <- ask + pure $ if shouldMinifyMicrosyntax conf + then minifyAnPlusB x + else x + minifyAnPlusB :: AnPlusB -> AnPlusB -minifyAnPlusB Even = AB (Nwith Nothing (Just 2)) Nothing -minifyAnPlusB (AB n@(Nwith s a) (Just b)) - | isPositive s && a == Just 2 = - if b == 1 || odd b && b < 0 +minifyAnPlusB Even = A Nothing (Just 2) +minifyAnPlusB (A ms mi) = + case mi of + Just 0 -> B 0 + _ -> uncurry A (minifyAN ms mi) +minifyAnPlusB (AB _ (Just 0) b) = B b +minifyAnPlusB (AB ms mi b) + | isPositive ms && mi == Just 2 = + if b == 1 || b < 0 && odd b then Odd else if even b && b <= 0 then minifyAnPlusB Even - else AB (minifyAValue n) (Just b) - | otherwise = AB (minifyAValue n) $ if b == 0 - then Nothing - else Just b -minifyAnPlusB (AB n@Nwith{} Nothing) = AB (minifyAValue n) Nothing + else AB ms' mi' b + | otherwise = if b == 0 + then A ms' mi' + else AB ms' mi' b + where (ms', mi') = minifyAN ms mi minifyAnPlusB x = x --- instance Specificity SimpleSelector where - -- specificity (IdSel _) = (0,1,0,0) - -- specificity (ClassSel _) = (0,0,1,0) + +minifyAN :: Maybe Sign -> Maybe Int -> (Maybe Sign, Maybe Int) +minifyAN (Just Plus) i = minifyAN Nothing i +minifyAN s (Just 1) = minifyAN s Nothing +minifyAN s i = (s, i) type AttId = Text type AttValue = Either Text StringType diff --git a/src/Hasmin/Types/Shadow.hs b/src/Hasmin/Types/Shadow.hs --- a/src/Hasmin/Types/Shadow.hs +++ b/src/Hasmin/Types/Shadow.hs @@ -16,6 +16,7 @@ import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton) import Data.Bool (bool) + import Hasmin.Types.Class import Hasmin.Types.Color import Hasmin.Types.Dimension diff --git a/src/Hasmin/Types/TimingFunction.hs b/src/Hasmin/Types/TimingFunction.hs --- a/src/Hasmin/Types/TimingFunction.hs +++ b/src/Hasmin/Types/TimingFunction.hs @@ -9,7 +9,8 @@ -- ----------------------------------------------------------------------------- module Hasmin.Types.TimingFunction ( - TimingFunction(..), StepsSecondParam(..) + TimingFunction(..) + , StepsSecondParam(..) ) where import Control.Monad.Reader (ask) @@ -29,8 +30,13 @@ -- 3. data TimingFunction = CubicBezier Number Number Number Number | Steps Int (Maybe StepsSecondParam) - | Ease | EaseIn | EaseInOut | EaseOut - | Linear | StepEnd | StepStart + | Ease + | EaseIn + | EaseInOut + | EaseOut + | Linear + | StepEnd + | StepStart deriving (Show) instance Eq TimingFunction where @@ -66,12 +72,12 @@ toSteps _ = Nothing -data StepsSecondParam = Start | End -- End is the default value +data StepsSecondParam = Start + | End -- End is the default value deriving (Eq, Show) instance ToText StepsSecondParam where toBuilder Start = "start" toBuilder End = "end" - instance ToText TimingFunction where toBuilder (CubicBezier a b c d) = "cubic-bezier(" <> mconcatIntersperse toBuilder (singleton ',') [a,b,c,d] @@ -89,9 +95,9 @@ instance Minifiable TimingFunction where minifyWith x = do conf <- ask - if shouldMinifyTimingFunctions conf - then pure $ minifyTimingFunction x - else pure x + pure $ if shouldMinifyTimingFunctions conf + then minifyTimingFunction x + else x minifyTimingFunction :: TimingFunction -> TimingFunction minifyTimingFunction x@(CubicBezier a b c 1) diff --git a/tests/Hasmin/Parser/InternalSpec.hs b/tests/Hasmin/Parser/InternalSpec.hs --- a/tests/Hasmin/Parser/InternalSpec.hs +++ b/tests/Hasmin/Parser/InternalSpec.hs @@ -17,7 +17,7 @@ mapM_ (matchSpecWithDesc declaration) declarationTestInfo declarationTestInfo :: [(String, Text, Text)] -declarationTestInfo = +declarationTestInfo = [("parses declaration with unknown property and value, ending in ';'", "a:b;", "a:b") ,("parses declaration with unknown property and value, ending in '}'", @@ -35,8 +35,8 @@ ] declarationParsersTests :: Spec -declarationParsersTests = - describe "Declaration parsers tests" $ do +declarationParsersTests = + describe "Declaration parsers tests" $ it "Parses valid font-style values, and fails with invalids" $ do fontStyle `shouldSucceedOn` ("normal" :: Text) fontStyle `shouldSucceedOn` ("italic" :: Text) @@ -47,28 +47,35 @@ styleRuleParser :: Spec describe "style rule parser" $ do it "parses rule whose final declaration ends in ';'" $ do - "a { margin : 0;}" ~> (styleRule + "a { margin : 0;}" ~> (styleRule -} styleRuleTestInfo :: [(String, Text, Text)] -styleRuleTestInfo = +styleRuleTestInfo = [("simple style rule", "a { margin : 0 ;}", "a{margin:0}") - ,("handles unset", + ,("handles unset", "h1 {\n border: unset\n}", "h1{border:unset}") - ,("handles initial", + ,("handles initial", "camelCase {\r color: initial;}", "camelCase{color:initial}") - ,("handles inherit", + ,("handles inherit", "h1 {\n\tpadding: inherit\f}", "h1{padding:inherit}") ] selectorParserTests :: Spec selectorParserTests = - describe "selector parser tests" $ - mapM_ (matchSpecWithDesc selector) selectorTestInfo + describe "Selector parser tests" $ + mapM_ (matchSpecWithDesc selector) selectorTestInfo +selectorParserFailures :: Spec +selectorParserFailures = + describe "Selector parser should fail on" . + it "" $ + selector `shouldFailOn` ("\\6543217" :: Text) + + selectorTestInfo :: [(String, Text, Text)] -selectorTestInfo = +selectorTestInfo = [("Element", "h6", "h6") ,("Element with namespace", "ns|body", "ns|body") ,("Element with any namespace", "*|p", "*|p") @@ -78,9 +85,10 @@ --,("Class name starting with number or dash", ".\\1\\#-\\.1 .\\--wie.-gehts", ".1#-.1.--wie.-gehts") ,("Class name with emoji", ".☺", ".☺") ,("Class name with multiple emoji", ".👊✊", ".👊✊") + ,("Class name with escaped letter", ".\\t", ".\\t") + ,("Class name with escaped unicode character", ".\\91", ".\\91") ,("Id", "#AnId", "#AnId") - --,("Id starting with a number", "#\\5\\#-\\.5", "#5#-.5") - --,("Id starting with a number", "#\\5\\#-\\.5", "#5#-.5") + -- ,("Id starting with a number", "#\\5\\#-\\.5", "#5#-.5") ,("Id with latin-1 character", "#ñ", "#ñ") -- The following four have a pseudo class syntax, but are pseudo elements ,(":after pseudo element", ":after", ":after") @@ -146,9 +154,9 @@ ,("an E element that has no children (including text nodes)", "E:empty","E:empty") ,("An E element being the source anchor of a hyperlink of which the target is not yet visited", - "E:link", "E:link") + "E:link", "E:link") ,("An E element being the source anchor of a hyperlink of which the target is already visited", - "E:visited", "E:visited") + "E:visited", "E:visited") ,("an E element during active action", "E:active","E:active") ,("an E element during hover action", @@ -196,11 +204,12 @@ -- mapM_ (matchSpecWithDesc stylesheet) stylesheetTestInfo --stylesheetTestInfo :: [(String, Text, Text)] ---stylesheetTestInfo = +--stylesheetTestInfo = spec :: Spec spec = do declarationParserTests selectorParserTests + selectorParserFailures declarationParsersTests main :: IO () diff --git a/tests/Hasmin/TestUtils.hs b/tests/Hasmin/TestUtils.hs --- a/tests/Hasmin/TestUtils.hs +++ b/tests/Hasmin/TestUtils.hs @@ -1,16 +1,35 @@ {-# LANGUAGE OverloadedStrings #-} -module Hasmin.TestUtils where +module Hasmin.TestUtils ( + module Hasmin.TestUtils + , module Test.QuickCheck + , module Test.Hspec + ) where import Test.Hspec +import Test.QuickCheck +import Test.Hspec.Attoparsec (parseSatisfies, (~>)) import Data.Text (Text, unpack, singleton) -import Test.Hspec.Attoparsec (parseSatisfies, (~>)) import Data.Attoparsec.Text (Parser) +import Control.Applicative (liftA2, liftA3) +import Control.Monad (liftM4) + +import Hasmin.Types.BgSize import Hasmin.Types.Class +import Hasmin.Types.Color import Hasmin.Types.Declaration +import Hasmin.Types.Dimension +import Hasmin.Types.FilterFunction +import Hasmin.Types.Numeric +import Hasmin.Types.Position +import Hasmin.Types.TimingFunction import Hasmin.Utils +-- | Check that a color is equivalent to their minified representation form +prop_minificationEq :: (Minifiable a, Eq a) => a -> Bool +prop_minificationEq d = minify d == d + -- Given a parser and a 3-tuple, prints a test description, -- applies the parser, and compares its result with the expected result matchSpecWithDesc :: ToText a => Parser a -> (String, Text, Text) -> Spec @@ -22,7 +41,111 @@ matchSpec parser (textToParse, expectedResult) = it (unpack textToParse) $ (toText <$> (textToParse ~> parser)) `parseSatisfies` (== expectedResult) -data Declarations = Declarations [Declaration] +mkGen :: [a] -> Gen a +mkGen xs = (xs !!) <$> choose (0, length xs - 1) + +newtype Declarations = Declarations [Declaration] instance ToText Declarations where toText (Declarations ds) = mconcatIntersperse toText (singleton ';') ds + +instance Arbitrary Distance where + arbitrary = liftA2 Distance arbitrary distanceUnit + -- TODO keep it DRY, avoid repeating constructor list here (i.e. SPOF) + where distanceUnit = mkGen [IN, CM, MM, Q, PC, PT, PX, EM, EX, + CH, VH, VW, VMIN, VMAX, REM] + +instance Arbitrary Angle where + arbitrary = liftA2 Angle arbitrary angleUnit + where angleUnit = mkGen [Deg, Grad, Rad, Turn] + +instance Arbitrary Duration where + arbitrary = liftA2 Duration arbitrary durationUnit + where durationUnit = mkGen [S, Ms] + +instance Arbitrary Frequency where + arbitrary = liftA2 Frequency arbitrary frequencyUnit + where frequencyUnit = mkGen [Hz, Khz] + +instance Arbitrary Resolution where + arbitrary = liftA2 Resolution arbitrary resolutionUnit + where resolutionUnit = mkGen [Dpi, Dpcm, Dppx] + +instance Arbitrary Number where + arbitrary = toNumber <$> (arbitrary :: Gen Rational) + +instance Arbitrary PosKeyword where + arbitrary = mkGen [PosCenter, PosLeft, PosRight, PosTop, PosBottom] + +-- instance Arbitrary Position where + -- arbitrary = oneof [ fmap (\x -> Position x Nothing Nothing Nothing) arbitrary ] + +instance Arbitrary Percentage where + arbitrary = fmap Percentage (arbitrary :: Gen Rational) + +instance Arbitrary FilterFunction where + arbitrary = oneof + [ Blur <$> arbitrary + , Brightness <$> arbitrary + , Contrast <$> arbitrary + , Grayscale <$> arbitrary + , Invert <$> arbitrary + , Opacity <$> arbitrary + , Saturate <$> arbitrary + , Sepia <$> arbitrary + , HueRotate <$> arbitrary + , liftM4 DropShadow arbitrary arbitrary arbitrary arbitrary + ] + +instance Arbitrary BgSize where + arbitrary = liftA2 BgSize arbitrary arbitrary + +instance Arbitrary Auto where + arbitrary = pure Auto + +instance Arbitrary StepsSecondParam where + arbitrary = oneof [pure Start, pure End] + +instance Arbitrary TimingFunction where + arbitrary = oneof [ liftM4 CubicBezier arbitrary arbitrary arbitrary arbitrary + , liftA2 Steps arbitrary arbitrary + , pure Ease + , pure EaseIn + , pure EaseInOut + , pure EaseOut + , pure Linear + , pure StepEnd + , pure StepStart + ] + +instance Arbitrary Color where + arbitrary = oneof [ fmap Named colorKeyword + , liftA3 mkHex3 hexChar hexChar hexChar + , liftA3 mkHex6 hexString hexString hexString + , liftM4 mkHex4 hexChar hexChar hexChar hexChar + , liftM4 mkHex8 hexString hexString hexString hexString + , liftA3 mkRGBInt intRange intRange intRange + , liftA3 mkRGBPer ratRange ratRange ratRange + , liftM4 mkRGBAInt intRange intRange intRange alphaRange + , liftM4 mkRGBAPer ratRange ratRange ratRange alphaRange + , liftA3 mkHSL hueRange ratRange ratRange + , liftM4 mkHSLA hueRange ratRange ratRange alphaRange + ] + where intRange = choose (0, 255) + ratRange = toPercentage <$> (choose (0, 100) :: Gen Float) + alphaRange = toAlphavalue <$> (choose (0, 1) :: Gen Float) + hueRange = choose (0, 360) + +-- | Generates color keywords uniformly distributed +colorKeyword :: Gen Text +colorKeyword = mkGen $ fmap fst keywordColors + +-- | Generates a hexadecimal character uniformly distributed +hexChar :: Gen Char +hexChar = mkGen hexadecimals + +hexString :: Gen String +hexString = liftA2 (\x y -> [x,y]) hexChar hexChar + +hexadecimals :: String +hexadecimals = "0123456789abcdef" diff --git a/tests/Hasmin/Types/BgSizeSpec.hs b/tests/Hasmin/Types/BgSizeSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Hasmin/Types/BgSizeSpec.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hasmin.Types.BgSizeSpec where + +import Data.Text (Text) +import Hasmin.Parser.Value +import Hasmin.Types.Class +import Hasmin.Types.BgSize +import Hasmin.TestUtils + +quickcheckBgSize :: Spec +quickcheckBgSize = + describe "Quickcheck tests for " . + it "Minified maintains semantical equivalence" $ + property (prop_minificationEq :: BgSize -> Bool) + +bgSizeTests :: Spec +bgSizeTests = + describe " minification tests" $ + mapM_ (matchSpec f) bgSizeTestsInfo + where f = minify <$> value + +bgSizeTestsInfo :: [(Text, Text)] +bgSizeTestsInfo = + [("cover" ,"cover") + ,("contain", "contain") + ] + +spec :: Spec +spec = do + quickcheckBgSize + bgSizeTests + +main :: IO () +main = hspec spec diff --git a/tests/Hasmin/Types/ColorSpec.hs b/tests/Hasmin/Types/ColorSpec.hs --- a/tests/Hasmin/Types/ColorSpec.hs +++ b/tests/Hasmin/Types/ColorSpec.hs @@ -2,72 +2,34 @@ module Hasmin.Types.ColorSpec where -import Test.Hspec -import Test.QuickCheck -import Hasmin.Parser.Value -import Hasmin.TestUtils - -import Test.Hspec.Attoparsec (parseSatisfies, (~>)) -import Data.Text (Text) +import Control.Applicative (liftA2) +import Control.Monad import Data.Foldable import Data.Maybe (fromJust) -import Control.Monad -import Hasmin.Types.Color +import Data.Text (Text) +import Test.Hspec.Attoparsec (parseSatisfies, (~>)) + +import Hasmin.Parser.Value +import Hasmin.TestUtils import Hasmin.Types.Class +import Hasmin.Types.Color import Hasmin.Types.Numeric -instance Arbitrary Color where - arbitrary = oneof [ fmap (fromJust . mkNamed) colorKeyword - , liftM3 mkHex3 hexChar hexChar hexChar - , liftM3 mkHex6 hexString hexString hexString - , liftM4 mkHex4 hexChar hexChar hexChar hexChar - , liftM4 mkHex8 hexString hexString hexString hexString - , liftM3 mkRGBInt intRange intRange intRange - , liftM3 mkRGBPer ratRange ratRange ratRange - , liftM4 mkRGBAInt intRange intRange intRange alphaRange - , liftM4 mkRGBAPer ratRange ratRange ratRange alphaRange - , liftM3 mkHSL hueRange ratRange ratRange - , liftM4 mkHSLA hueRange ratRange ratRange alphaRange - ] - where intRange = choose (0, 255) - ratRange = toPercentage <$> (choose (0, 100) :: Gen Float) - alphaRange = toAlphavalue <$> (choose (0, 1) :: Gen Float) - hueRange = choose (0, 360) - --- | Generates color keywords uniformly distributed -colorKeyword :: Gen Text -colorKeyword = do - index <- choose (0, len) - pure $ keywords !! index - where len = length keywordColors - 1 - keywords = fmap fst keywordColors - --- | Generates a hexadecimal character uniformly distributed -hexChar :: Gen Char -hexChar = (hexadecimals !!) <$> choose (0, length hexadecimals - 1) - -hexString :: Gen String -hexString = (\x y -> [x,y]) <$> hexChar <*> hexChar - --- | Check that a color is equivalent to their minified representation form -prop_minificationEq :: Color -> Bool -prop_minificationEq c = c == minifyColor c - colorTests :: Spec colorTests = - describe "Color datatype tests" $ - it "color minify semantically equivalent" $ - quickCheck prop_minificationEq + describe " tests" . + it "minified color is semantically equivalent" $ + property (prop_minificationEq :: Color -> Bool) colorParserTests :: Spec colorParserTests = - describe "Color Parser tests" $ + describe "Color Parser tests" . it "succeeds in parsing and minifying different red color representations" $ traverse_ ((`parseSatisfies` (==(fromJust $ mkNamed "red"))) . (~> (minifyColor <$> color))) redColor colorParserSpacesAndCommentsTests :: Spec colorParserSpacesAndCommentsTests = - describe "Color Parser test" $ + describe "Color Parser test" . it "succeeds in parsing different yellow color representations with spaces and comments in-between" $ traverse_ ((`parseSatisfies` (==(fromJust $ mkNamed "yellow"))) . (~> color)) commentsAndSpacesInColors @@ -83,13 +45,6 @@ , "hsla(0,100%,50%,1)", "hsla(0,100%,50%,1.0)" , "hsla(360,100%,50%,1)", "hsla(360,100%,50%,1.0)" ] - --- | All 4096 (16^3) possible 3 char shorthands -allHex3 :: [String] -allHex3 = replicateM 3 hexadecimals - -hexadecimals :: String -hexadecimals = "0123456789abcdef" -- Every color is yellow commentsAndSpacesInColors :: [Text] diff --git a/tests/Hasmin/Types/DeclarationSpec.hs b/tests/Hasmin/Types/DeclarationSpec.hs --- a/tests/Hasmin/Types/DeclarationSpec.hs +++ b/tests/Hasmin/Types/DeclarationSpec.hs @@ -2,13 +2,12 @@ module Hasmin.Types.DeclarationSpec where -import Test.Hspec +import Data.Foldable (traverse_) +import Data.Monoid ((<>)) +import Data.Text (Text) + import Hasmin.Parser.Internal import Hasmin.TestUtils - -import Data.Text (Text) -import Data.Monoid ((<>)) -import Data.Foldable (traverse_) import Hasmin.Types.Class import Hasmin.Types.Declaration @@ -255,7 +254,7 @@ ] minifyDecTests :: Spec -minifyDecTests = do +minifyDecTests = describe "minifyDec function" $ mapM_ (matchSpec f) minifyDecTestsInfo where f = minify <$> declaration @@ -371,7 +370,7 @@ -- Tests for shorthands whose initial values are "medium none currentColor", -- and can go on any order. anyOrderShorthandTests :: Spec -anyOrderShorthandTests = do +anyOrderShorthandTests = describe "Shorthands that accept values in any order (mostly: medium none currentColor)" $ traverse_ (mapM_ (matchSpec (minify <$> declaration))) d where d = fmap f shorthandsToTest @@ -426,13 +425,13 @@ -- background-size: The first value gives the width of the corresponding image, -- the second value its height. Its initial value is 'auto', and it doesn't -- inherit. If only one value is given the second is assumed to be ‘auto’. - ,("background-size: 96px", "background-size:1in") + ,("background-size: 96px", "background-size:6pc") ,("background-size: auto", "background-size:auto") ,("background-size: unset", "background-size:auto") ,("background-size: initial", "background-size:auto") ,("background-size: auto auto", "background-size:auto") - ,("background-size: auto 96px", "background-size:auto 1in") - ,("background-size: 96px auto", "background-size:1in") + ,("background-size: auto 96px", "background-size:auto 6pc") + ,("background-size: 96px auto", "background-size:6pc") ] spec :: Spec diff --git a/tests/Hasmin/Types/DimensionSpec.hs b/tests/Hasmin/Types/DimensionSpec.hs --- a/tests/Hasmin/Types/DimensionSpec.hs +++ b/tests/Hasmin/Types/DimensionSpec.hs @@ -2,17 +2,32 @@ module Hasmin.Types.DimensionSpec where -import Test.Hspec ---import Test.QuickCheck ---import Hasmin.Parser.Internal hiding (property) +import Control.Applicative (liftA2) ---import Test.Hspec.Attoparsec (shouldParse, parseSatisfies, (~>)) import Hasmin.Types.Dimension +import Hasmin.Types.Numeric +import Hasmin.Types.Class +import Hasmin.TestUtils +dimensionTests :: Spec +dimensionTests = + describe "Dimension tests with quickcheck" $ do + it "Minified s are equivalent to the original ones" $ + property (prop_minificationEq :: Distance -> Bool) + it "Minified s are equivalent to the original ones" $ + property (prop_minificationEq :: Angle -> Bool) + it "Minified