hasmin 1.0.1 → 1.0.2

raw patch · 40 files changed

+1995/−1208 lines, 40 filesdep +quickcheck-instancesdep −bifunctorsdep ~basedep ~criteriondep ~doctestPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: quickcheck-instances

Dependencies removed: bifunctors

Dependency ranges changed: base, criterion, doctest

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• Main.hs +1/−1
• hasmin.cabal +155/−139
• src/Hasmin/Parser/BasicShape.hs +63/−0
• src/Hasmin/Parser/BorderRadius.hs +30/−0
• src/Hasmin/Parser/Color.hs +101/−0
• src/Hasmin/Parser/Dimension.hs +70/−0
• src/Hasmin/Parser/Gradient.hs +87/−0
• src/Hasmin/Parser/Internal.hs +23/−199
• src/Hasmin/Parser/Numeric.hs +51/−0
• src/Hasmin/Parser/PercentageLength.hs +41/−0
• src/Hasmin/Parser/Position.hs +91/−0
• src/Hasmin/Parser/Primitives.hs +94/−0
• src/Hasmin/Parser/Selector.hs +209/−0
• src/Hasmin/Parser/String.hs +40/−0
• src/Hasmin/Parser/TimingFunction.hs +50/−0
• src/Hasmin/Parser/TransformFunction.hs +81/−0
• src/Hasmin/Parser/Utils.hs +26/−79
• src/Hasmin/Parser/Value.hs +158/−570
• src/Hasmin/Properties.hs +9/−3
• src/Hasmin/Types/BasicShape.hs +198/−0
• src/Hasmin/Types/BorderRadius.hs +52/−0
• src/Hasmin/Types/Color.hs +12/−16
• src/Hasmin/Types/Declaration.hs +16/−28
• src/Hasmin/Types/Dimension.hs +38/−37
• src/Hasmin/Types/FilterFunction.hs +15/−13
• src/Hasmin/Types/Gradient.hs +2/−1
• src/Hasmin/Types/PercentageLength.hs +4/−5
• src/Hasmin/Types/Position.hs +28/−11
• src/Hasmin/Types/RepeatStyle.hs +1/−1
• src/Hasmin/Types/Shadow.hs +6/−6
• src/Hasmin/Types/String.hs +36/−23
• src/Hasmin/Types/TimingFunction.hs +1/−1
• src/Hasmin/Types/Value.hs +65/−45
• src/Hasmin/Utils.hs +24/−0
• tests/Hasmin/TestUtils.hs +50/−21
• tests/Hasmin/Types/BasicShapeSpec.hs +45/−0
• tests/Hasmin/Types/DimensionSpec.hs +2/−2
• tests/Hasmin/Types/PositionSpec.hs +10/−5
• tests/Hasmin/Types/RepeatStyleSpec.hs +1/−2

@@ -1,6 +1,15 @@ # Changelog This project adheres to [PVP](https://pvp.haskell.org). +## 1.0.2+### Added+* `caret-color` and `font-display` to the property traits table, enabling their minification.+* `border-radius` minification.+* Parsing and minification of `<basic-shape>`.++### Improved+* Position minification+ ## 1.0.1  ### Added

@@ -101,7 +101,7 @@ instructions :: ParserInfo Instructions instructions = info (helper <*> versionOption <*> liftA2 (,) command config)     (fullDesc <> header "Hasmin - A Haskell CSS Minifier")-  where versionOption = infoOption ("Hasmin " <> showVersion version <> " " <> take 8 $(gitHash))+  where versionOption = infoOption ("Version " <> showVersion version <> ", " <> "Git revision " <> $(gitHash))                                    (long "version" <> help "Show version and commit hash")  main :: IO ()

@@ -1,139 +1,155 @@-name:                hasmin
-version:             1.0.1
-license:             BSD3
-license-file:        LICENSE
-author:              (c) 2017 Cristian Adrián Ontivero <cristianontivero@gmail.com>
-maintainer:          Cristian Adrián Ontivero <cristianontivero@gmail.com>
-synopsis:            CSS Minifier
-homepage:            https://github.com/contivero/hasmin#readme
-bug-reports:         https://github.com/contivero/hasmin/issues
-category:            Text
-build-type:          Simple
-extra-source-files:  README.md
-                     CHANGELOG.md
-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. 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
-    .
-    By default, most minification techniques are enabled. For a list of
-    available flags, do: ./hasmin --help
-
-source-repository head
-  type: git
-  location: https://github.com/contivero/hasmin.git
-
-executable hasmin
-  default-language:    Haskell2010
-  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
-                     , optparse-applicative >=0.11       && <0.15
-                     , text                 >=1.2        && <1.3
-                     , hopfli               >=0.2        && <0.4
-                     , bytestring           >=0.10.2.0   && <0.11
-                     , gitrev               >=1.0.0      && <1.4
-                     , hasmin
-
-library
-  default-language:    Haskell2010
-  hs-source-dirs:      src
-  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.Class
-                     , Hasmin.Types.Stylesheet
-                     -- exposed because it is needed by tests:
-                     , Hasmin.Parser.Internal
-                     , Hasmin.Parser.Value
-                     , Hasmin.Types.Color
-                     , Hasmin.Types.Declaration
-                     , Hasmin.Types.Dimension
-                     , Hasmin.Types.Numeric
-                     , Hasmin.Types.TransformFunction
-                     , Hasmin.Types.Value
-                     , Hasmin.Types.RepeatStyle
-                     , Hasmin.Types.FilterFunction
-                     , Hasmin.Types.Position
-                     , Hasmin.Types.BgSize
-                     , Hasmin.Types.String
-                     , Hasmin.Utils
-                     , Hasmin.Types.TimingFunction
-  other-modules:       Hasmin.Parser.Utils
-                     , Hasmin.Properties
-                     , Hasmin.Types.Selector
-                     , Hasmin.Types.Gradient
-                     , Hasmin.Types.PercentageLength
-                     , Hasmin.Types.Shadow
-  build-depends:       base            >=4.9        && <5.1
-                     , bifunctors      >=5.4        && <5.5
-                     , attoparsec      >=0.12       && <0.14
-                     , containers      >=0.5        && <0.6
-                     , matrix          >=0.3.4      && <0.4
-                     , mtl             >=2.2.1      && <2.3
-                     , numbers         >=3000.2.0.0 && <3000.3
-                     , parsers         >=0.12.3     && <0.13
-                     , text            >=1.2        && <1.3
-
-test-suite spec
-  default-language:    Haskell2010
-  type:                exitcode-stdio-1.0
-  hs-source-dirs:      tests
-  main-is:             Spec.hs
-  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
-  default-extensions:  OverloadedStrings
-  other-modules:       Hasmin.Parser.InternalSpec
-                     , Hasmin.Parser.ValueSpec
-                     , Hasmin.TestUtils
-                     , Hasmin.Types.ColorSpec
-                     , Hasmin.Types.DeclarationSpec
-                     , Hasmin.Types.DimensionSpec
-                     , Hasmin.Types.FilterFunctionSpec
-                     , Hasmin.Types.GradientSpec
-                     , Hasmin.Types.PositionSpec
-                     , Hasmin.Types.RepeatStyleSpec
-                     , Hasmin.Types.SelectorSpec
-                     , Hasmin.Types.ValueSpec
-                     , Hasmin.Types.BgSizeSpec
-                     , Hasmin.Types.ShadowSpec
-                     , Hasmin.Types.StringSpec
-                     , Hasmin.Types.StylesheetSpec
-                     , Hasmin.Types.TimingFunctionSpec
-                     , Hasmin.Types.TransformFunctionSpec
-  build-depends:       base             >=4.9     && <5.1
-                     , attoparsec       >=0.12    && <0.14
-                     , hspec            >=2.2     && <3.0
-                     , hspec-attoparsec >=0.1.0.0 && <0.2
-                     , mtl              >=2.2.1   && <2.3
-                     , QuickCheck       >=2.8     && <3.0
-                     , text             >=1.2     && <1.3
-                     , hasmin
-
-test-suite doctest
-  default-language:    Haskell2010
-  type:                exitcode-stdio-1.0
-  hs-source-dirs:      tests
-  main-is:             DocTest.hs
-  ghc-options:         -threaded -Wall -fno-warn-orphans
-  build-depends:       base             >=4.9     && <5.1
-                     , doctest          >=0.11    && <0.14
-                     , doctest-discover >=0.1.0.0 && <0.2
-                     , hasmin
-
-benchmark bench
-  default-language:    Haskell2010
-  type:                exitcode-stdio-1.0
-  hs-source-dirs:      benchmarks
-  main-is:             Benchmarks.hs
-  ghc-options:         -threaded -Wall -fno-warn-orphans
-  build-depends:       base             >=4.9     && <5.1
-                     , criterion        >=0.11    && <1.3
-                     , directory        >=1.3.0.0 && <1.4
-                     , text             >=1.2     && <1.3
-                     , hasmin
+name:                hasmin+version:             1.0.2+license:             BSD3+license-file:        LICENSE+author:              (c) 2017 Cristian Adrián Ontivero <cristianontivero@gmail.com>+maintainer:          Cristian Adrián Ontivero <cristianontivero@gmail.com>+synopsis:            CSS Minifier+homepage:            https://github.com/contivero/hasmin#readme+bug-reports:         https://github.com/contivero/hasmin/issues+category:            Text+build-type:          Simple+extra-source-files:  README.md+                     CHANGELOG.md+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. 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+    .+    By default, most minification techniques are enabled. For a list of+    available flags, do: ./hasmin --help++source-repository head+  type: git+  location: https://github.com/contivero/hasmin.git++executable hasmin+  default-language:    Haskell2010+  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 -Werror=incomplete-patterns+  main-is:             Main.hs+  other-modules:       Paths_hasmin+  build-depends:       base                 >=4.10       && <5.0+                     , optparse-applicative >=0.11       && <0.15+                     , text                 >=1.2        && <1.3+                     , hopfli               >=0.2        && <0.4+                     , bytestring           >=0.10.2.0   && <0.11+                     , gitrev               >=1.0.0      && <1.4+                     , hasmin++library+  default-language:    Haskell2010+  hs-source-dirs:      src+  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 -Werror=incomplete-patterns+  exposed-modules:     Hasmin+                     , Hasmin.Config+                     , Hasmin.Class+                     , Hasmin.Types.Stylesheet+                     -- exposed because it is needed by tests:+                     , Hasmin.Parser.BasicShape+                     , Hasmin.Parser.BorderRadius+                     , Hasmin.Parser.Color+                     , Hasmin.Parser.Dimension+                     , Hasmin.Parser.Gradient+                     , Hasmin.Parser.Internal+                     , Hasmin.Parser.Numeric+                     , Hasmin.Parser.PercentageLength+                     , Hasmin.Parser.Position+                     , Hasmin.Parser.Primitives+                     , Hasmin.Parser.Selector+                     , Hasmin.Parser.String+                     , Hasmin.Parser.TimingFunction+                     , Hasmin.Parser.TransformFunction+                     , Hasmin.Parser.Value+                     , Hasmin.Types.BasicShape+                     , Hasmin.Types.BgSize+                     , Hasmin.Types.BorderRadius+                     , Hasmin.Types.Color+                     , Hasmin.Types.Declaration+                     , Hasmin.Types.Dimension+                     , Hasmin.Types.FilterFunction+                     , Hasmin.Types.Numeric+                     , Hasmin.Types.Position+                     , Hasmin.Types.RepeatStyle+                     , Hasmin.Types.String+                     , Hasmin.Types.TimingFunction+                     , Hasmin.Types.TransformFunction+                     , Hasmin.Types.Value+                     , Hasmin.Types.PercentageLength+                     , Hasmin.Utils+  other-modules:       Hasmin.Parser.Utils+                     , Hasmin.Properties+                     , Hasmin.Types.Selector+                     , Hasmin.Types.Gradient+                     , Hasmin.Types.Shadow+  build-depends:       base            >=4.10       && <5.0+                     , attoparsec      >=0.12       && <0.14+                     , containers      >=0.5        && <0.6+                     , matrix          >=0.3.4      && <0.4+                     , mtl             >=2.2.1      && <2.3+                     , numbers         >=3000.2.0.0 && <3000.3+                     , parsers         >=0.12.3     && <0.13+                     , text            >=1.2        && <1.3++test-suite spec+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  main-is:             Spec.hs+  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 -Werror=incomplete-patterns+  default-extensions:  OverloadedStrings+  other-modules:       Hasmin.Parser.InternalSpec+                     , Hasmin.Parser.ValueSpec+                     , Hasmin.TestUtils+                     , Hasmin.Types.BasicShapeSpec+                     , Hasmin.Types.BgSizeSpec+                     , Hasmin.Types.ColorSpec+                     , Hasmin.Types.DeclarationSpec+                     , Hasmin.Types.DimensionSpec+                     , Hasmin.Types.FilterFunctionSpec+                     , Hasmin.Types.GradientSpec+                     , Hasmin.Types.PositionSpec+                     , Hasmin.Types.RepeatStyleSpec+                     , Hasmin.Types.SelectorSpec+                     , Hasmin.Types.ShadowSpec+                     , Hasmin.Types.StringSpec+                     , Hasmin.Types.StylesheetSpec+                     , Hasmin.Types.TimingFunctionSpec+                     , Hasmin.Types.TransformFunctionSpec+                     , Hasmin.Types.ValueSpec+  build-depends:       base                 >=4.10    && <5.0+                     , attoparsec           >=0.12    && <0.14+                     , hspec                >=2.2     && <3.0+                     , hspec-attoparsec     >=0.1.0.0 && <0.2+                     , mtl                  >=2.2.1   && <2.3+                     , QuickCheck           >=2.8     && <3.0+                     , quickcheck-instances >=0.3.16  && <0.3.19+                     , text                 >=1.2     && <1.3+                     , hasmin++test-suite doctest+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  main-is:             DocTest.hs+  ghc-options:         -threaded -Wall -fno-warn-orphans+  build-depends:       base             >=4.10    && <5.0+                     , doctest          >=0.11    && <0.16+                     , doctest-discover >=0.1.0.0 && <0.2+                     , hasmin++benchmark bench+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      benchmarks+  main-is:             Benchmarks.hs+  ghc-options:         -threaded -Wall -fno-warn-orphans+  build-depends:       base             >=4.10    && <5.0+                     , criterion        >=0.11    && <1.5+                     , directory        >=1.3.0.0 && <1.4+                     , text             >=1.2     && <1.3+                     , hasmin

@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.BasicShape+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-- Parsers for CSS <https://www.w3.org/TR/css-shapes/#typedef-basic-shape \<basic-shape>> values.+--+-----------------------------------------------------------------------------+module Hasmin.Parser.BasicShape where++import Control.Applicative ((<|>),  optional, many)+import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as A+import Data.List.NonEmpty (NonEmpty((:|)))++import Hasmin.Parser.Utils+import Hasmin.Parser.PercentageLength+import Hasmin.Parser.Position+import Hasmin.Parser.BorderRadius+import Hasmin.Types.BasicShape+import Hasmin.Utils++-- inset( <shape-arg>{1,4} [round <border-radius>]? )+inset :: Parser BasicShape+inset = do+  sa  <- percentageLength <* skipComments+  sas <- atMost 3 (percentageLength <* skipComments)+  br  <- optional (A.asciiCI "round" *> skipComments *> borderRadius)+  pure $ Inset (sa:|sas) br++       -- circle( [<shape-radius>]? [at <position>]? )+circle :: Parser BasicShape+circle =+    Circle <$> optional (shapeRadius <* skipComments)+           <*> optional (A.asciiCI "at" *> skipComments *> position)++-- ellipse( [<shape-radius>{2}]? [at <position>]? )+ellipse :: Parser BasicShape+ellipse = Ellipse <$> twoSR <*> optional atPosition+  where atPosition = lexeme (A.asciiCI "at") *> position+        twoSR      = A.option None $ do+            sr1 <- shapeRadius+            (Two sr1 <$> (skipComments *> shapeRadius)) <|> pure (One sr1)++-- polygon( [<fill-rule>,]? [<shape-arg> <shape-arg>]# )+polygon :: Parser BasicShape+polygon = Polygon <$> optional fillrule <*> shapeargs+  where shapeargs = (:|) <$> pairOf percentageLength+                         <*> many (comma *> pairOf percentageLength)+        fillrule  = parserFromPairs+                      [("nonzero", pure NonZero)+                      ,("evenodd", pure EvenOdd)] <* comma+        pairOf p = mzip (p <* skipComments) p++shapeRadius :: Parser ShapeRadius+shapeRadius = either SRPercentage SRLength <$> percentageLength+           <|> parserFromPairs [("closest-side", pure SRClosestSide)+                               ,("farthest-side", pure SRFarthestSide)]+

@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.BorderRadius+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-- Parsers for CSS values.+--+-----------------------------------------------------------------------------+module Hasmin.Parser.BorderRadius+    ( borderRadius+    ) where++import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as A+import Data.List.NonEmpty (NonEmpty((:|)))++import Hasmin.Parser.Utils+import Hasmin.Parser.PercentageLength+import Hasmin.Types.BorderRadius++-- <length-percentage>{1,4} [ / <length-percentage>{1,4} ]?+borderRadius :: Parser BorderRadius+borderRadius = do+    x  <- percentageLength <* skipComments+    xs <- atMost 3 (percentageLength <* skipComments)+    ys <- A.option [] $ A.char '/' *> atMost 4 (skipComments *> percentageLength)+    pure $ BorderRadius (x:|xs) ys

@@ -0,0 +1,101 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.Color+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-- Parsers for CSS \<color> values.+--+-----------------------------------------------------------------------------+module Hasmin.Parser.Color where++import Control.Applicative ((<|>),  optional)+import Control.Monad (mzero)+import Data.Attoparsec.Text (Parser)+import Data.Maybe (fromMaybe)+import qualified Data.Attoparsec.Text as A+import Data.Text (Text)+import qualified Data.Text as T+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map++import Hasmin.Parser.Utils+import Hasmin.Parser.Numeric+import Hasmin.Types.Color++hex :: Parser Color+hex = do+    _ <- A.char '#'+    a <- hexadecimal+    b <- hexadecimal+    c <- hexadecimal+    x <- optional hexadecimal+    case x of+      Nothing -> pure $ mkHex3 a b c+      Just d  -> do y <- optional hexadecimal+                    case y of+                      Nothing -> pure $ mkHex4 a b c d+                      Just e  -> do f <- hexadecimal+                                    z <- optional hexadecimal+                                    case z of+                                      Nothing -> pure $ mkHex6 [a,b] [c,d] [e,f]+                                      Just g  -> do h <- hexadecimal+                                                    pure $ mkHex8 [a,b] [c,d] [e,f] [g,h]++-- Assumes "rgb(" has already been read+rgb :: Parser Color+rgb = functionParser (rgbInt <|> rgbPer)+  where rgbInt = mkRGBInt <$> word8 <* comma <*> word8 <* comma <*> word8+        rgbPer = mkRGBPer <$> percentage <* comma+                          <*> percentage <* comma <*> percentage++-- Assumes "rgba(" has already been read+rgba :: Parser Color+rgba = functionParser (rgbaInt <|> rgbaPer)+  where rgbaInt = mkRGBAInt <$> word8 <* comma <*> word8 <* comma+                            <*> word8 <* comma <*> alphavalue+        rgbaPer = mkRGBAPer <$> percentage <* comma <*> percentage <* comma+                            <*> percentage <* comma <*> alphavalue++-- Assumes "hsl(" has already been read+hsl :: Parser Color+hsl = functionParser p+  where p = mkHSL <$> int <* comma <*> percentage <* comma <*> percentage++-- Assumes "hsla(" has already been read+hsla :: Parser Color+hsla = functionParser p+  where p = mkHSLA <$> int <* comma <*> percentage <* comma+                   <*> percentage <* comma <*> alphavalue++-- | Parser for <https://drafts.csswg.org/css-color-3/#colorunits \<color\>>.+color :: Parser Color+color = hex <|> othercolor+  where+    othercolor = do+      i <- ident+      let t = T.toLower i+      fromMaybe (colorFunctionParser t) (Map.lookup t namedColorsParsersMap)++namedColorsParsersMap :: Map Text (Parser Color)+namedColorsParsersMap = Map.fromList $ foldr f [] keywordColors+  where f x xs = let a = fst x+                 in (a, pure $ Named a) : xs++colorFunctionsParsers :: [(Text, Parser Color)]+colorFunctionsParsers =+          [("rgb",  rgb)+          ,("rgba", rgba)+          ,("hsl",  hsl)+          ,("hsla", hsla)+          ]++functionPar :: Map Text (Parser a) -> Text -> Parser a+functionPar m i = A.char '(' *> fromMaybe mzero (Map.lookup t m)+  where t = T.toLower i++colorFunctionParser :: Text -> Parser Color+colorFunctionParser = functionPar (Map.fromList colorFunctionsParsers)

@@ -0,0 +1,70 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.Dimension+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-- Parsers for CSS dimensions, i.e. \<length>, \<time>, etc.+--+-----------------------------------------------------------------------------+module Hasmin.Parser.Dimension where++import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as A+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import qualified Data.Char as C+import Data.Text (Text)+import qualified Data.Text as T+import Control.Monad (mzero)+import Control.Arrow ((&&&))++import Hasmin.Parser.Utils+import Hasmin.Parser.Numeric+import Hasmin.Types.Numeric+import Hasmin.Class+import Hasmin.Types.Dimension++distance :: Parser Length+distance = dimensionParser distanceConstructorsMap NullLength+  where distanceConstructorsMap = Map.fromList distanceConstructorsList++angle :: Parser Angle+angle = dimensionParser angleConstructorsMap NullAngle+  where angleConstructorsMap = Map.fromList angleConstructorsList++time :: Parser Time+time = do+    n <- number+    u <- opt (A.takeWhile1 C.isAlpha)+    if T.null u+       then mzero+       else case Map.lookup (T.toLower u) timeConstructorsMap of+              Just f  -> pure $ f n+              Nothing -> mzero -- parsed units aren't angle units, fail+  where timeConstructorsMap = Map.fromList timeConstructorsList++timeConstructorsList :: [(Text, Number -> Time)]+timeConstructorsList = fmap (toText &&& flip Time) [minBound..]++angleConstructorsList :: [(Text, Number -> Angle)]+angleConstructorsList = fmap (toText &&& flip Angle) [minBound..]++distanceConstructorsList :: [(Text, Number -> Length)]+distanceConstructorsList = fmap (toText &&& flip Length) [minBound..]++-- Create a numerical parser based on a Map.+-- See for instance, the "angle" parser+dimensionParser :: Map Text (Number -> a) -> a -> Parser a+dimensionParser m unitlessValue = do+    n <- number+    u <- opt (A.takeWhile1 C.isAlpha)+    if T.null u+       then if n == 0+               then pure unitlessValue -- <angle> 0, without units+               else mzero -- Non-zero <number>, fail+       else case Map.lookup (T.toCaseFold u) m of+              Just f  -> pure $ f n+              Nothing -> mzero -- parsed units aren't angle units, fail

@@ -0,0 +1,87 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.Value+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-- Parsers for CSS \<gradient> values.+--+-----------------------------------------------------------------------------+module Hasmin.Parser.Gradient where++import Control.Applicative ((<|>), many, optional)+import Data.Functor (($>))+import Text.Parser.Permutation ((<|?>), (<$$>), (<$?>), (<||>), permute)+import Data.Maybe (isNothing)+import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as A++import Hasmin.Parser.Utils+import Hasmin.Parser.Color+import Hasmin.Parser.Position+import Hasmin.Parser.Dimension+import Hasmin.Parser.PercentageLength+import Hasmin.Types.Gradient+import Hasmin.Utils++radialgradient :: Parser Gradient+radialgradient = functionParser $ do+    (def, c) <- A.option (True, RadialGradient Nothing Nothing) ((False,) <$> endingShapeAndSize <* skipComments)+    p  <- optional (A.asciiCI "at" *> skipComments *> position)+    _  <- if def && isNothing p+             then pure '*' -- do nothing+             else comma+    cs <- colorStopList+    pure $ c p cs+  where circle = A.asciiCI "circle" $> Just Circle <* skipComments+        ellipse = A.asciiCI "ellipse" $> Just Ellipse <* skipComments+        endingShapeAndSize = r1 <|> r2 <|> r3+          where r1 = permute (RadialGradient <$?> (Nothing, ellipse) <||> (Just <$> (PL <$> percentageLength <*> lexeme percentageLength)))+                r2 = permute (RadialGradient <$?> (Nothing, circle) <||> ((Just . SL) <$> distance <* skipComments))+                r3 = permute (RadialGradient <$?> (Nothing, circle <|> ellipse) <||> extentKeyword)+                   <|> permute (RadialGradient <$$> (circle <|> ellipse) <|?> (Nothing, extentKeyword))+                extentKeyword = Just <$>+                    parserFromPairs [("closest-corner",  pure ClosestCorner)+                                    ,("closest-side",    pure ClosestSide)+                                    ,("farthest-corner", pure FarthestCorner)+                                    ,("farthest-side",   pure FarthestSide)] <* skipComments++-- | Assumes "linear-gradient(", or one of its prefixed equivalents, has been parsed.+-- : [<angle>|to <side-or-corner> ,]? <color-stop> [, <color-stop>]++lineargradient :: Parser Gradient+lineargradient = functionParser (lg <|> oldLg)+  where lg = LinearGradient <$> optional angleOrSide <*> colorStopList+        oldLg = OldLinearGradient <$> optional ((ga <|> sc) <* comma)+                                  <*> colorStopList+        angleOrSide = (ga <|> gs) <* comma+        ga = Left <$> angle+        gs = A.asciiCI "to" *> skipComments *> sc+        sc = Right <$> sideOrCorner++-- <side-or-corner> = [left | right] || [top | bottom]+sideOrCorner :: Parser (Side, Maybe Side)+sideOrCorner = orderOne <|> orderTwo+  where orderOne = mzip (leftright <* skipComments) (optional topbottom)+        orderTwo = mzip (topbottom <* skipComments) (optional leftright)++        leftright :: Parser Side+        leftright =  parserFromPairs [("left", pure LeftSide), ("right", pure RightSide)]++        topbottom :: Parser Side+        topbottom = parserFromPairs [("top", pure TopSide), ("bottom", pure BottomSide)]++colorStopList :: Parser [ColorStop]+colorStopList = do+    c1 <- colorStop+    _  <- A.char ',' <* skipComments+    c2 <- colorStop+    cs <- many (A.char ',' *> skipComments *> colorStop)+    pure $ c1:c2:cs++colorStop :: Parser ColorStop+colorStop = ColorStop <$> color <* skipComments+        <*> optional (percentageLength <* skipComments)

@@ -21,204 +21,28 @@     , supportsCondition     ) where -import Control.Applicative ((<|>), many, some, empty, optional)+import Control.Applicative ((<|>), many, some, optional) import Data.Functor (($>))-import Data.Attoparsec.Combinator (lookAhead, sepBy, endOfInput)-import Data.Attoparsec.Text (asciiCI, char, many1, manyTill,-  option, Parser, satisfy, string)-import Data.List.NonEmpty (NonEmpty( (:|) ))+import Data.Attoparsec.Combinator (lookAhead, endOfInput)+import Data.Attoparsec.Text (asciiCI, char, manyTill,+  Parser, satisfy)+import Data.List.NonEmpty (NonEmpty) import Data.Monoid ((<>)) import Data.Maybe (fromMaybe) import Data.Text (Text)-import Data.Text.Lazy.Builder as LB-import Data.Map.Strict (Map) import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Attoparsec.Text as A import qualified Data.Char as C import qualified Data.Text as T-import qualified Data.Text.Lazy as TL  import Hasmin.Parser.Utils import Hasmin.Parser.Value-import Hasmin.Types.Selector+import Hasmin.Parser.Selector import Hasmin.Types.Stylesheet import Hasmin.Types.Declaration-import Hasmin.Types.String --- | Parser for CSS complex selectors (see 'Selector' for more details).-selector :: Parser Selector-selector = Selector <$> compoundSelector <*> combinatorsAndSelectors-  where combinatorsAndSelectors = many ((,) <$> combinator <* skipComments  <*> compoundSelector)---- First tries with '>>' (descendant), '>' (child), '+' (adjacent sibling), and--- '~' (general sibling) combinators. If those fail, it tries with the--- descendant (whitespace) combinator. This is done to allow comments in-between.------ | Parser for selector combinators, i.e. ">>" (descendant), '>' (child), '+'--- (adjacent sibling), '~' (general sibling), and ' ' (descendant) combinators.-combinator :: Parser Combinator-combinator =  (skipComments *> ((string ">>" $> DescendantBrackets)-          <|> (char '>' $> Child)-          <|> (char '+' $> AdjacentSibling)-          <|> (char '~' $> GeneralSibling)))-          <|> (satisfy ws $> DescendantSpace)-  where ws c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f'--compoundSelector :: Parser CompoundSelector-compoundSelector =-    (:|) <$> (typeSelector <|> universal)-                           <*> many p-                       <|> ((Universal mempty :|) <$> many1 p)-  where p = idSel <|> classSel <|> attributeSel <|> pseudo--- | Parses a \"number sign\" (U+0023, \#) immediately followed by the ID value,--- which must be a CSS identifier.-idSel :: Parser SimpleSelector-idSel = do-    _    <- char '#'-    name <- mconcat <$> many1 nmchar-    pure . IdSel . TL.toStrict $ toLazyText name---- class: '.' IDENT-classSel :: Parser SimpleSelector-classSel = char '.' *> (ClassSel <$> ident)--{--attrib-  : '[' S* [ namespace_prefix ]? IDENT S*-        [ [ PREFIXMATCH |-            SUFFIXMATCH |-            SUBSTRINGMATCH |-            '=' |-            INCLUDES |-            DASHMATCH ] S* [ IDENT | STRING ] S*-        ]? ']'-  ;--}--- FIXME namespace prefixes aren't allowed inside attribute selectors,--- but they should be.-attributeSel :: Parser SimpleSelector-attributeSel = do-    _     <- char '['-    attId <- lexeme ident-    g     <- option Attribute attValue-    _     <- char ']'-    pure $ AttributeSel (g attId)-  where attValue = do-          f <- ((string "^=" $> (:^=:)) <|>-                (string "$=" $> (:$=:)) <|>-                (string "*=" $> (:*=:)) <|>-                (string "="  $> (:=:))  <|>-                (string "~=" $> (:~=:)) <|>-                (string "|=" $> (:|=:))) <* skipComments-          attval <- identOrString <* skipComments-          pure (`f` attval)--identOrString :: Parser (Either Text StringType)-identOrString = (Left <$> ident) <|> (Right <$> stringtype)---- type_selector: [namespace_prefix]? element_name-typeSelector :: Parser SimpleSelector-typeSelector = Type <$> opt namespacePrefix <*> ident---- universal: [ namespace_prefix ]? '*'-universal :: Parser SimpleSelector-universal = Universal <$> opt namespacePrefix <* char '*'---- namespace_prefix: [ IDENT | '*' ]? '|'-namespacePrefix :: Parser Text-namespacePrefix = opt (ident <|> string "*") <* char '|'--{- '::' starts a pseudo-element, ':' a pseudo-class-   Exceptions: :first-line, :first-letter, :before and :after.-   Note that pseudo-elements are restricted to one per selector and-   occur only in the last simple_selector_sequence.--   <pseudo-class-selector> = ':' <ident-token> |-                             ':' <function-token> <any-value> ')'-   <pseudo-element-selector> = ':' <pseudo-class-selector>--}--- pseudo: ':' ':'? [ IDENT | functional_pseudo ]-pseudo :: Parser SimpleSelector-pseudo = char ':' *> (pseudoElementSelector <|> pseudoClassSelector)-  where pseudoClassSelector = do-            i <- ident-            c <- A.peekChar-            case c of-              Just '(' -> char '(' *> case Map.lookup (T.toCaseFold i) fpcMap of-                            Just p  -> functionParser p-                            Nothing -> functionParser (FunctionalPseudoClass i <$> A.takeWhile (/= ')'))-              _        -> pure $ PseudoClass i-        pseudoElementSelector =-            (char ':' *> (PseudoElem <$> ident)) <|> (ident >>= handleSpecialCase)-          where-            handleSpecialCase :: Text -> Parser SimpleSelector-            handleSpecialCase t-                | isSpecialPseudoElement = pure $ PseudoElem t-                | otherwise              = empty-              where isSpecialPseudoElement = T.toCaseFold t `elem` specialPseudoElements---- \<An+B> microsyntax parser.-anplusb :: Parser AnPlusB-anplusb = (asciiCI "even" $> Even)-      <|> (asciiCI "odd" $> Odd)-      <|> do-        s    <- optional parseSign-        dgts <- option mempty digits-        case dgts of-          [] -> ciN *> skipComments *> option (A s Nothing) (AB s Nothing <$> bValue)-          _  -> let n = read dgts :: Int-                in (ciN *> skipComments *> option (A s $ Just n) (AB s (Just n) <$> bValue))-                    <|> (pure . B $ getSign s * n)-  where ciN       = satisfy (\c -> c == 'N' || c == 'n')-        parseSign = (char '-' $> Minus) <|> (char '+' $> Plus)-        getSign (Just Minus) = -1-        getSign _            = 1-        bValue    = do-            readPlus <- (char '-' $> False) <|> (char '+' $> True)-            d        <- skipComments *> digits-            if readPlus-               then pure $ read d-               else pure $ read ('-':d)---- Functional pseudo classes parsers map-fpcMap :: Map Text (Parser SimpleSelector)-fpcMap = Map.fromList-    [buildTuple "nth-of-type"      (\x -> FunctionalPseudoClass2 x <$> anplusb)-    ,buildTuple "nth-last-of-type" (\x -> FunctionalPseudoClass2 x <$> anplusb)-    ,buildTuple "nth-column"       (\x -> FunctionalPseudoClass2 x <$> anplusb)-    ,buildTuple "nth-last-column"  (\x -> FunctionalPseudoClass2 x <$> anplusb)-    ,buildTuple "not"              (\x -> FunctionalPseudoClass1 x <$> compoundSelectorList)-    ,buildTuple "matches"          (\x -> FunctionalPseudoClass1 x <$> compoundSelectorList)-    ,buildTuple "nth-child"        (anbAndSelectors . FunctionalPseudoClass3)-    ,buildTuple "nth-last-child"   (anbAndSelectors . FunctionalPseudoClass3)-    ,buildTuple "lang"             (const (Lang <$> identOrString))-    ---    -- :drop( [ active || valid || invalid ]? )-    -- The :drop() functional pseudo-class is identical to :drop-    -- ,("drop", anplusb)-    ---    -- It accepts a comma-separated list of one or more language ranges as its-    -- argument. Each language range in :lang() must be a valid CSS <ident> or-    -- <string>.-    -- ,("lang", anplusb)-    ---    -- ,("dir", text)-    -- ,("has", relative selectors)-    ]-  where buildTuple t c = (t, c t)-        compoundSelectorList = (:) <$> compoundSelector <*> many (comma *> compoundSelector)-        anbAndSelectors constructor = do-            a <- anplusb <* skipComments-            o <- option [] (asciiCI "of" *> skipComments *> compoundSelectorList)-            pure $ constructor a o---- | Parse a list of comma-separated selectors, ignoring whitespace and--- comments.-selectors :: Parser [Selector]-selectors = lexeme selector `sepBy` char ','- -- | Parser for a declaration, starting by the property name. declaration :: Parser Declaration declaration = do@@ -239,10 +63,10 @@ -- | Used to parse the "!important" at the end of declarations, ignoring spaces -- and comments after the '!'. important :: Parser Bool-important = option False (char '!' *> skipComments *> asciiCI "important" $> True)+important = A.option False (char '!' *> skipComments *> asciiCI "important" $> True)  iehack :: Parser Bool-iehack = option False (string "\\9" $> True)+iehack = A.option False (A.string "\\9" $> True)  -- Note: The handleSemicolons outside is needed to handle parsing "h1 { ; }". --@@ -250,7 +74,7 @@ -- declarations (e.g. ; ;) declarations :: Parser [Declaration] declarations = many (declaration <* handleSemicolons) <* handleSemicolons-  where handleSemicolons = many (string ";" *> skipComments)+  where handleSemicolons = many (A.char ';' *> skipComments)  -- | Parser for CSS at-rules (e.g. \@keyframes, \@media) atRule :: Parser Rule@@ -278,7 +102,7 @@ atImport :: Parser Rule atImport = do     esu <- skipComments *> stringOrUrl-    mql <- option [] mediaQueryList+    mql <- A.option [] mediaQueryList     _   <- skipComments <* char ';'     pure $ AtImport esu mql @@ -290,7 +114,7 @@ -- <namespace-prefix> = IDENT atNamespace :: Parser Rule atNamespace = do-    i   <- skipComments *> option mempty ident+    i   <- skipComments *> A.option mempty ident     ret <- if T.null i               then (AtNamespace i . Left) <$> stringtype               else decideBasedOn i@@ -323,19 +147,19 @@  atMedia :: Parser Rule atMedia = do-  m <- satisfy C.isSpace *> mediaQueryList-  _ <- char '{' <* skipComments-  r <- manyTill (rule <* skipComments) (lookAhead (char '}'))-  _ <- char '}'-  pure $ AtMedia m r+    m <- satisfy C.isSpace *> mediaQueryList+    _ <- char '{' <* skipComments+    r <- manyTill (rule <* skipComments) (lookAhead (char '}'))+    _ <- char '}'+    pure $ AtMedia m r  atSupports :: Parser Rule atSupports = do-  sc <- satisfy C.isSpace *> supportsCondition-  _  <- lexeme (char '{')-  r  <- manyTill (rule <* skipComments) (lookAhead (char '}'))-  _ <- char '}'-  pure $ AtSupports sc r+    sc <- satisfy C.isSpace *> supportsCondition+    _  <- lexeme (char '{')+    r  <- manyTill (rule <* skipComments) (lookAhead (char '}'))+    _ <- char '}'+    pure $ AtSupports sc r  -- | Parser for a <https://drafts.csswg.org/css-conditional-3/#supports_condition supports_condition>, -- needed by @\@supports@ rules.@@ -406,7 +230,7 @@ -- and comments. stylesheet :: Parser [Rule] stylesheet = do-  charset    <- option [] ((:[]) <$> atCharset <* skipComments)+  charset    <- A.option [] ((:[]) <$> atCharset <* skipComments)   imports    <- many (atImport <* skipComments)   namespaces <- many (atNamespace <* skipComments)   _ <- skipComments -- if there is no charset, import, or namespace at rule we need this here.@@ -443,7 +267,7 @@         mediaType = lexeme ident         andExpressions = many (h *> expression)         h = lexeme (asciiCI "and" *> satisfy C.isSpace)-        optionalNotOrOnly = option mempty (asciiCI "not" <|> asciiCI "only")+        optionalNotOrOnly = A.option mempty (asciiCI "not" <|> asciiCI "only")  -- https://www.w3.org/TR/mediaqueries-4/#typedef-media-condition-without-or expression :: Parser Expression

@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.Numeric+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-----------------------------------------------------------------------------+module Hasmin.Parser.Numeric+    ( alphavalue+    , rational+    , int+    , percentage+    , number+    ) where++import Control.Applicative ((<|>))+import Numeric (readSigned, readFloat)+import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as A++import Hasmin.Types.Numeric+import Hasmin.Parser.Utils+import Hasmin.Parser.Primitives++-- | Parser for <https://www.w3.org/TR/css-values-3/#numbers \<number\>>.+number :: Parser Number+number = Number <$> rational++-- | Parser for <https://drafts.csswg.org/css-values-3/#percentages \<percentage\>>.+percentage :: Parser Percentage+percentage = Percentage <$> rational <* A.char '%'++alphavalue :: Parser Alphavalue+alphavalue = mkAlphavalue <$> rational++-- Note that many properties that allow an integer or real number as a value+-- actually restrict the value to some range, often to a non-negative value.+--+-- | Real number parser. \<number\>: <'int' integer> | [0-9]*.[0-9]++rational :: Parser Rational+rational = do+    sign <- A.option [] (wrapMinus <$> (A.char '-' <|> A.char '+'))+    dgts <- ((++) <$> digits <*> A.option "" fractionalPart)+           <|> ("0"++) <$> fractionalPart -- append a zero for read not to fail+    e <- A.option [] expo+    pure . fst . head $ readSigned readFloat (sign ++ dgts ++ e)+  where fractionalPart = (:) <$> A.char '.' <*> digits+        expo = (:) <$> A.satisfy (\c -> c == 'e' || c == 'E') <*> int'+        wrapMinus x = [x | x == '-'] -- we use this since read fails with leading '+'

@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.PercentageLength+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-----------------------------------------------------------------------------+module Hasmin.Parser.PercentageLength where++import Control.Applicative ((<|>))+import Control.Monad (mzero)+import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as A+import qualified Data.Map.Strict as Map+import qualified Data.Char as C+import qualified Data.Text as T++import Hasmin.Parser.Utils+import Hasmin.Parser.Numeric+import Hasmin.Parser.Dimension+import Hasmin.Types.Numeric+import Hasmin.Types.Dimension+import Hasmin.Types.PercentageLength++percentageLength :: Parser PercentageLength+percentageLength = do+    n    <- number+    rest <- opt (A.string "%" <|> A.takeWhile1 C.isAlpha)+    if T.null rest  -- if true, then it was just a <number> value+       then if n == 0+               then pure $ Right NullLength+               else mzero+       else let r = T.toLower rest+            in case Map.lookup r plMap of+                 Just f  -> pure $ f n+                 Nothing -> mzero+  where plMap = Map.fromList $+            ("%", Left . toPercentage):(fmap . fmap) (Right .) distanceConstructorsList

@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.Position+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-- Parsers for CSS \<position> values.+--+-----------------------------------------------------------------------------+module Hasmin.Parser.Position where++import Control.Applicative ((<|>), optional)+import Data.Functor (($>))+import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as A+import qualified Data.Text as T+import Control.Monad (mzero)++import Hasmin.Parser.Utils+import Hasmin.Parser.PercentageLength+import Hasmin.Types.Position+import Hasmin.Types.PercentageLength++-- | Parser for <https://drafts.csswg.org/css-values-3/#position \<position\>>.+position :: Parser Position+position = perLen <|> keyword+  where+    perLen = percentageLength >>= startsWithPL+    keyword =+        parserFromPairs [("left",   startsWith (Just PosLeft)   tb)+                        ,("right",  startsWith (Just PosRight)  tb)+                        ,("top",    startsWith (Just PosTop)    lr)+                        ,("bottom", startsWith (Just PosBottom) lr)+                        ,("center", startsWithCenter)]+    tb = (A.asciiCI "top"  $> Just PosTop,  A.asciiCI "bottom" $> Just PosBottom)+    lr = (A.asciiCI "left" $> Just PosLeft, A.asciiCI "right"  $> Just PosRight)++    startsWithPL :: PercentageLength -> Parser Position+    startsWithPL x = skipComments *>+        (followsWithPL <|> someKeyword <|> wasASinglePL)+      where+        pl = Just x+        followsWithPL = Position Nothing pl Nothing <$> (Just <$> percentageLength)+        wasASinglePL  = pure $ Position Nothing pl Nothing Nothing+        someKeyword   = do+            i <- ident+            case T.toCaseFold i of+              "center" -> pure $ Position Nothing pl (Just PosCenter) Nothing+              "top"    -> pure $ Position Nothing pl (Just PosTop) Nothing+              "bottom" -> pure $ Position Nothing pl (Just PosBottom) Nothing+              _        -> mzero++    maybePL :: Parser (Maybe PercentageLength)+    maybePL = optional percentageLength++    startsWithCenter :: Parser Position+    startsWithCenter = skipComments *>+        (followsWithPL <|> followsWithAKeyword <|> pure (posTillNow Nothing Nothing))+      where+        followsWithPL = (posTillNow Nothing . Just) <$> percentageLength+        followsWithAKeyword = do+            i <- ident <* skipComments+            let f x = posTillNow (Just x) <$> maybePL+            case T.toCaseFold i of+              "left"   -> f PosLeft+              "right"  -> f PosRight+              "top"    -> f PosTop+              "bottom" -> f PosBottom+              "center" -> pure $ posTillNow (Just PosCenter) Nothing+              _        -> mzero+        posTillNow = Position (Just PosCenter) Nothing++    -- Used for the cases when a position starts with the X axis (left and right+    -- keywords) or Y axis (top and bottom)+    startsWith :: Maybe PosKeyword+               -> (Parser (Maybe PosKeyword), Parser (Maybe PosKeyword))+               -> Parser Position+    startsWith x (p1, p2) = do+        _  <- skipComments+        pl <- optional (percentageLength <* skipComments)+        let endsWithCenter = Position x pl <$> center <*> pure Nothing+            endsWithKeywordAndMaybePL = Position x pl <$> posKeyword <*> maybePL+            endsWithPL = pure $ Position x Nothing Nothing pl+        endsWithCenter <|> endsWithKeywordAndMaybePL <|> endsWithPL+      where+        posKeyword = (p1 <|> p2)  <* skipComments+        center = A.asciiCI "center" $> Just PosCenter+

@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.Primitives+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-- Parsers for very basic CSS grammar tokens.+--+-----------------------------------------------------------------------------+module Hasmin.Parser.Primitives+    ( ident+    , escape+    , unicode+    , nmstart+    , nmchar+    , int+    , int'+    , digits+    ) where++import Control.Applicative ((<|>), some, many)+import Data.Attoparsec.Text (Parser, (<?>))+import Data.Monoid ((<>))+import Data.Text.Lazy.Builder (Builder)+import Data.Text (Text)+import qualified Data.Attoparsec.Text as A+import qualified Data.Char as C+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as B++-- TODO combine with unicode to make it more efficient+-- escape: {unicode}|\\[^\n\r\f0-9a-f]+escape :: Parser Builder+escape =  unicode+      <|> (mappend <$> (B.singleton <$> A.char '\\') <*> (B.singleton <$> A.satisfy cond))+      <?> "not an escape token: {unicode}|\\\\[^\\n\\r\\f0-9a-f]"+  where cond c = c /= '\n'+              && c /= '\r'+              && c /= '\f'+              && (not . C.isHexDigit) c++-- unicode        \\[0-9a-f]{1,6}(\r\n|[ \n\r\t\f])?+unicode :: Parser Builder+unicode = do+    backslash <- A.char '\\'+    hexChars  <- A.takeWhile1 C.isHexDigit+    _         <- A.option mempty (A.string "\r\n" <|> (T.singleton <$> A.satisfy ws))+    if T.length hexChars <= 6+       then pure $ B.singleton backslash <> B.fromText hexChars+       else fail "unicode escaped character with length greater than 6"+  where ws x = x == ' ' || x == '\n' || x == '\r' || x == '\t' || x == '\f'++-- ident: -?{nmstart}{nmchar}*+ident :: Parser Text+ident = do+    dash <- A.option mempty (B.singleton <$> A.char '-')+    ns   <- nmstart+    nc   <- mconcat <$> many nmchar+    pure $ TL.toStrict (B.toLazyText (dash <> ns <> nc))++-- nmstart: [_a-z]|{nonascii}|{escape}+nmstart :: Parser Builder+nmstart = B.singleton <$> A.satisfy (\c -> C.isAlpha c || (not . C.isAscii) c || c == '_')+       <|> escape+       <?> "not an nmstart token: [_a-z]|{nonascii}|{escape}"++-- nmchar: [_a-z0-9-]|{nonascii}|{escape}+nmchar :: Parser Builder+nmchar = B.singleton <$> A.satisfy cond <|> escape+  where cond x = C.isAlphaNum x || x == '_' || x == '-'+              || (not . C.isAscii) x++-- | \<integer\> data type parser, but into a String instead of an Int, for other+-- parsers to use (e.g.: see the parsers int, or rational)+int' :: Parser String+int' = do+  sign <- A.char '-' <|> pure '+'+  d    <- digits+  case sign of+    '+' -> pure d+    '-' -> pure (sign:d)+    _   -> error "int': parsed a number starting with other than [+|-]"++-- | Parser for \<integer\>: [+|-][0-9]++int :: Parser Int+int = read <$> int'++-- | Parser one or more digits.+digits :: Parser String+digits = some A.digit

@@ -0,0 +1,209 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.Selector+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-----------------------------------------------------------------------------+module Hasmin.Parser.Selector+    ( selectors+    , selector+    ) where++import Control.Applicative ((<|>), many, some, empty, optional)+import Data.Attoparsec.Combinator (sepBy)+import Data.Attoparsec.Text (asciiCI, char, Parser, satisfy, string)+import qualified Data.Attoparsec.Text as A+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Data.Functor (($>))+import qualified Data.Text.Lazy.Builder as LB+import Data.List.NonEmpty (NonEmpty( (:|) ))++import Hasmin.Parser.Utils+import Hasmin.Parser.String+import Hasmin.Utils++import Hasmin.Types.Selector+import Hasmin.Types.String++-- | Parser for CSS complex selectors (see 'Selector' for more details).+selector :: Parser Selector+selector = Selector <$> compoundSelector <*> combinatorsAndSelectors+  where combinatorsAndSelectors = many $ mzip (combinator <* skipComments) compoundSelector++-- First tries with '>>' (descendant), '>' (child), '+' (adjacent sibling), and+-- '~' (general sibling) combinators. If those fail, it tries with the+-- descendant (whitespace) combinator. This is done to allow comments in-between.+--+-- | Parser for selector combinators, i.e. ">>" (descendant), '>' (child), '+'+-- (adjacent sibling), '~' (general sibling), and ' ' (descendant) combinators.+combinator :: Parser Combinator+combinator =  (skipComments *> ((string ">>" $> DescendantBrackets)+          <|> (char '>' $> Child)+          <|> (char '+' $> AdjacentSibling)+          <|> (char '~' $> GeneralSibling)))+          <|> (satisfy ws $> DescendantSpace)+  where ws c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f'++compoundSelector :: Parser CompoundSelector+compoundSelector = cs1 <|> cs2+  where cs1 = do+            sel  <- typeSelector <|> universal+            sels <- many p+            pure $ sel:|sels+        cs2 = (Universal mempty :|) <$> some p+        p = idSel <|> classSel <|> attributeSel <|> pseudo++-- | Parses a \"number sign\" (U+0023, \#) immediately followed by the ID value,+-- which must be a CSS identifier.+idSel :: Parser SimpleSelector+idSel = do+    _    <- char '#'+    name <- mconcat <$> some nmchar+    pure . IdSel . TL.toStrict $ LB.toLazyText name++-- class: '.' IDENT+classSel :: Parser SimpleSelector+classSel = char '.' *> (ClassSel <$> ident)++{-+attrib+  : '[' S* [ namespace_prefix ]? IDENT S*+        [ [ PREFIXMATCH |+            SUFFIXMATCH |+            SUBSTRINGMATCH |+            '=' |+            INCLUDES |+            DASHMATCH ] S* [ IDENT | STRING ] S*+        ]? ']'+  ;+-}+-- FIXME namespace prefixes aren't allowed inside attribute selectors,+-- but they should be.+attributeSel :: Parser SimpleSelector+attributeSel = do+    _     <- char '['+    attId <- lexeme ident+    g     <- A.option Attribute attValue+    _     <- char ']'+    pure $ AttributeSel (g attId)+  where attValue = do+          f <- ((string "^=" $> (:^=:)) <|>+                (string "$=" $> (:$=:)) <|>+                (string "*=" $> (:*=:)) <|>+                (string "="  $> (:=:))  <|>+                (string "~=" $> (:~=:)) <|>+                (string "|=" $> (:|=:))) <* skipComments+          attval <- identOrString <* skipComments+          pure (`f` attval)++-- type_selector: [namespace_prefix]? element_name+typeSelector :: Parser SimpleSelector+typeSelector = Type <$> opt namespacePrefix <*> ident++-- universal: [ namespace_prefix ]? '*'+universal :: Parser SimpleSelector+universal = Universal <$> opt namespacePrefix <* char '*'++-- namespace_prefix: [ IDENT | '*' ]? '|'+namespacePrefix :: Parser Text+namespacePrefix = opt (ident <|> string "*") <* char '|'++{- '::' starts a pseudo-element, ':' a pseudo-class+   Exceptions: :first-line, :first-letter, :before and :after.+   Note that pseudo-elements are restricted to one per selector and+   occur only in the last simple_selector_sequence.++   <pseudo-class-selector> = ':' <ident-token> |+                             ':' <function-token> <any-value> ')'+   <pseudo-element-selector> = ':' <pseudo-class-selector>+-}+-- pseudo: ':' ':'? [ IDENT | functional_pseudo ]+pseudo :: Parser SimpleSelector+pseudo = char ':' *> (pseudoElementSelector <|> pseudoClassSelector)+  where pseudoClassSelector = do+            i <- ident+            c <- A.peekChar+            case c of+              Just '(' -> char '(' *> case Map.lookup (T.toLower i) fpcMap of+                            Just p  -> functionParser p+                            Nothing -> functionParser (FunctionalPseudoClass i <$> A.takeWhile (/= ')'))+              _        -> pure $ PseudoClass i+        pseudoElementSelector =+            (char ':' *> (PseudoElem <$> ident)) <|> (ident >>= handleSpecialCase)+          where+            handleSpecialCase :: Text -> Parser SimpleSelector+            handleSpecialCase t+                | isSpecialPseudoElement = pure $ PseudoElem t+                | otherwise              = empty+              where isSpecialPseudoElement = T.toLower t `elem` specialPseudoElements++-- \<An+B> microsyntax parser.+anplusb :: Parser AnPlusB+anplusb = (asciiCI "even" $> Even)+      <|> (asciiCI "odd" $> Odd)+      <|> do+        s    <- optional parseSign+        dgts <- A.option mempty digits+        case dgts of+          [] -> ciN *> skipComments *> A.option (A s Nothing) (AB s Nothing <$> bValue)+          _  -> let n = read dgts :: Int+                in (ciN *> skipComments *> A.option (A s $ Just n) (AB s (Just n) <$> bValue))+                    <|> (pure . B $ getSign s * n)+  where ciN       = satisfy (\c -> c == 'N' || c == 'n')+        parseSign = (char '-' $> Minus) <|> (char '+' $> Plus)+        getSign (Just Minus) = -1+        getSign _            = 1+        bValue    = do+            readPlus <- (char '-' $> False) <|> (char '+' $> True)+            d        <- skipComments *> digits+            if readPlus+               then pure $ read d+               else pure $ read ('-':d)++-- Functional pseudo classes parsers map+fpcMap :: Map Text (Parser SimpleSelector)+fpcMap = Map.fromList+    [buildTuple "nth-of-type"      (\x -> FunctionalPseudoClass2 x <$> anplusb)+    ,buildTuple "nth-last-of-type" (\x -> FunctionalPseudoClass2 x <$> anplusb)+    ,buildTuple "nth-column"       (\x -> FunctionalPseudoClass2 x <$> anplusb)+    ,buildTuple "nth-last-column"  (\x -> FunctionalPseudoClass2 x <$> anplusb)+    ,buildTuple "not"              (\x -> FunctionalPseudoClass1 x <$> compoundSelectorList)+    ,buildTuple "matches"          (\x -> FunctionalPseudoClass1 x <$> compoundSelectorList)+    ,buildTuple "nth-child"        (anbAndSelectors . FunctionalPseudoClass3)+    ,buildTuple "nth-last-child"   (anbAndSelectors . FunctionalPseudoClass3)+    ,buildTuple "lang"             (const (Lang <$> identOrString))+    --+    -- :drop( [ active || valid || invalid ]? )+    -- The :drop() functional pseudo-class is identical to :drop+    -- ,("drop", anplusb)+    --+    -- It accepts a comma-separated list of one or more language ranges as its+    -- argument. Each language range in :lang() must be a valid CSS <ident> or+    -- <string>.+    -- ,("lang", anplusb)+    --+    -- ,("dir", text)+    -- ,("has", relative selectors)+    ]+  where buildTuple t c = (t, c t)+        compoundSelectorList = (:) <$> compoundSelector <*> many (comma *> compoundSelector)+        anbAndSelectors constructor = do+            a <- anplusb <* skipComments+            o <- A.option [] (asciiCI "of" *> skipComments *> compoundSelectorList)+            pure $ constructor a o++-- | Parse a list of comma-separated selectors, ignoring whitespace and+-- comments.+selectors :: Parser [Selector]+selectors = lexeme selector `sepBy` char ','++identOrString :: Parser (Either Text StringType)+identOrString = (Left <$> ident) <|> (Right <$> stringtype)

@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.String+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-- Parsers for CSS \<string> values.+--+-----------------------------------------------------------------------------+module Hasmin.Parser.String+    ( convertEscaped+    , stringtype+    ) where++import Control.Applicative ((<|>))+import Data.Attoparsec.Text (Parser)+import Data.Functor (($>))+import qualified Data.Attoparsec.Text as A+import qualified Data.Text as T++import Hasmin.Types.String++-- <string> data type parser+stringtype :: Parser StringType+stringtype = doubleQuotes <|> singleQuotes+  where+    doubleQuotes :: Parser StringType+    doubleQuotes =  A.char '\"' *> (DoubleQuotes <$> untilDoubleQuotes)+      where untilDoubleQuotes = mappend <$> A.takeWhile (\c -> c /= '\\' && c /= '\"') <*> checkCharacter+            checkCharacter = (A.string "\"" $> mempty)+                          <|> (T.cons <$> A.char '\\' <*> untilDoubleQuotes)++    singleQuotes :: Parser StringType+    singleQuotes = A.char '\'' *> (SingleQuotes <$> untilSingleQuotes)+      where untilSingleQuotes = mappend <$> A.takeWhile (\c -> c /= '\\' && c /= '\'') <*> checkCharacter+            checkCharacter = (A.string "\'" $> mempty)+                          <|> (T.cons <$> A.char '\\' <*> untilSingleQuotes)

@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.TimingFunction+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-- Parsers for \<single-timing-function> values.+--+-----------------------------------------------------------------------------+module Hasmin.Parser.TimingFunction+    ( timingFunction+    , cubicbezier+    , steps+    ) where++import Control.Applicative (optional)+import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as A++import Hasmin.Parser.Primitives+import Hasmin.Parser.Numeric+import Hasmin.Parser.Utils+import Hasmin.Types.TimingFunction++-- | Parser for <https://drafts.csswg.org/css-timing-1/#single-timing-function-production \<single-timing-function\>>.+timingFunction :: Parser TimingFunction+timingFunction = parserFromPairs [("ease",         pure Ease)+                                 ,("ease-in",      pure EaseIn)+                                 ,("ease-in-out",  pure EaseInOut)+                                 ,("ease-out",     pure EaseOut)+                                 ,("linear",       pure Linear)+                                 ,("step-end",     pure StepEnd)+                                 ,("step-start",   pure StepStart)+                                 ,("steps",        A.char '(' *> steps)+                                 ,("cubic-bezier", A.char '(' *> cubicbezier)]++-- | Parses what's between parenthesis in the "cubic-bezier()" function.+cubicbezier :: Parser TimingFunction+cubicbezier = functionParser $+    CubicBezier <$> number <* comma <*> number <* comma+                <*> number <* comma <*> number++-- | Parses what's between parenthesis in the "steps()" function.+steps :: Parser TimingFunction+steps = functionParser $ Steps <$> int <*> optional startOrEnd+  where startOrEnd = comma *> parserFromPairs [("end",   pure End)+                                              ,("start", pure Start)]

@@ -0,0 +1,81 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Parser.TransformFunction+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-- Parsers for CSS values.+--+-----------------------------------------------------------------------------+module Hasmin.Parser.TransformFunction+    ( matrix+    , matrix3d+    , rotate3d+    , scale+    , scale3d+    , skew+    , translate+    , translate3d+    ) where++import Control.Applicative (liftA3, optional)+import Data.Attoparsec.Text (count, Parser)++import Hasmin.Parser.Numeric+import Hasmin.Parser.Dimension+import Hasmin.Parser.PercentageLength+import Hasmin.Parser.Utils+import Hasmin.Types.TransformFunction++matrix :: Parser TransformFunction+matrix = functionParser $ do+    n  <-  number+    ns <-  count 5 (comma *> number)+    pure $ mkMat (n:ns)++matrix3d :: Parser TransformFunction+matrix3d = functionParser $ do+    n  <-  number+    ns <-  count 15 (comma *> number)+    pure $ mkMat3d (n:ns)++rotate3d :: Parser TransformFunction+rotate3d = functionParser $ do+    x  <-  number <* comma+    y  <-  number <* comma+    z  <-  number <* comma+    a  <-  angle+    pure $ Rotate3d x y z a++-- | Parser of scale() function. Assumes "scale(" has been already parsed+scale :: Parser TransformFunction+scale = functionParser $ do+    n  <- number+    mn <- optional (comma *> number)+    pure $ Scale n mn++scale3d :: Parser TransformFunction+scale3d = functionParser $ liftA3 Scale3d n n number+  where n = number <* comma++skew :: Parser TransformFunction+skew = functionParser $ do+    a  <- angle+    ma <- optional (comma *> angle)+    pure $ Skew a ma++-- | Assumes "translate(" has been already parsed+translate :: Parser TransformFunction+translate = functionParser $ do+    pl  <- percentageLength+    mpl <- optional (comma *> percentageLength)+    pure $ Translate pl mpl++translate3d :: Parser TransformFunction+translate3d = functionParser $+    Translate3d <$> percentageLength <* comma+                <*> percentageLength <* comma+                <*> distance+

@@ -10,8 +10,6 @@ ----------------------------------------------------------------------------- module Hasmin.Parser.Utils     ( ident-    , fontfamilyname-    , unquotedURL     , skipComments     , lexeme     , functionParser@@ -22,20 +20,25 @@     , opt     , nmchar     , hexadecimal+    , word8+    , parserFromPairs+    , atMost     ) where -import Control.Applicative ((<|>), many)+import Control.Applicative (liftA2, (<|>), many) import Control.Monad (void, mzero)-import Data.Attoparsec.Text (char, many1, digit,-  option, Parser, satisfy, skipSpace, string, takeWhile1, (<?>))-import Data.Monoid ((<>))+import Data.Attoparsec.Text (char,+  option, Parser, satisfy, skipSpace, string) import Data.Text (Text)-import Data.Text.Lazy.Builder as LB+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import Data.Word (Word8) import qualified Data.Attoparsec.Text as A import qualified Data.Char as C-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL+import qualified Data.Map.Strict as Map +import Hasmin.Parser.Primitives+ -- | Skip whatever comments and whitespaces are found. skipComments :: Parser () skipComments = void $ many (skipSpace *> comment) <* skipSpace@@ -63,81 +66,25 @@ opt :: Monoid m => Parser m -> Parser m opt = option mempty --- | Parse a URL without enclosing quotes.--- See <https://drafts.csswg.org/css-syntax-3/#consume-a-url-token §4.3.6. Consume a url token>-unquotedURL :: Parser Text-unquotedURL = do-    t <- many (escape <|> (LB.singleton <$> satisfy validChar))-    pure $ TL.toStrict (toLazyText (mconcat t))-  where validChar x = x /= '\"' && x /= '\'' && x /= '(' && x /= ')'-                   && x /= '\\' && notWhitespace x && notNonprintable x-        notWhitespace x = x /= '\n' &&  x /= '\t' && x /= ' '-        notNonprintable x = not (C.chr 0 <= x && x <= C.chr 8)-                         && x /= '\t'-                         && not ('\SO' <= x && x <= C.chr 31)-                         && x /= '\DEL'--fontfamilyname :: Parser Text-fontfamilyname = do-    i  <- ident-    is <- many (skipComments *> ident)-    if T.toLower i `elem` invalidNames-       then mzero-       else pure $ i <> foldMap (" "<>) is-  where invalidNames = ["serif", "sans-serif", "monospace", "cursive",-                        "fantasy", "inherit", "initial", "unset", "default"]---- ident: -?{nmstart}{nmchar}*-ident :: Parser Text-ident = do-    dash <- option mempty (LB.singleton <$> char '-')-    ns   <- nmstart-    nc   <- mconcat <$> many nmchar-    pure $ TL.toStrict (toLazyText (dash <> ns <> nc))---- nmstart: [_a-z]|{nonascii}|{escape}-nmstart :: Parser Builder-nmstart = LB.singleton <$> satisfy (\c -> C.isAlpha c || (not . C.isAscii) c || c == '_')-       <|> escape-       <?> "not an nmstart token: [_a-z]|{nonascii}|{escape}"---- nmchar: [_a-z0-9-]|{nonascii}|{escape}-nmchar :: Parser Builder-nmchar = LB.singleton <$> satisfy cond <|> escape-  where cond x = C.isAlphaNum x || x == '_' || x == '-'-              || (not . C.isAscii) x---- TODO combine with unicode to make it more efficient--- escape: {unicode}|\\[^\n\r\f0-9a-f]-escape :: Parser Builder-escape =  unicode-      <|> (mappend <$> (LB.singleton <$> char '\\') <*> (LB.singleton <$> satisfy cond))-      <?> "not an escape token: {unicode}|\\\\[^\\n\\r\\f0-9a-f]"-  where cond c = c /= '\n'-              && c /= '\r'-              && c /= '\f'-              && (not . C.isHexDigit) c---- unicode        \\[0-9a-f]{1,6}(\r\n|[ \n\r\t\f])?-unicode :: Parser Builder-unicode = do-    backslash <- char '\\'-    hexChars  <- takeWhile1 C.isHexDigit-    _         <- opt (string "\r\n" <|> (T.singleton <$> satisfy ws))-    if T.length hexChars <= 6-       then pure $ LB.singleton backslash <> LB.fromText hexChars-       else fail "unicode escaped character with length greater than 6"-  where ws x = x == ' ' || x == '\n' || x == '\r' || x == '\t' || x == '\f'- -- | Assumes the identifier and the left parenthesis have been parsed -- Parses p, ignoring surrounding whitespace and comments, and consumes the -- final right parenthesis. functionParser :: Parser a -> Parser a functionParser p = lexeme p <* char ')' --- | Parser one or more digits.-digits :: Parser String-digits = many1 digit- hexadecimal :: Parser Char hexadecimal = satisfy C.isHexDigit++word8 :: Parser Word8+word8 = read <$> digits++parserFromPairs :: [(Text, Parser a)] -> Parser a+parserFromPairs ls = do+    i <- ident+    let t = T.toLower i+    fromMaybe mzero (Map.lookup t m)+  where m = Map.fromList ls++atMost :: Int -> Parser a -> Parser [a]+atMost 0 _ = pure []+atMost n p = A.option [] $ liftA2 (:) p (atMost (n-1) p)

@@ -20,7 +20,6 @@     , percentage     , url     , stringtype-    , textualvalue     , stringvalue    -- used in StringSpec     , shadowList     -- used in ShadowSpec     , timingFunction@@ -29,116 +28,57 @@     , color     , number     , fontStyle+    , textualvalue+    , borderRadius     ) where -import Control.Applicative ((<|>), many, liftA3, optional)-import Control.Arrow (first, (&&&))+import Control.Applicative ((<|>), many, optional)+import Control.Arrow (first) import Control.Monad (mzero) import Data.Functor (($>))-import Data.Attoparsec.Text (asciiCI, char, count, option, Parser, satisfy,-       skipSpace, string)-import Data.Map.Strict (Map) import Data.Monoid ((<>)) import Data.Maybe (fromMaybe, isNothing) import Data.Text (Text)-import Data.Word (Word8) import Data.Char (isAscii) import Text.Parser.Permutation ((<|?>), (<$$>), (<$?>), (<||>), permute)-import Numeric (readSigned, readFloat) import qualified Data.Set as Set+import Data.Attoparsec.Text (asciiCI, char, option, Parser, skipSpace, string) import qualified Data.Attoparsec.Text as A import qualified Data.Char as C+import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import qualified Data.List as L import qualified Data.Text as T +import Hasmin.Parser.BasicShape+import Hasmin.Parser.BorderRadius+import Hasmin.Parser.Color+import Hasmin.Parser.Dimension+import Hasmin.Parser.Gradient+import Hasmin.Parser.Numeric+import Hasmin.Parser.PercentageLength+import Hasmin.Parser.Position+import Hasmin.Parser.String+import Hasmin.Parser.TimingFunction+import Hasmin.Parser.TransformFunction import Hasmin.Parser.Utils import Hasmin.Types.BgSize-import Hasmin.Class-import Hasmin.Types.Color import Hasmin.Types.Dimension import Hasmin.Types.FilterFunction-import Hasmin.Types.Gradient import Hasmin.Types.Numeric-import Hasmin.Types.PercentageLength import Hasmin.Types.Position import Hasmin.Types.RepeatStyle import Hasmin.Types.Shadow import Hasmin.Types.String-import Hasmin.Types.TimingFunction import Hasmin.Types.TransformFunction import Hasmin.Types.Value+import Hasmin.Utils  -- | Given a propery name, it returns a specific parser of values for that -- property. Fails if no specific parser is found. valuesFor :: Text -> Parser Values-valuesFor propName =-  case Map.lookup (T.toLower propName) propertyValueParsersMap of-    Just x  -> x <* skipComments-    Nothing -> mzero---- | Parser for <https://www.w3.org/TR/css-values-3/#numbers \<number\>>.-number :: Parser Number-number = Number <$> rational---- ------------------------------------------------------------------------------ Color Parsers--- ------------------------------------------------------------------------------- Assumes "rgb(" has already been read-rgb :: Parser Color-rgb = functionParser (rgbInt <|> rgbPer)-  where rgbInt = mkRGBInt <$> word8 <* comma <*> word8 <* comma <*> word8-        rgbPer = mkRGBPer <$> percentage <* comma-                          <*> percentage <* comma <*> percentage---- Assumes "rgba(" has already been read-rgba :: Parser Color-rgba = functionParser (rgbaInt <|> rgbaPer)-  where rgbaInt = mkRGBAInt <$> word8 <* comma <*> word8 <* comma-                            <*> word8 <* comma <*> alphavalue-        rgbaPer = mkRGBAPer <$> percentage <* comma <*> percentage <* comma-                            <*> percentage <* comma <*> alphavalue---- Assumes "hsl(" has already been read-hsl :: Parser Color-hsl = functionParser p-  where p = mkHSL <$> int <* comma <*> percentage <* comma <*> percentage---- Assumes "hsla(" has already been read-hsla :: Parser Color-hsla = functionParser p-  where p = mkHSLA <$> int <* comma <*> percentage <* comma-                   <*> percentage <* comma <*> alphavalue--alphavalue :: Parser Alphavalue-alphavalue = mkAlphavalue <$> rational--hexvalue :: Parser Value-hexvalue = ColorV <$> hex--hex :: Parser Color-hex = do-    _ <- char '#'-    a <- hexadecimal-    b <- hexadecimal-    c <- hexadecimal-    x <- optional hexadecimal-    case x of-      Nothing -> pure $ mkHex3 a b c-      Just d  -> do y <- optional hexadecimal-                    case y of-                      Nothing -> pure $ mkHex4 a b c d-                      Just e  -> do f <- hexadecimal-                                    z <- optional hexadecimal-                                    case z of-                                      Nothing -> pure $ mkHex6 [a,b] [c,d] [e,f]-                                      Just g  -> do h <- hexadecimal-                                                    pure $ mkHex8 [a,b] [c,d] [e,f] [g,h]---- ------------------------------------------------------------------------------ Dimensions Parsers--- ---------------------------------------------------------------------------+valuesFor propName = maybe mzero (<* skipComments) parser+  where parser = Map.lookup (T.toLower propName) propertyValueParsersMap  -- A map relating dimension units and the percentage symbol, -- to functions that construct that value. Meant to unify all the numerical@@ -146,19 +86,17 @@ -- See numericalvalue. numericalConstructorsMap :: Map Text (Number -> Value) numericalConstructorsMap   = Map.fromList $ fmap (first T.toCaseFold) l-  where durationFunc u v   = DurationV (Duration v u)-        frequencyFunc u v  = FrequencyV (Frequency v u)+  where frequencyFunc u v  = FrequencyV (Frequency v u)         resolutionFunc u v = ResolutionV (Resolution v u)-        l = [("s",    durationFunc S)-            ,("ms",   durationFunc Ms)-            ,("hz",   frequencyFunc Hz)+        l = [("hz",   frequencyFunc Hz)             ,("khz",  frequencyFunc Khz)             ,("dpi",  resolutionFunc Dpi)             ,("dpcm", resolutionFunc Dpcm)             ,("dppx", resolutionFunc Dppx)             ,("%", \x -> PercentageV (Percentage $ toRational x))-            ] ++ (fmap . fmap) (LengthV .) distanceConstructorsList+            ] ++ (fmap . fmap) (TimeV .) timeConstructorsList               ++ (fmap . fmap) (AngleV .) angleConstructorsList+              ++ (fmap . fmap) (LengthV .) distanceConstructorsList  -- Unified numerical parser. -- Parses <number>, dimensions (i.e. <length>, <angle>, ...), and <percentage>@@ -172,88 +110,8 @@               Just f  -> pure $ f n               Nothing -> mzero -- TODO see if we should return an "Other" value --- Create a numerical parser based on a Map.--- See for instance, the "angle" parser-dimensionParser :: Map Text (Number -> a) -> a -> Parser a-dimensionParser m unitlessValue = do-    n <- number-    u <- opt (A.takeWhile1 C.isAlpha)-    if T.null u-       then if n == 0-               then pure unitlessValue -- <angle> 0, without units-               else mzero -- Non-zero <number>, fail-       else case Map.lookup (T.toCaseFold u) m of-              Just f  -> pure $ f n-              Nothing -> mzero -- parsed units aren't angle units, fail--distance :: Parser Length-distance = dimensionParser distanceConstructorsMap NullLength-  where distanceConstructorsMap = Map.fromList distanceConstructorsList--angle :: Parser Angle-angle = dimensionParser angleConstructorsMap NullAngle-  where angleConstructorsMap = Map.fromList angleConstructorsList--duration :: Parser Duration-duration = do-    n <- number-    u <- opt (A.takeWhile1 C.isAlpha)-    if T.null u-       then mzero-       else case Map.lookup (T.toCaseFold u) durationConstructorsMap of-              Just f  -> pure $ f n-              Nothing -> mzero -- parsed units aren't angle units, fail-  where durationConstructorsMap = Map.fromList $-            fmap (toText &&& flip Duration) [S, Ms]--angleConstructorsList :: [(Text, Number -> Angle)]-angleConstructorsList = fmap (toText &&& flip Angle)-    [Deg, Grad, Rad, Turn]--distanceConstructorsList :: [(Text, Number -> Length)]-distanceConstructorsList = fmap (toText &&& flip Length)-    [EM, EX, CH, VH, VW, VMIN, VMAX, REM, Q, CM, MM, IN, PC, PT, PX]---- | Parser for <https://drafts.csswg.org/css-values-3/#percentages \<percentage\>>.-percentage :: Parser Percentage-percentage = Percentage <$> rational <* char '%'---- ------------------------------------------------------------------------------ Primitives--- ------------------------------------------------------------------------------- | \<integer\> data type parser, but into a String instead of an Int, for other--- parsers to use (e.g.: see the parsers int, or rational)-int' :: Parser String-int' = do-  sign <- char '-' <|> pure '+'-  d    <- digits-  case sign of-    '+' -> pure d-    '-' -> pure (sign:d)-    _   -> error "int': parsed a number starting with other than [+|-]"---- | Parser for \<integer\>: [+|-][0-9]+-int :: Parser Int-int = read <$> int'--word8 :: Parser Word8-word8 = read <$> digits---- Note that many properties that allow an integer or real number as a value--- actually restrict the value to some range, often to a non-negative value.------ | Real number parser. \<number\>: <'int' integer> | [0-9]*.[0-9]+-rational :: Parser Rational-rational = do-    sign <- option [] (wrapMinus <$> (char '-' <|> char '+'))-    dgts <- ((++) <$> digits <*> option "" fractionalPart)-           <|> ("0"++) <$> fractionalPart -- append a zero for read not to fail-    e <- option [] expo-    pure . fst . head $ readSigned readFloat (sign ++ dgts ++ e)-  where fractionalPart = (:) <$> char '.' <*> digits-        expo = (:) <$> satisfy (\c -> c == 'e' || c == 'E') <*> int'-        wrapMinus x = [x | x == '-'] -- we use this since read fails with leading '+'+hexvalue :: Parser Value+hexvalue = ColorV <$> hex  -- | Parser for <https://drafts.csswg.org/css-fonts-3/#propdef-font-style \<font-style\>>, -- used in the @font-style@ and @font@ properties.@@ -289,76 +147,6 @@ positionvalue :: Parser Value positionvalue = PositionV <$> position --- | Parser for <https://drafts.csswg.org/css-values-3/#position \<position\>>.-position :: Parser Position-position = perLen <|> kword-  where-    perLen = percentageLength >>= startsWithPL-    kword = do-        i <- ident-        case Map.lookup (T.toCaseFold i) keywords of-          Just x  -> skipComments *> x-          Nothing -> mzero-    keywords = Map.fromList-        [("left",   startsWith (Just PosLeft)   tb)-        ,("right",  startsWith (Just PosRight)  tb)-        ,("top",    startsWith (Just PosTop)    lr)-        ,("bottom", startsWith (Just PosBottom) lr)-        ,("center", startsWithCenter)]-    tb = (asciiCI "top"  $> Just PosTop,  asciiCI "bottom" $> Just PosBottom)-    lr = (asciiCI "left" $> Just PosLeft, asciiCI "right"  $> Just PosRight)--    startsWithPL :: PercentageLength -> Parser Position-    startsWithPL x = skipComments *>-        (followsWithPL <|> someKeyword <|> wasASinglePL)-      where-        pl = Just x-        followsWithPL = Position Nothing pl Nothing <$> (Just <$> percentageLength)-        wasASinglePL  = pure $ Position Nothing pl Nothing Nothing-        someKeyword   = do-            i <- ident-            case T.toCaseFold i of-              "center" -> pure $ Position Nothing pl (Just PosCenter) Nothing-              "top"    -> pure $ Position Nothing pl (Just PosTop) Nothing-              "bottom" -> pure $ Position Nothing pl (Just PosBottom) Nothing-              _        -> mzero--    maybePL :: Parser (Maybe PercentageLength)-    maybePL = optional percentageLength--    startsWithCenter :: Parser Position-    startsWithCenter =  followsWithPL-                    <|> followsWithAKeyword-                    <|> pure (posTillNow Nothing Nothing)-      where-        followsWithPL = (posTillNow Nothing . Just) <$> percentageLength-        followsWithAKeyword = do-            i <- ident <* skipComments-            let f x = posTillNow (Just x) <$> maybePL-            case T.toCaseFold i of-              "left"   -> f PosLeft-              "right"  -> f PosRight-              "top"    -> f PosTop-              "bottom" -> f PosBottom-              "center" -> pure $ posTillNow (Just PosCenter) Nothing-              _        -> mzero-        posTillNow = Position (Just PosCenter) Nothing--    -- Used for the cases when a position starts with the X axis (left and right-    -- keywords) or Y axis (top and bottom)-    startsWith :: Maybe PosKeyword-               -> (Parser (Maybe PosKeyword), Parser (Maybe PosKeyword))-               -> Parser Position-    startsWith x (p1, p2) = do-        pl <- optional (percentageLength <* skipComments)-        let endsWithCenter = Position x pl <$> center <*> pure Nothing-            endsWithKeywordAndMaybePL = Position x pl <$> posKeyword <*> maybePL-            endsWithPL = pure $ Position x Nothing Nothing pl-        endsWithCenter <|> endsWithKeywordAndMaybePL <|> endsWithPL-      where-        posKeyword = (p1 <|> p2)  <* skipComments-        center = asciiCI "center" $> Just PosCenter- {- transformOrigin :: Parser Values transformOrigin = twoVal <|> oneVal@@ -386,9 +174,9 @@ -}  bgSize :: Parser BgSize-bgSize = twovaluesyntax <|> contain <|> cover-  where cover   = asciiCI "cover" $> Cover-        contain = asciiCI "contain" $> Contain+bgSize = twovaluesyntax <|> containOrCover+  where containOrCover = parserFromPairs [("cover", pure Cover)+                                         ,("contain", pure Contain)]         twovaluesyntax = do             x <- bgsizeValue <* skipComments             (BgSize2 x <$> bgsizeValue) <|> pure (BgSize1 x)@@ -455,7 +243,7 @@ -- used for the background property, which takes among other things: -- <position> [ / <bg-size> ]? positionAndBgSize :: Parser (Position, Maybe BgSize)-positionAndBgSize = (,) <$> position <*> optional (slash *> bgSize)+positionAndBgSize = mzip position (optional (slash *> bgSize))  matchKeywords :: [Text] -> Parser TextV matchKeywords listOfKeywords = do@@ -475,7 +263,7 @@                if Set.member lowercased possibilities                   then fromMaybe mzero (Map.lookup lowercased functionsMap)                   else mzero-  where possibilities = Set.fromList $ map T.toCaseFold+  where possibilities = Set.fromList             ["url", "element", "linear-gradient", "radial-gradient"]  transition :: Parser Values@@ -485,9 +273,9 @@ singleTransition :: Parser Value singleTransition = do     st <- permute (mkSingleTransition <$?> (Nothing, Just <$> singleTransitionProperty <* skipComments)-                                      <|?> (Nothing, Just <$> duration <* skipComments)+                                      <|?> (Nothing, Just <$> time <* skipComments)                                       <|?> (Nothing, Just <$> timingFunction <* skipComments)-                                      <|?> (Nothing, Just <$> duration <* skipComments))+                                      <|?> (Nothing, Just <$> time <* skipComments))     if singleTransitionIsEmpty st        then mzero        else pure st@@ -503,22 +291,6 @@                else pure $ TextV i         excludedKeywords = Set.fromList ["initial", "inherit", "unset", "default", "none"] --- | Parser for <https://drafts.csswg.org/css-timing-1/#single-timing-function-production \<single-timing-function\>>.-timingFunction :: Parser TimingFunction-timingFunction = do-    i <- ident-    fromMaybe mzero $ Map.lookup (T.toLower i) timingFunctionKeywords-  where timingFunctionKeywords = Map.fromList-          [("ease",         pure Ease)-          ,("ease-in",      pure EaseIn)-          ,("ease-in-out",  pure EaseInOut)-          ,("ease-out",     pure EaseOut)-          ,("linear",       pure Linear)-          ,("step-end",     pure StepEnd)-          ,("step-start",   pure StepStart)-          ,("steps",        char '(' *> steps)-          ,("cubic-bezier", char '(' *> cubicbezier)]- backgroundSize :: Parser Values backgroundSize = parseCommaSeparated (BgSizeV <$> bgSize) @@ -537,6 +309,7 @@     ,("background",                 background)     ,("background-repeat",          parseCommaSeparated (RepeatStyleV <$> repeatStyle))     ,("background-size",            backgroundSize)+    ,("border-radius",              singleValue (BorderRadiusV <$> borderRadius))     ,("box-shadow",                 shadowList)     ,("-o-box-shadow",              shadowList)     ,("-moz-box-shadow",            shadowList)@@ -631,11 +404,12 @@                            FontWeight -> pure $ storeProperty' j (mkOther i)                            _          -> pure $ storeProperty  j x (TextV i)               Nothing -> mzero-          where m  = Map.fromList $ zip ["ultra-condensed", "extra-condensed", "condensed", "semi-condensed", "semi-expanded", "expanded", "extra-expanded", "ultra-expanded"] (repeat FontStretch)-                                 ++ zip ["small-caps"] (repeat FontVariant)-                                 ++ zip ["italic", "oblique"] (repeat FontStyle)-                                 ++ zip ["bold", "bolder", "lighter"] (repeat FontWeight)-                                 ++ [("normal", Ambiguous)]+          where m =+                  Map.fromList $ zip ["ultra-condensed", "extra-condensed", "condensed", "semi-condensed", "semi-expanded", "expanded", "extra-expanded", "ultra-expanded"] (repeat FontStretch)+                              ++ zip ["small-caps"] (repeat FontVariant)+                              ++ zip ["italic", "oblique"] (repeat FontStyle)+                              ++ zip ["bold", "bolder", "lighter"] (repeat FontWeight)+                              ++ [("normal", Ambiguous)]         parse4 :: Parser (Maybe TextV, Maybe TextV, Maybe Value, Maybe TextV)         parse4 = do             let initialized = (Nothing, Nothing, Nothing, Nothing, 0)@@ -680,12 +454,12 @@  fontFamilyValues :: Parser Values fontFamilyValues = singleValue csswideKeyword <|> do-    v <- fontfamily-    vs <- many ((,) <$> separator <*> fontfamily)+    v  <- fontfamily+    vs <- many (mzip separator fontfamily)     pure $ Values v vs  fontfamily :: Parser Value-fontfamily = (StringV <$> stringtype) <|> (mkOther <$> unquotedFontFamily)+fontfamily = stringvalue <|> (mkOther <$> unquotedFontFamily)  local :: Parser Value local = functionParser $@@ -697,22 +471,11 @@     vs <- many (skipComments *> ident)     pure $ v <> foldMap (T.singleton ' ' <>) vs --textualvalue :: Parser Value-textualvalue = do-    i <- ident-    if i == "\\9" -- iehack-       then mzero-       else do c <- A.peekChar-               case c of-                 Just '(' -> functionParsers i-                 Just ':' -> mzero -- invalid-                 _        -> textualParsers i- textualParsers :: Text -> Parser Value textualParsers i = let t = T.toCaseFold i                    in fromMaybe (pure $ mkOther i) (Map.lookup t textualParsersMap)-  where textualParsersMap = Map.union csswideKeywordsMap namedColorsParsersMap+  where textualParsersMap = Map.union csswideKeywordsMap namedColorsValueParsersMap+        namedColorsValueParsersMap = (fmap . fmap) ColorV namedColorsParsersMap  csswideKeyword :: Parser Value csswideKeyword = do@@ -728,18 +491,18 @@                                   else mzero  csswideKeywordsMap :: Map Text (Parser Value)-csswideKeywordsMap  = Map.fromList $ map (first T.toCaseFold)-                                 [("initial", pure Initial)-                                 ,("inherit", pure Inherit)-                                 ,("unset",   pure Unset)]+csswideKeywordsMap  = Map.fromList+    [("initial", pure Initial)+    ,("inherit", pure Inherit)+    ,("unset",   pure Unset)]  stringvalue :: Parser Value stringvalue = StringV <$> stringtype  functionParsers :: Text -> Parser Value functionParsers i = char '(' *>-    case Map.lookup (T.toCaseFold i) functionsMap of-      Just x -> x <|> genericFunc i+    case Map.lookup (T.toLower i) functionsMap of+      Just x  -> x <|> genericFunc i       Nothing -> genericFunc i                  <|> (mkOther <$> (f i "(" <$> someText <*> string ")"))   where f x y z w = x <> y <> z <> w@@ -749,11 +512,11 @@ genericFunc i = (GenericFunc i <$> valuesInParens) <* char ')'  valuesInParens :: Parser Values-valuesInParens = Values <$> v <*> many ((,) <$> separator <*> v) <* skipComments+valuesInParens = Values <$> v <*> many (mzip separator v) <* skipComments  where v =  textualvalue          <|> numericalvalue          <|> hexvalue-         <|> (StringV <$> stringtype)+         <|> stringvalue  stringOrUrl :: Parser (Either StringType Url) stringOrUrl = (Left <$> stringtype) <|> (Right <$> someUrl)@@ -782,103 +545,95 @@                                     ,("round",     RsRound)]  functionsMap :: Map Text (Parser Value)-functionsMap = Map.fromList $ fmap (first T.toCaseFold)-          [("rgb",                     ColorV <$> rgb)-          ,("rgba",                    ColorV <$> rgba)-          ,("hsl",                     ColorV <$> hsl)-          ,("hsla",                    ColorV <$> hsla)-          ,("url",                     UrlV <$> url)-          ,("format",                  format)-          ,("local",                   local)-          -- <gradient> parsers-          ,("linear-gradient",         GradientV "linear-gradient" <$> lineargradient)-          ,("-o-linear-gradient",      GradientV "-o-linear-gradient" <$> lineargradient)-          ,("-ms-linear-gradient",     GradientV "-ms-linear-gradient" <$> lineargradient)-          ,("-moz-linear-gradient",    GradientV "-moz-linear-gradient" <$> lineargradient)-          ,("-webkit-linear-gradient", GradientV "-webkit-linear-gradient" <$> lineargradient)-          ,("radial-gradient",         GradientV "radial-gradient" <$> radialgradient)-          ,("-o-radial-gradient",      GradientV "-o-radial-gradient" <$> radialgradient)-          ,("-moz-radial-gradient",    GradientV "-moz-radial-gradient" <$> radialgradient)-          ,("-webkit-radial-gradient", GradientV "-webkit-radial-gradient" <$> radialgradient)-          --,("repeating-linear-gradient", ? ) -- TODO-          --,("repeating-radial-gradient", ? ) -- TODO-          -- <shape>-          ,("rect",                    rect)-          -- <transform-function>-          ,("matrix",                  TransformV <$> matrix)-          ,("matrix3d",                TransformV <$> matrix3d)-          ,("rotate",                  (TransformV . Rotate) <$> functionParser angle)-          ,("rotate3d",                TransformV <$> rotate3d)-          ,("rotateX",                 (TransformV . Rotate) <$> functionParser angle)-          ,("rotateY",                 (TransformV . Rotate) <$> functionParser angle)-          ,("rotateZ",                 (TransformV . Rotate) <$> functionParser angle)-          ,("scale",                   TransformV <$> scale)-          ,("scale3d",                 TransformV <$> scale3d)-          ,("scaleX",                  (TransformV . ScaleY) <$> functionParser number)-          ,("scaleY",                  (TransformV . ScaleY) <$> functionParser number)-          ,("scaleZ",                  (TransformV . ScaleZ) <$> functionParser number)-          ,("skew",                    TransformV <$> skew)-          ,("skewX",                   (TransformV . SkewX) <$> functionParser angle)-          ,("skewY",                   (TransformV . SkewY) <$> functionParser angle)-          ,("translate",               TransformV <$> translate)-          ,("translate3d",             TransformV <$> translate3d)-          ,("translateX",              (TransformV . TranslateX) <$> functionParser percentageLength)-          ,("translateY",              (TransformV . TranslateY) <$> functionParser percentageLength)-          ,("translateZ",              (TransformV . TranslateZ) <$> functionParser distance)-          ,("perspective",             (TransformV . Perspective) <$> functionParser distance)-          -- <timing-function>-          ,("cubic-bezier",            TimingFuncV <$> cubicbezier)-          ,("steps",                   TimingFuncV <$> steps)-          -- <filter-function>-          ,("blur",                    (FilterV . Blur) <$> functionParser distance)-          ,("contrast",                (FilterV . Contrast) <$> functionParser numberPercentage)-          ,("grayscale",               (FilterV . Grayscale) <$> functionParser numberPercentage)-          ,("invert",                  (FilterV . Invert) <$> functionParser numberPercentage)-          ,("opacity",                 (FilterV . Opacity) <$> functionParser numberPercentage)-          ,("saturate",                (FilterV . Saturate) <$> functionParser numberPercentage)-          ,("sepia",                   (FilterV . Sepia) <$> functionParser numberPercentage)-          ,("brightness",              (FilterV . Brightness) <$> functionParser numberPercentage)-          ,("drop-shadow",             FilterV <$> dropShadow)-          ,("hue-rotate",              (FilterV . HueRotate) <$> functionParser angle)-          ,("element", genericFunc "element")-          ---          -- <basic-shape>-          -- circle() = circle( [<shape-radius>]? [at <position>]? )-          -- polygon( [<fill-rule>,]? [<shape-arg> <shape-arg>]# )-          -- inset()-          -- ellipse( [<shape-radius>{2}]? [at <position>]? )-          ---          -- <image> https://drafts.csswg.org/css-images-          -- Note: <gradient> is a type of <image> !-          -- cross-fade()-          -- image()-          -- image-set()-          -- image-set()-          -- element()-          ---          ---          --,("stylistic", functionParser ident) -- IDENT-          --,("styleset", ? ) -- ident#-          --,("swash", ? ) -- ident-          --,("annotation", ? ) -- ident-          --,("attr", ? ) --  <attr-name> <type-or-unit>? [, <attr-fallback> ]?-          --,("calc", ? )  -- <calc-sum> , experimental-          --,("character-variant", ? ) -- ident#-          --,("element", ? )  -- id selector, experimental-          --,("local", ? )-          --,("ornaments", ? ) -- ident-          --,("symbols", ? )  --  <symbols-type>? [ <string> | <image> ]+-          --,("var", ? )  -- experimental: <custom-property-name> [, <declaration-value> ]?--- minmax()-          ]+functionsMap = Map.fromList (colorFunctionValueParsers ++ l)+  where colorFunctionValueParsers = (fmap . fmap . fmap) ColorV colorFunctionsParsers+        l = [("url",                     UrlV <$> url)+            ,("format",                  format)+            ,("local",                   local)+            -- <gradient> parsers+            ,("linear-gradient",         GradientV "linear-gradient" <$> lineargradient)+            ,("-o-linear-gradient",      GradientV "-o-linear-gradient" <$> lineargradient)+            ,("-ms-linear-gradient",     GradientV "-ms-linear-gradient" <$> lineargradient)+            ,("-moz-linear-gradient",    GradientV "-moz-linear-gradient" <$> lineargradient)+            ,("-webkit-linear-gradient", GradientV "-webkit-linear-gradient" <$> lineargradient)+            ,("radial-gradient",         GradientV "radial-gradient" <$> radialgradient)+            ,("-o-radial-gradient",      GradientV "-o-radial-gradient" <$> radialgradient)+            ,("-moz-radial-gradient",    GradientV "-moz-radial-gradient" <$> radialgradient)+            ,("-webkit-radial-gradient", GradientV "-webkit-radial-gradient" <$> radialgradient)+            --,("repeating-linear-gradient", ? ) -- TODO+            --,("repeating-radial-gradient", ? ) -- TODO+            -- <shape>+            ,("rect",                    rect)+            -- <transform-function>+            ,("matrix",                  TransformV <$> matrix)+            ,("matrix3d",                TransformV <$> matrix3d)+            ,("rotate",                  (TransformV . Rotate) <$> functionParser angle)+            ,("rotate3d",                TransformV <$> rotate3d)+            ,("rotatex",                 (TransformV . Rotate) <$> functionParser angle)+            ,("rotatey",                 (TransformV . Rotate) <$> functionParser angle)+            ,("rotatez",                 (TransformV . Rotate) <$> functionParser angle)+            ,("scale",                   TransformV <$> scale)+            ,("scale3d",                 TransformV <$> scale3d)+            ,("scalex",                  (TransformV . ScaleY) <$> functionParser number)+            ,("scaley",                  (TransformV . ScaleY) <$> functionParser number)+            ,("scalez",                  (TransformV . ScaleZ) <$> functionParser number)+            ,("skew",                    TransformV <$> skew)+            ,("skewx",                   (TransformV . SkewX) <$> functionParser angle)+            ,("skewy",                   (TransformV . SkewY) <$> functionParser angle)+            ,("translate",               TransformV <$> translate)+            ,("translate3d",             TransformV <$> translate3d)+            ,("translatex",              (TransformV . TranslateX) <$> functionParser percentageLength)+            ,("translatey",              (TransformV . TranslateY) <$> functionParser percentageLength)+            ,("translatez",              (TransformV . TranslateZ) <$> functionParser distance)+            ,("perspective",             (TransformV . Perspective) <$> functionParser distance)+            -- <timing-function>+            ,("cubic-bezier",            TimingFuncV <$> cubicbezier)+            ,("steps",                   TimingFuncV <$> steps)+            -- <filter-function>+            ,("blur",                    (FilterV . Blur) <$> functionParser distance)+            ,("contrast",                (FilterV . Contrast) <$> functionParser numberPercentage)+            ,("grayscale",               (FilterV . Grayscale) <$> functionParser numberPercentage)+            ,("invert",                  (FilterV . Invert) <$> functionParser numberPercentage)+            ,("opacity",                 (FilterV . Opacity) <$> functionParser numberPercentage)+            ,("saturate",                (FilterV . Saturate) <$> functionParser numberPercentage)+            ,("sepia",                   (FilterV . Sepia) <$> functionParser numberPercentage)+            ,("brightness",              (FilterV . Brightness) <$> functionParser numberPercentage)+            ,("drop-shadow",             FilterV <$> dropShadow)+            ,("hue-rotate",              (FilterV . HueRotate) <$> functionParser angle)+            ,("element",                 genericFunc "element")+            -- <basic-shape>+            ,("circle",                  BasicShapeV <$> functionParser circle)+            ,("ellipse",                 BasicShapeV <$> functionParser ellipse)+            ,("inset",                   BasicShapeV <$> functionParser inset)+            ,("polygon",                 BasicShapeV <$> functionParser polygon)+            --+            -- <image> https://drafts.csswg.org/css-images+            -- Note: <gradient> is a type of <image> !+            -- cross-fade()+            -- image()+            -- image-set()+            -- image-set()+            -- element()+            --+            --+            --,("stylistic", functionParser ident) -- IDENT+            --,("styleset", ? ) -- ident#+            --,("swash", ? ) -- ident+            --,("annotation", ? ) -- ident+            --,("attr", ? ) --  <attr-name> <type-or-unit>? [, <attr-fallback> ]?+            --,("calc", ? )  -- <calc-sum> , experimental+            --,("character-variant", ? ) -- ident#+            --,("element", ? )  -- id selector, experimental+            --,("ornaments", ? ) -- ident+            --,("symbols", ? )  --  <symbols-type>? [ <string> | <image> ]++            --,("var", ? )  -- experimental: <custom-property-name> [, <declaration-value> ]?+  -- minmax()+            ]  dropShadow :: Parser FilterFunction-dropShadow = functionParser $ do-    l1 <- distance-    l2 <- lexeme distance-    l3 <- optional (distance <* skipComments)-    c  <- optional color-    pure $ DropShadow l1 l2 l3 c+dropShadow = functionParser $+    DropShadow <$> len <*> len <*> optional len <*> optional color+  where len = distance <* skipComments  textShadow :: Parser Values textShadow = parseCommaSeparated shadowText@@ -904,7 +659,7 @@ parseCommaSeparated :: Parser Value -> Parser Values parseCommaSeparated p = do     v  <- p-    vs <- lexeme $ many ((,) <$> commaSeparator <*> p)+    vs <- lexeme $ many (mzip commaSeparator p)     c  <- A.peekChar     case c of       Just x  -> if x `elem` ['!', ';', '}']@@ -925,93 +680,6 @@             l4 <- optional (distance <* skipComments)             pure (l1,l2,l3,l4) -radialgradient :: Parser Gradient-radialgradient = functionParser $ do-    (def, c) <- option (True, RadialGradient Nothing Nothing) ((False,) <$> endingShapeAndSize <* skipComments)-    p  <- optional (asciiCI "at" *> skipComments *> position)-    _  <- if def && isNothing p-             then pure '*' -- do nothing-             else comma-    cs <- colorStopList-    pure $ c p cs-  where circle = asciiCI "circle" $> Just Circle <* skipComments-        ellipse = asciiCI "ellipse" $> Just Ellipse <* skipComments-        endingShapeAndSize = r1 <|> r2 <|> r3-          where r1 = permute (RadialGradient <$?> (Nothing, ellipse) <||> (Just <$> (PL <$> percentageLength <*> lexeme percentageLength)))-                r2 = permute (RadialGradient <$?> (Nothing, circle) <||> ((Just . SL) <$> distance <* skipComments))-                r3 = permute (RadialGradient <$?> (Nothing, circle <|> ellipse) <||> extentKeyword)-                   <|> permute (RadialGradient <$$> (circle <|> ellipse) <|?> (Nothing, extentKeyword))-                extentKeyword = do-                    i <- ident-                    _ <- skipComments-                    case Map.lookup i extentKeywords of-                      Just x -> pure (Just x)-                      Nothing -> mzero-                extentKeywords :: Map Text Size-                extentKeywords = Map.fromList [("closest-corner",  ClosestCorner)-                                              ,("closest-side",    ClosestSide)-                                              ,("farthest-corner", FarthestCorner)-                                              ,("farthest-side",   FarthestSide)]---- | Assumes "linear-gradient(", or one of its prefixed equivalents, has been parsed.--- : [<angle>|to <side-or-corner> ,]? <color-stop> [, <color-stop>]+-lineargradient :: Parser Gradient-lineargradient = functionParser (lg <|> oldLg)-  where lg = LinearGradient <$> optional angleOrSide <*> colorStopList-        oldLg = OldLinearGradient <$> optional ((ga <|> sc) <* comma)-                                  <*> colorStopList-        angleOrSide = (ga <|> gs) <* comma-        ga = Left <$> angle-        gs = asciiCI "to" *> skipComments *> sc-        sc = Right <$> sideOrCorner---- <side-or-corner> = [left | right] || [top | bottom]-sideOrCorner :: Parser (Side, Maybe Side)-sideOrCorner = orderOne <|> orderTwo-  where orderOne = (,) <$> leftright <* skipComments-                       <*> optional topbottom-        orderTwo = (,) <$> topbottom <* skipComments-                       <*> optional leftright--leftright :: Parser Side-leftright =  (asciiCI "left" $> LeftSide)-         <|> (asciiCI "right" $> RightSide)--topbottom :: Parser Side-topbottom =  (asciiCI "top" $> TopSide)-         <|> (asciiCI "bottom" $> BottomSide)--colorStopList :: Parser [ColorStop]-colorStopList = do-    c1 <- colorStop-    _  <- char ',' <* skipComments-    c2 <- colorStop-    cs <- many (char ',' *> skipComments *> colorStop)-    pure $ c1:c2:cs--colorStop :: Parser ColorStop-colorStop = ColorStop <$> color <* skipComments-        <*> optional (percentageLength <* skipComments)---- | Parser for <https://drafts.csswg.org/css-color-3/#colorunits \<color\>>.-color :: Parser Color-color = hex <|> othercolor-  where othercolor = do-            t <- textualvalue-            case t of-              ColorV c -> pure c-              _        -> mzero---- TODO make parser specifically for it instead of reusing numericalvalue-percentageLength :: Parser PercentageLength-percentageLength = do-    n <- numericalvalue-    case n of-      PercentageV p -> pure $ Left p-      NumberV 0     -> pure $ Right NullLength-      LengthV d     -> pure $ Right d-      _             -> mzero- numberPercentage :: Parser (Either Number Percentage) numberPercentage = do     n <- numericalvalue@@ -1022,78 +690,8 @@  -- | Assumes "rect(" has been already parsed rect :: Parser Value-rect = functionParser $ do-    length1 <- distance <* comma-    length2 <- distance <* comma-    length3 <- distance <* comma-    length4 <- distance-    pure $ Rect length1 length2 length3 length4---- | Assumes "translate(" has been already parsed-translate :: Parser TransformFunction-translate = functionParser $ do-    pl  <- percentageLength-    mpl <- optional (comma *> percentageLength)-    pure $ Translate pl mpl---- | Parser of scale() function. Assumes "scale(" has been already parsed-scale :: Parser TransformFunction-scale = functionParser $ do-    n  <- number-    mn <- optional (comma *> number)-    pure $ Scale n mn--scale3d :: Parser TransformFunction-scale3d = functionParser $ liftA3 Scale3d n n number-  where n = number <* comma--skew :: Parser TransformFunction-skew = functionParser $ do-    a  <- angle-    ma <- optional (comma *> angle)-    pure $ Skew a ma--translate3d :: Parser TransformFunction-translate3d = functionParser $-    Translate3d <$> percentageLength <* comma-                <*> percentageLength <* comma-                <*> distance--matrix :: Parser TransformFunction-matrix = functionParser $ do-    n  <-  number-    ns <-  count 5 (comma *> number)-    pure $ mkMat (n:ns)--matrix3d :: Parser TransformFunction-matrix3d = functionParser $ do-    n  <-  number-    ns <-  count 15 (comma *> number)-    pure $ mkMat3d (n:ns)--rotate3d :: Parser TransformFunction-rotate3d = functionParser $ do-    x  <-  number <* comma-    y  <-  number <* comma-    z  <-  number <* comma-    a  <-  angle-    pure $ Rotate3d x y z a--cubicbezier :: Parser TimingFunction-cubicbezier = functionParser $ do-    p0 <- number <* comma-    p1 <- number <* comma-    p2 <- number <* comma-    p3 <- number-    pure $ CubicBezier p0 p1 p2 p3--steps :: Parser TimingFunction-steps = functionParser $ do-    i <- int-    s <- optional (comma *> startOrEnd)-    pure $ Steps i s-  where startOrEnd = (asciiCI "end" $> End)-                 <|> (asciiCI "start" $> Start)+rect = functionParser (Rect <$> dc <*> dc <*> dc <*> distance)+  where dc = distance <* comma  -- It uses skipSpace instead of skipComments, since comments aren't valid inside -- the url-token. From the spec:@@ -1113,20 +711,15 @@ format = Format <$> functionParser p   where p = (:) <$> stringtype <*> many (comma *> stringtype) -namedColorsParsersMap :: Map Text (Parser Value)-namedColorsParsersMap = Map.fromList $ foldr f [] keywordColors-  where f x xs = let a = fst x-                 in (a, pure $ ColorV (Named a)) : xs- -- | For cases when CSS hacks are used, e.g.: @margin-top: 1px \\9;@. valuesFallback :: Parser Values-valuesFallback = Values <$> value <*> many ((,) <$> separator <*> value) <* skipComments+valuesFallback = Values <$> value <*> many (mzip separator value) <* skipComments  value :: Parser Value value =  textualvalue      <|> numericalvalue      <|> hexvalue-     <|> (StringV <$> stringtype)+     <|> stringvalue      <|> invalidvalue  separator :: Parser Separator@@ -1137,22 +730,6 @@ commaSeparator :: Parser Separator commaSeparator = lexeme (char ',' $> Comma) --- <string> data type parser-stringtype :: Parser StringType-stringtype = doubleQuotesString <|> singleQuotesString--doubleQuotesString :: Parser StringType-doubleQuotesString =  char '\"' *> (DoubleQuotes <$> untilDoubleQuotes)-  where untilDoubleQuotes = mappend <$> A.takeWhile (\c -> c /= '\\' && c /= '\"') <*> checkCharacter-        checkCharacter = (string "\"" $> mempty)-                      <|> (T.cons <$> char '\\' <*> untilDoubleQuotes)--singleQuotesString :: Parser StringType-singleQuotesString = char '\'' *> (SingleQuotes <$> untilSingleQuotes)-  where untilSingleQuotes = mappend <$> A.takeWhile (\c -> c /= '\\' && c /= '\'') <*> checkCharacter-        checkCharacter = (string "\'" $> mempty)-                      <|> (T.cons <$> char '\\' <*> untilSingleQuotes)- -- <single-animation># animation :: Parser Values animation = parseCommaSeparated singleAnimation@@ -1162,8 +739,8 @@ singleAnimation = do     sa <- permute (mkSingleAnimation <$?> (Nothing, Just <$> keyframesName <* skipComments)                                      <|?> (Nothing, Just <$> iterationCount <* skipComments)-                                     <|?> (Nothing, Just <$> duration <* skipComments)-                                     <|?> (Nothing, Just <$> duration <* skipComments)+                                     <|?> (Nothing, Just <$> time <* skipComments)+                                     <|?> (Nothing, Just <$> time <* skipComments)                                      <|?> (Nothing, Just <$> timingFunction <* skipComments)                                      <|?> (Nothing, Just <$> animationDirection <* skipComments)                                      <|?> (Nothing, Just <$> animationFillMode <* skipComments)@@ -1190,3 +767,14 @@   where s = Set.fromList ls  -- <single-animation-fill-mode> = none | forwards | backwards | both++textualvalue :: Parser Value+textualvalue = do+    i <- ident+    if i == "\\9" -- iehack+       then mzero+       else do c <- A.peekChar+               case c of+                 Just '(' -> functionParsers i+                 Just ':' -> mzero -- invalid+                 _        -> textualParsers i

@@ -130,6 +130,7 @@     ,("break-before",                       "auto",                     NonInherited, mempty, mempty)     ,("break-inside",                       "auto",                     NonInherited, mempty, mempty)     ,("caption-side",                       "top",                      Inherited, mempty, mempty)+    ,("caret-color",                        "auto",                     Inherited, mempty, mempty)     ,("clear",                              "none",                     NonInherited, mempty, mempty)     ,("clip",                               "auto",                     NonInherited, mempty, mempty) -- deprecated!     ,("color",                              mempty {-UA dependent-},    Inherited, mempty, mempty)@@ -161,21 +162,26 @@     ,("flex-shrink",                        "1",                        NonInherited, ["flex"], mempty)     ,("flex-wrap",                          "nowrap", NonInherited, ["flex-flow"], mempty)     ,("float",                              "none", NonInherited, mempty, mempty)-    ,("font",                               mempty {-shorthand-}, Inherited, mempty, ["font-style", "font-variant", "font-weight", "font-stretch", "font-size", "line-height", "font-family"])++    -- It seems it's neither inherited nor not inherited. It's not even a+    -- property, but an @font-face "descriptor".+    ,("font-display",                       "auto", NonInherited, mempty, mempty)+     ,("font-family",                        mempty {-UA dependent-}, Inherited, ["font"], mempty)     ,("font-feature-settings",              "normal", Inherited, mempty, mempty)     ,("font-kerning",                       "auto", Inherited, ["font"], mempty)     ,("font-language-override",             "normal", Inherited, ["font"], mempty)-    ,("font-size",                          "medium", Inherited, ["font"], mempty)+    ,("font",                               mempty {-shorthand-}, Inherited, mempty, ["font-style", "font-variant", "font-weight", "font-stretch", "font-size", "line-height", "font-family"])     ,("font-size-adjust",                   "none", Inherited, ["font"], mempty)+    ,("font-size",                          "medium", Inherited, ["font"], mempty)     ,("font-stretch",                       "normal", Inherited, ["font"], mempty)     ,("font-style",                         "normal", Inherited, ["font"], mempty)     ,("font-synthesis",                     "weight style", Inherited, mempty, mempty)-    ,("font-variant",                       "normal", Inherited, ["font"], mempty)     ,("font-variant-alternates",            "normal", Inherited, mempty, mempty)     ,("font-variant-caps",                  "normal", Inherited, mempty, mempty)     ,("font-variant-east-asian",            "normal", Inherited, mempty, mempty)     ,("font-variant-ligatures",             "normal", Inherited, mempty, mempty)+    ,("font-variant",                       "normal", Inherited, ["font"], mempty)     ,("font-variant-numeric",               "normal", Inherited, mempty, mempty)     ,("font-variant-position",              "normal", Inherited, mempty, mempty)     ,("font-weight",                        "normal", Inherited, ["font"], mempty)

@@ -0,0 +1,198 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances, FlexibleContexts,+             StandaloneDeriving, DeriveFunctor, DeriveFoldable,+             DeriveTraversable #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Types.BasicShape+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-----------------------------------------------------------------------------+module Hasmin.Types.BasicShape+    ( BasicShape(..)+    , ShapeRadius(..)+    , AtMost2(..)+    , FillRule(..)+    ) where++import Control.Monad.Reader (Reader)+import Data.Monoid ((<>), mempty)+import Data.Bitraversable (bitraverse)+import Data.Maybe (isJust)+import Data.List.NonEmpty (NonEmpty((:|)))+import qualified Data.List.NonEmpty as NE+import Data.Text.Lazy.Builder (Builder)++import Hasmin.Types.Position+import Hasmin.Types.BorderRadius+import Hasmin.Types.Dimension+import Hasmin.Types.PercentageLength+import Hasmin.Types.Numeric+import Hasmin.Config+import Hasmin.Class+import Hasmin.Utils++type ShapeArg = PercentageLength++-- | CSS <https://drafts.csswg.org/css-shapes/#basic-shape-functions \<basic-shape\>> data type.+data BasicShape+       -- inset( <shape-arg>{1,4} [round <border-radius>]? )+        = Inset (NonEmpty ShapeArg) (Maybe BorderRadius)+       -- circle( [<shape-radius>]? [at <position>]? )+        | Circle (Maybe ShapeRadius) (Maybe Position)+       -- ellipse( [<shape-radius>{2}]? [at <position>]? )+        | Ellipse (AtMost2 ShapeRadius) (Maybe Position)+       -- polygon( [<fill-rule>,]? [<shape-arg> <shape-arg>]# )+        | Polygon (Maybe FillRule) (NonEmpty (ShapeArg, ShapeArg))+  deriving Show++instance Eq BasicShape where+    Inset sas1 mbr1 == Inset sas2 mbr2     = eqUsing sasEq sas1 sas2 && mbrEq mbr1 mbr2+    Circle msr1 mp1 == Circle msr2 mp2     = msrEq msr1 msr2 && mpEq mp1 mp2+    Ellipse sr2 mp1 == Ellipse sr2' mp2    = sr2Eq sr2 sr2' && mpEq mp1 mp2+    Polygon mfr1 sas1 == Polygon mfr2 sas2 = mfrEq mfr1 mfr2 && eqUsing pairEq sas1 sas2+    _ == _                                 = False++eqUsing :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a -> Bool+eqUsing f (x:|xs) (y:|ys) = f x y && go xs ys+  where go [] []    = True+        go (_:_) [] = False+        go [] (_:_) = False+        go (c:cs) (d:ds) = f c d && go cs ds++pairEq :: (Num a, Eq a) => (Either a Length, Either a Length)+                        -> (Either a Length, Either a Length) -> Bool+pairEq (a1, a2) (b1, b2) = a1 `sasEq` b1 && a2 `sasEq` b2++sasEq :: (Num a, Eq a) => Either a Length -> Either a Length -> Bool+sasEq a b = isZero a && isZero b || a == b++mfrEq :: Maybe FillRule -> Maybe FillRule -> Bool+mfrEq Nothing (Just NonZero) = True+mfrEq (Just NonZero) Nothing = True+mfrEq x y                    = x == y++sr2Eq :: AtMost2 ShapeRadius -> AtMost2 ShapeRadius -> Bool+sr2Eq None x =+    case x of+      One SRClosestSide               -> True+      Two SRClosestSide SRClosestSide -> True+      None                            -> True+      _                               -> False+sr2Eq (One SRClosestSide) None               = True+sr2Eq (One x) (Two y SRClosestSide)          = x == y+sr2Eq (One x) (One y)                        = x == y+sr2Eq One{} _                                = False+sr2Eq (Two x SRClosestSide) (One y)          = x == y+sr2Eq (Two SRClosestSide SRClosestSide) None = True+sr2Eq (Two a b) (Two c d)                    = a == c && b == d+sr2Eq Two{} _                                = False++msrEq :: Maybe ShapeRadius -> Maybe ShapeRadius -> Bool+msrEq Nothing (Just SRClosestSide) = True+msrEq (Just SRClosestSide) Nothing = True+msrEq x y                          = x == y++mbrEq :: Maybe BorderRadius -> Maybe BorderRadius -> Bool+mbrEq Nothing y = maybe True isZeroBR y+mbrEq x Nothing = mbrEq Nothing x+mbrEq x y       = x == y++mpEq :: Maybe Position -> Maybe Position -> Bool+mpEq Nothing (Just x) = x == centerpos+mpEq (Just x) Nothing = x == centerpos+mpEq x y              = x == y++data ShapeRadius = SRLength Length+                 | SRPercentage Percentage+                 | SRClosestSide+                 | SRFarthestSide+  deriving (Show, Eq)++instance ToText ShapeRadius where+  toBuilder (SRLength l)     = toBuilder l+  toBuilder (SRPercentage p) = toBuilder p+  toBuilder SRClosestSide    = "closest-side"+  toBuilder SRFarthestSide   = "farthest-side"++minifySR :: ShapeRadius -> Reader Config ShapeRadius+minifySR (SRLength l) = SRLength <$> minify l+minifySR sr           = pure sr++data FillRule = NonZero | EvenOdd+  deriving (Show, Eq)++data AtMost2 a = None | One a | Two a a+  deriving (Functor, Foldable, Traversable)++deriving instance Show a => Show (AtMost2 a)+deriving instance Eq a => Eq (AtMost2 a)++instance ToText FillRule where+  toBuilder NonZero = "nonzero"+  toBuilder EvenOdd = "evenodd"++instance Minifiable BasicShape where+  minify (Inset xs Nothing) = pure $ Inset (reduceTRBL xs) Nothing+  minify (Inset xs (Just br)) = Inset (reduceTRBL xs) <$> br'+    where br' = do+              x <- minify br+              pure $ if isZeroBR x+                        then Nothing+                        else Just x+  minify (Circle msr mp) = do+      mp' <- traverse minify mp+      let newPos = if mp' == Just centerpos then Nothing else mp'+      Circle <$> minifyMSR msr <*> pure newPos+    where minifyMSR :: Maybe ShapeRadius -> Reader Config (Maybe ShapeRadius)+          minifyMSR Nothing   = pure Nothing+          minifyMSR (Just sr) =+              case sr of+                SRLength l    -> (Just . SRLength) <$> minify l+                SRClosestSide -> pure Nothing+                _             -> pure (Just sr)+  minify (Ellipse sr2 mp) = do+      sr' <- minifySR2 sr2+      mp' <- traverse minify mp+      let newPos = if mp' == Just centerpos+                      then Nothing+                      else mp'+      pure $ Ellipse sr' newPos+    where minifySR2 (One x) =+              case x of+                SRClosestSide -> pure None+                SRLength l    -> (One . SRLength) <$> minify l+                _             -> pure (One x)+          minifySR2 (Two x SRClosestSide) = minifySR2 (One x)+          minifySR2 t@Two{}               = traverse minifySR t+          minifySR2 None                  = pure None+  minify (Polygon mfr mp) =+      case mfr of+        Just NonZero -> Polygon Nothing <$> mp'+        _            -> Polygon mfr <$> mp'+    where mp' = traverse (bitraverse minifyPL minifyPL) mp++instance ToText BasicShape where+  toBuilder (Inset xs mys) = surround "inset" $ mconcatIntersperse toBuilder " " (NE.toList xs) <> mys'+    where mys' = maybe mempty (\x -> " round " <> toBuilder x) mys+  toBuilder (Circle msr mp) = surround "circle" $ msr' <> ms <> mp'+    where msr' = maybe mempty toBuilder msr+          mp'  = maybe mempty (\x -> "at " <> toBuilder x) mp+          ms   = if isJust msr && isJust mp then " " else mempty+  toBuilder (Ellipse m2sr mp) = surround "ellipse" $ bsr2 <> ms <> mp'+    where ms   = if bsr2 == mempty || mp' == mempty then mempty else " "+          mp'  = maybe mempty (\x -> "at " <> toBuilder x) mp+          bsr2 =+              case m2sr of+                One rx    -> toBuilder rx+                Two rx ry -> toBuilder rx <> " " <> toBuilder ry+                None      -> mempty+  toBuilder (Polygon mfr xys) = surround "polygon" $ f mfr xys+    where f Nothing xys'   = mconcatIntersperse g "," (NE.toList xys')+          f (Just fr) xys' = toBuilder fr <> "," <> mconcatIntersperse g "," (NE.toList xys')+          g (x, y) = toBuilder x <> " " <> toBuilder y++surround :: Builder -> Builder -> Builder+surround func x = func <> "(" <> x <> ")"

@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Types.BorderRadius+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : unknown+--+-----------------------------------------------------------------------------+module Hasmin.Types.BorderRadius+    ( BorderRadius(..)+    , isZeroBR+    ) where++import Data.List.NonEmpty (NonEmpty((:|)))+import qualified Data.List.NonEmpty as NE+import Data.Monoid ((<>))+import qualified Data.Text.Lazy.Builder as B++import Hasmin.Class+import Hasmin.Types.PercentageLength+import Hasmin.Utils+                                -- <length-percentage>{1,4} [ / <length-percentage>{1,4} ]?+data BorderRadius = BorderRadius (NonEmpty PercentageLength) [PercentageLength]+  deriving Show++instance Eq BorderRadius where+  BorderRadius xs1 ys1 == BorderRadius xs2 ys2 =+      minifyBorderRadius xs1 ys1 `eq` minifyBorderRadius xs2 ys2+    where (BorderRadius as1 bs1) `eq` (BorderRadius as2 bs2) = as1 == as2 && bs1 == bs2++instance Minifiable BorderRadius where+  minify (BorderRadius xs ys) =+      minifyBorderRadius <$> traverse minifyPL xs <*> traverse minifyPL ys++minifyBorderRadius :: NonEmpty PercentageLength -> [PercentageLength] -> BorderRadius+minifyBorderRadius as [] = BorderRadius (reduceTRBL as) []+minifyBorderRadius as bs+    | l1 == l2  = BorderRadius l1 []+    | otherwise = BorderRadius l1 (NE.toList l2)+  where l1 = reduceTRBL as+        l2 = reduceTRBL (NE.fromList bs)++instance ToText BorderRadius where+  toBuilder (BorderRadius (h:|ts) xs) = toBuilder h <> f ' ' ts <> f '/' xs+    where f _ [] = mempty+          f i ys = B.singleton i <> mconcatIntersperse toBuilder " " ys++isZeroBR :: BorderRadius -> Bool+isZeroBR (BorderRadius (pl:|[]) []) = isZero pl+isZeroBR _                          = False

@@ -31,14 +31,15 @@ import Data.Char (isHexDigit, digitToInt, intToDigit, toLower) import Data.Maybe (fromMaybe) import Data.Ratio ((%))-import Data.Text (pack, Text)-import Data.Text.Lazy.Builder (Builder, singleton, fromText)+import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder, singleton)+import qualified Data.Text.Lazy.Builder as B import Data.Word (Word8) import qualified Data.Map.Strict as Map import qualified Data.Text as T -import Hasmin.Config import Hasmin.Class+import Hasmin.Config import Hasmin.Types.Numeric import Hasmin.Utils @@ -70,12 +71,8 @@   (Hex6 r1 g1 b1) == (Hex8 r2 g2 b2 a)     | a == "ff" = r1 == r2 && g1 == g2 && b1 == b2     | otherwise = False-  c1 == (Named s) = case Map.lookup (T.toLower s) colorMap of-                      Just a  -> a == c1-                      Nothing -> False-  (Named s) == c2 = case Map.lookup (T.toLower s) colorMap of-                      Just a  -> a == c2-                      Nothing -> False+  c1 == (Named s) = Map.lookup (T.toLower s) colorMap == Just c1+  (Named s) == c2 = c2 == Named s   a == b = toLongHex a == toLongHex b  instance Ord Color where@@ -128,14 +125,14 @@     where values = toBuilderWithCommas [toText h, toText s, toText l]   toBuilder (HSLA h s l a)    = "hsla(" <> values <> singleton ')'     where values = toBuilderWithCommas [toText h, toText s, toText l, toText a]-  toBuilder (Named a)         = fromText a+  toBuilder (Named a)         = B.fromText a   toBuilder (Hex3 r g b)      = singleton '#' <> singleton r <> singleton g <> singleton b   toBuilder (Hex4 r g b a)    = singleton '#' <> singleton r <> singleton g <> singleton b <> singleton a-  toBuilder (Hex6 r g b)      = fromText . pack $ mconcat ["#", r, g, b]-  toBuilder (Hex8 r g b a)    = fromText . pack $ mconcat ["#", r, g, b, a]+  toBuilder (Hex6 r g b)      = B.fromString $ mconcat ["#", r, g, b]+  toBuilder (Hex8 r g b a)    = B.fromString $ mconcat ["#", r, g, b, a]  toBuilderWithCommas :: [Text] -> Builder-toBuilderWithCommas = mconcatIntersperse fromText (singleton ',')+toBuilderWithCommas = mconcatIntersperse B.fromText (singleton ',')  -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --                              Smart constructors@@ -237,10 +234,9 @@ hexToWord8 = fromIntegral . foldl (\s c -> s*16 + digitToInt c) 0  toRGBAInt :: Color -> Color-toRGBAInt (Named s) = case Map.lookup (T.toLower s) colorMap of-                        Just a  -> toRGBAInt a-                        Nothing -> error e+toRGBAInt (Named s) = maybe (error e) toRGBAInt (Map.lookup t colorMap)   where e = T.unpack $ "Invalid color keyword (" <> s <> "). Can't convert to rgba"+        t = T.toLower s toRGBAInt (Hex3 r g b) = RGBAInt (f [r,r]) (f [g,g]) (f [b,b]) 1   where f = fromIntegral . hexToWord8 toRGBAInt (Hex6 r g b) = RGBAInt (hexToWord8 r) (hexToWord8 g) (hexToWord8 b) 1

@@ -22,6 +22,8 @@ import Data.Maybe (fromMaybe) import Data.Sequence (Seq, (|>)) import Data.List (find, delete, minimumBy, (\\))+import Data.List.NonEmpty (NonEmpty((:|)))+import qualified Data.List.NonEmpty as NE import Data.Text (Text) import Data.Text.Lazy.Builder (singleton, fromText) import qualified Data.Map.Strict as Map@@ -41,10 +43,10 @@  -- | A CSS <https://www.w3.org/TR/css-syntax-3/#declaration \<declaration\>>. data Declaration = Declaration-    { propertyName :: Text -- ^ Property name of the declaration.-    , valueList    :: Values  -- ^ Values used in the declaration.-    , isImportant  :: Bool  -- ^ Whether the declaration is \"!important\" (i.e. ends with it).-    , hasIEhack    :: Bool    -- ^ Whether the declaration ends with the \"\\9\" IE hack.+    { propertyName :: Text   -- ^ Property name of the declaration.+    , valueList    :: Values -- ^ Values used in the declaration.+    , isImportant  :: Bool   -- ^ Whether the declaration is \"!important\" (i.e. ends with it).+    , hasIEhack    :: Bool   -- ^ Whether the declaration ends with the \"\\9\" IE hack.     } deriving (Eq, Show) instance ToText Declaration where   toBuilder (Declaration p vs i h) = fromText p <> singleton ':'@@ -98,10 +100,10 @@   ,("right",                      nullPercentageToLength)   ,("bottom",                     nullPercentageToLength)   ,("left",                       nullPercentageToLength)-  ,("border-color",               pure . reduceTRBL)-  ,("border-width",               pure . reduceTRBL)-  ,("border-style",               pure . reduceTRBL)-  ,("padding",                    nullPercentageToLength >=> pure . reduceTRBL)+  ,("border-color",               pure . reduceTRBLDec)+  ,("border-width",               pure . reduceTRBLDec)+  ,("border-style",               pure . reduceTRBLDec)+  ,("padding",                    nullPercentageToLength >=> pure . reduceTRBLDec)   ,("padding-top",                nullPercentageToLength)   ,("padding-right",              nullPercentageToLength)   ,("padding-bottom",             nullPercentageToLength)@@ -110,7 +112,7 @@   ,("margin-right",               nullPercentageToLength)   ,("margin-bottom",              nullPercentageToLength)   ,("margin-left",                nullPercentageToLength)-  ,("margin",                     nullPercentageToLength >=> pure . reduceTRBL)+  ,("margin",                     nullPercentageToLength >=> pure . reduceTRBLDec)   ,("grid-row-gap",               nullPercentageToLength)   ,("grid-column-gap",            nullPercentageToLength)   ,("line-height",                nullPercentageToLength)@@ -288,7 +290,6 @@     ,("left",   LengthV NullLength)     ,("center", PercentageV (Percentage 50))] - -- | Minifies a declaration, based on the property's specific traits (i.e. if -- it inherits or not, and what its initial value is), and the chosen -- configurations.@@ -519,12 +520,12 @@               -> Maybe Declaration -- ^ If successful, the combination of both mergeIntoTRBL d1@(Declaration _ (Values v1 vs) i1 h1) d2@(Declaration p2 (Values v2 _) i2 h2)     | h1 || h2     = Nothing -- TODO handle ie hacks-    | i1 && not i2 = Just $ reduceTRBL d1 -- margin:6px !important;margin-top:0; --> margin:6px !important+    | i1 && not i2 = Just $ reduceTRBLDec d1 -- margin:6px !important;margin-top:0; --> margin:6px !important     | not i1 && i2 = Nothing -- margin:6px;margin-top:0!important; --> stays the same     | otherwise    = do           (_,index) <- find (\(x,_) -> T.isInfixOf x (T.toCaseFold p2)) indexTable           let mkDec ys  = d1 {valueList = mkValues $ replaceAt index v2 ys}-              retDec ys = let mergedDec = reduceTRBL (mkDec ys)+              retDec ys = let mergedDec = reduceTRBLDec (mkDec ys)                           in if textualLength mergedDec <= originalLength                                 then Just mergedDec                                 else Nothing@@ -541,22 +542,9 @@ -- E.g.: margin: 6px 6px 6px 6px;  --> margin: 6px; --       margin: 1px 0 2px 0;      --> margin: 1px 0 2px; -- can be used with "border-image-outset" too.-reduceTRBL :: Declaration -> Declaration-reduceTRBL d@(Declaration _ (Values v1 vs) _ _) =-    case v1:map snd vs of-      [t,r,b,l] -> reduce4 t r b l-      [t,r,b]   -> reduce3 t r b-      [t,r]     -> reduce2 t r-      _         -> d-  where reduce4 tv rv bv lv-            | lv == rv  = reduce3 tv rv bv-            | otherwise = d-        reduce3 tv rv bv-            | tv == bv  = reduce2 tv rv-            | otherwise = d { valueList = mkValues [tv, rv, bv] }-        reduce2 tv rv-            | tv == rv  = d { valueList = mkValues [tv] }-            | otherwise = d { valueList = mkValues [tv, rv] }+reduceTRBLDec :: Declaration -> Declaration+reduceTRBLDec d@(Declaration _ (Values v1 vs) _ _) =+    d { valueList = mkValues . NE.toList $ reduceTRBL (v1:|map snd vs) }  mapValues :: (Value -> Reader Config Value) -> Values -> Reader Config Values mapValues f (Values v1 vs) = do

@@ -7,9 +7,9 @@ -- Stability   : experimental -- Portability : unknown ----- CSS Dimension data types: \<length\> (distance), \<angle\>, \<duration\>,--- \<frequency\>, and \<resolution\>. Provides conversion of absolute--- dimensions into other equivalent dimensions.+-- CSS Dimension data types: \<length\>, \<angle\>, \<time\>, \<frequency\>,+-- and \<resolution\>. Provides conversion of absolute dimensions into other+-- equivalent dimensions. -- ----------------------------------------------------------------------------- module Hasmin.Types.Dimension@@ -17,8 +17,8 @@     , LengthUnit(..)     , Angle(..)     , AngleUnit(..)-    , Duration(..)-    , DurationUnit(..)+    , Time(..)+    , TimeUnit(..)     , Frequency(..)     , FrequencyUnit(..)     , Resolution(..)@@ -35,9 +35,10 @@ import Control.Monad.Reader (asks) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton, fromText)+ import Hasmin.Class-import Hasmin.Types.Numeric import Hasmin.Config+import Hasmin.Types.Numeric import Hasmin.Utils  -- | The \<length\> CSS data type@@ -101,7 +102,7 @@   minify a@(Angle r u) = do       dimSettings <- asks dimensionSettings       pure $ case dimSettings of-               DimMinOn  -> minDim Angle r u [Turn, Grad, Rad, Deg]+               DimMinOn  -> minDim Angle r u [minBound..]                DimMinOff -> a   minify NullAngle = pure NullAngle @@ -109,21 +110,21 @@   toBuilder NullAngle   = singleton '0'   toBuilder (Angle r u) = toBuilder r <> toBuilder u --- | The \<duration\> CSS data type-data Duration = Duration Number DurationUnit+-- | The \<time\> CSS data type+data Time = Time Number TimeUnit   deriving (Show)-instance Eq Duration where-  (Duration r1 u1) == (Duration r2 u2)+instance Eq Time where+  (Time r1 u1) == (Time r2 u2)     | u1 == u2  = r1 == r2     | otherwise = toSeconds r1 u1 == toSeconds r2 u2-instance Minifiable Duration where-  minify d@(Duration r u) = do+instance Minifiable Time where+  minify d@(Time r u) = do       dimSettings <- asks dimensionSettings       pure $ case dimSettings of-                DimMinOn  -> minDim Duration r u [S, Ms]+                DimMinOn  -> minDim Time r u [minBound..]                 DimMinOff -> d-instance ToText Duration where-  toBuilder (Duration r u) = toBuilder r <> toBuilder u+instance ToText Time where+  toBuilder (Time r u) = toBuilder r <> toBuilder u  -- | The \<frequency\> CSS data type data Frequency = Frequency Number FrequencyUnit@@ -136,7 +137,7 @@   minify f@(Frequency r u) = do       dimSettings <- asks dimensionSettings       pure $ case dimSettings of-                DimMinOn  -> minDim Frequency r u [Khz, Hz]+                DimMinOn  -> minDim Frequency r u [minBound..]                 DimMinOff -> f instance ToText Frequency where   toBuilder (Frequency r u) = toBuilder r <> toBuilder u@@ -152,7 +153,7 @@   minify x@(Resolution r u) = do       dimSettings <- asks dimensionSettings       pure $ case dimSettings of-               DimMinOn  -> minDim Resolution r u [Dpcm, Dppx, Dpi]+               DimMinOn  -> minDim Resolution r u [minBound..]                DimMinOff -> x instance ToText Resolution where   toBuilder (Resolution r u) = toBuilder r <> toBuilder u@@ -172,9 +173,9 @@ class Unit a where   convertTo :: a -> Number -> a -> Number -data LengthUnit = IN | CM | MM | Q | PC | PT | PX            -- absolute-                  | EM | EX | CH | VH | VW | VMIN | VMAX | REM -- relative-  deriving (Show, Eq)+data LengthUnit = IN | CM | MM | PC | PT | PX | Q            -- absolute+                | EM | EX | CH | VH | VW | VMIN | VMAX | REM -- relative+  deriving (Show, Eq, Enum, Bounded) instance ToText LengthUnit where   toBuilder IN   = "in"   toBuilder CM   = "cm"@@ -201,31 +202,31 @@   convertTo PX = toPixels   convertTo _  = const -data AngleUnit = Deg | Grad | Rad | Turn-  deriving (Show, Eq)+data AngleUnit = Turn | Grad | Rad | Deg+  deriving (Show, Eq, Enum, Bounded) instance ToText AngleUnit where-  toBuilder Deg  = "deg"+  toBuilder Turn = "turn"   toBuilder Grad = "grad"   toBuilder Rad  = "rad"-  toBuilder Turn = "turn"+  toBuilder Deg  = "deg" instance Unit AngleUnit where-  convertTo Deg  = toDegrees+  convertTo Turn = toTurns   convertTo Grad = toGradians   convertTo Rad  = toRadians-  convertTo Turn = toTurns+  convertTo Deg  = toDegrees -data DurationUnit = S -- seconds-                  | Ms -- miliseconds-  deriving (Show, Eq)-instance ToText DurationUnit where+data TimeUnit = S -- seconds+              | Ms -- miliseconds+  deriving (Show, Eq, Enum, Bounded)+instance ToText TimeUnit where   toBuilder S  = "s"   toBuilder Ms = "ms"-instance Unit DurationUnit where+instance Unit TimeUnit where   convertTo S  = toSeconds   convertTo Ms = toMiliseconds  data FrequencyUnit = Hz | Khz-  deriving (Show, Eq)+  deriving (Show, Eq, Enum, Bounded) instance ToText FrequencyUnit where   toBuilder Hz  = "hz"   toBuilder Khz = "khz"@@ -233,8 +234,8 @@   convertTo Hz  = toHertz   convertTo Khz = toKilohertz -data ResolutionUnit = Dpi | Dpcm | Dppx-  deriving (Show, Eq)+data ResolutionUnit = Dpcm | Dppx | Dpi+  deriving (Show, Eq, Enum, Bounded) instance ToText ResolutionUnit where   toBuilder Dpi  = "dpi"   toBuilder Dpcm = "dpcm"@@ -334,11 +335,11 @@ toTurns d Rad  = d / (2 * rationalPi) toTurns d Turn = d -------------------------------------------------------------------------------toSeconds :: Number -> DurationUnit -> Number+toSeconds :: Number -> TimeUnit -> Number toSeconds d S     = d toSeconds d Ms = d / 1000 -toMiliseconds :: Number -> DurationUnit -> Number+toMiliseconds :: Number -> TimeUnit -> Number toMiliseconds d S     = d * 1000 toMiliseconds d Ms = d ------------------------------------------------------------------------------

@@ -17,22 +17,26 @@ import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton, Builder) -import Hasmin.Config import Hasmin.Class-import Hasmin.Types.Dimension+import Hasmin.Config import Hasmin.Types.Color+import Hasmin.Types.Dimension import Hasmin.Types.Numeric +-- The CSS spec calls it <number-percentage>, amount comes from the mozilla+-- docs.+type Amount = Either Number Percentage+ -- | CSS <https://drafts.fxtf.org/filter-effects/#typedef-filter-function \<filter-function\>> -- data type. data FilterFunction = Blur Length-                    | Brightness (Either Number Percentage)-                    | Contrast (Either Number Percentage)-                    | Grayscale (Either Number Percentage)-                    | Invert (Either Number Percentage)-                    | Opacity (Either Number Percentage)-                    | Saturate (Either Number Percentage)-                    | Sepia (Either Number Percentage)+                    | Brightness Amount+                    | Contrast Amount+                    | Grayscale Amount+                    | Invert Amount+                    | Opacity Amount+                    | Saturate Amount+                    | Sepia Amount                     | HueRotate Angle                     | DropShadow Length Length (Maybe Length) (Maybe Color)   deriving (Show)@@ -97,8 +101,7 @@               c2 <- traverse minify d               pure $ constr x y z c2 -minifyNumberPercentage :: Either Number Percentage-                       -> Reader Config (Either Number Percentage)+minifyNumberPercentage :: Amount -> Reader Config Amount minifyNumberPercentage x = do     conf <- ask     pure $ if shouldMinifyFilterFunctions conf@@ -112,8 +115,7 @@             | 0 < p && p < 10 = Right p             | otherwise       = Left $ toNumber (p / 100) -filterFunctionEquality :: Either Number Percentage-                       -> Either Number Percentage -> Bool+filterFunctionEquality :: Amount -> Amount -> 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

@@ -21,8 +21,9 @@ import Data.Text.Lazy.Builder (singleton)
 import Data.Maybe (catMaybes, fromJust, isNothing, isJust)
 import Data.Either (isLeft)
-import Hasmin.Config
+
 import Hasmin.Class
+import Hasmin.Config
 import Hasmin.Types.Color
 import Hasmin.Types.Dimension
 import Hasmin.Types.Numeric

@@ -16,10 +16,11 @@     ) where  import Control.Monad.Reader (Reader)-import Hasmin.Types.Dimension-import Hasmin.Types.Numeric+ import Hasmin.Class import Hasmin.Config+import Hasmin.Types.Dimension+import Hasmin.Types.Numeric  -- | CSS <length-percentage> data type, i.e.: [length | percentage] -- Though because of the name it would be more intuitive to define:@@ -28,9 +29,7 @@ -- makes no sense to minify a Percentage. type PercentageLength = Either Percentage Length --minifyPL :: PercentageLength-         -> Reader Config PercentageLength+minifyPL :: PercentageLength -> Reader Config PercentageLength minifyPL x@(Right _) = mapM minify x minifyPL x@(Left p)     | p == 0    = pure $ Right NullLength -- minifies 0% to 0

@@ -14,12 +14,13 @@     , minifyPosition     , p50     , l0+    , centerpos     ) where  import Data.Text (Text) import qualified Data.Text as T import Data.Text.Lazy.Builder (singleton, fromText)-import Data.Maybe (isJust)+import Data.Maybe (isJust, isNothing) import Hasmin.Class import Hasmin.Types.Dimension import Hasmin.Types.PercentageLength@@ -30,7 +31,7 @@                 | PosRight                 | PosTop                 | PosBottom-  deriving (Eq, Show)+  deriving (Show, Eq, Enum, Bounded) instance ToText PosKeyword where   toBuilder PosCenter = "center"   toBuilder PosTop    = "top"@@ -65,7 +66,9 @@ minifyPosition p@(Position (Just x) Nothing Nothing (Just y)) =     minifyPos2 x y   where mkPos2 i j = if isZero j-                        then Position Nothing i Nothing l0+                        then if i == p50+                                then Position (Just PosTop) Nothing Nothing Nothing+                                else Position Nothing i Nothing l0                         else Position Nothing i Nothing (Just j)         minifyPos2 PosLeft a   = mkPos2 l0 a         minifyPos2 PosRight a  = mkPos2 p100 a@@ -78,7 +81,7 @@                         else Position Nothing (Just i) Nothing j         minifyPos2 a PosTop    = mkPos2 a l0         minifyPos2 a PosBottom = mkPos2 a p100-        minifyPos2 a PosCenter = mkPos2 a p50+        minifyPos2 a PosCenter = mkPos2 a Nothing         minifyPos2 _ _         = p -- Two <lenght-percentage> minifyPosition p@(Position Nothing (Just x) Nothing (Just y)) = f x y@@ -148,7 +151,7 @@         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+          | otherwise    = Position Nothing (Just b) Nothing Nothing         minifyPos3 PosRight b PosTop           | isZero b     = Position Nothing p100 Nothing l0           | otherwise    = Position (Just PosRight) (Just b) Nothing l0@@ -160,8 +163,18 @@           | 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 isHorizontal i = i == PosLeft || i == PosRight+        f (x, y)           | c == PosLeft && x == Just PosTop && isJust y = minifyPosition $ Position Nothing l0 Nothing y+          | c == PosCenter && isHorizontal a = Position x y Nothing Nothing+          | c == PosTop && isNothing x =+              if y == p50+                 then Position (Just PosTop) Nothing Nothing Nothing+                 else Position x y Nothing l0+          | c == PosBottom && isNothing x =+              if y == p50+                 then Position (Just PosBottom) Nothing Nothing Nothing+                 else Position x y Nothing p100           | otherwise = if Just a == x && Just b == y                            then p                            else minifyPosition $ p {origin2 = x, offset2 = y }@@ -185,7 +198,7 @@         minifyPos4' PosLeft a PosBottom b             | isZero b  = minifyPosition $ Position Nothing (Just a) Nothing p100             | isZero a  = minifyPosition $ Position (Just PosLeft) Nothing (Just PosTop) (Just b)-            | otherwise = minifyPosition $ Position (Just PosLeft) (Just a) (Just PosBottom) (Just b)+            | otherwise = Position (Just PosLeft) (Just a) (Just PosBottom) (Just b)         minifyPos4' PosRight a PosBottom b             | isZero a && isZero b = Position Nothing p100 Nothing p100             | otherwise            = Position (Just PosRight) (Just a) (Just PosBottom) (Just b)@@ -200,12 +213,12 @@                     else (Just PosTop, Just x) minAxis PosLeft x =     case x of-      Left 50 -> (Just PosCenter, Nothing)+      Left 50 -> (Nothing, p50)       smth    -> if isZero smth-                    then (Just PosLeft, Nothing)+                    then (Nothing, l0)                     else (Just PosLeft, Just x) minAxis PosRight x-    | isZero x  = (Just PosRight, Nothing)+    | isZero x  = (Nothing, p100)     | otherwise = (Just PosRight, Just x) minAxis PosBottom x     | isZero x  = (Just PosBottom, Nothing)@@ -213,9 +226,10 @@ minAxis PosCenter x = (Just PosCenter, Just x)  instance Eq Position where-  x == y = let (Position a b c d) = minifyPosition x +  x == y = let (Position a b c d) = minifyPosition x                (Position e f g h) = minifyPosition y            in a == e && b == f && c == g && d == h+              || a == g && b == h && c == e && d == f  l0 :: Maybe PercentageLength l0 = Just $ Right NullLength@@ -225,3 +239,6 @@  p50 :: Maybe PercentageLength p50 = Just $ Left 50++centerpos :: Position+centerpos = Position (Just PosCenter) Nothing Nothing Nothing

@@ -65,7 +65,7 @@                | RsSpace                | RsRound                | RsNoRepeat-  deriving (Eq, Show)+  deriving (Show, Eq, Enum, Bounded) instance ToText RSKeyword where   toBuilder RsRepeat   = "repeat"   toBuilder RsSpace    = "space"

@@ -22,12 +22,12 @@  -- | CSS <https://drafts.csswg.org/css-backgrounds-3/#typedef-shadow \<shadow\>> -- data type, used by the @box-shadow@ property.-data Shadow = Shadow { inset        :: Bool-                     , sOffsetX     :: Length-                     , sOffsetY     :: Length-                     , blurRadius   :: Maybe Length-                     , spreadRadius :: Maybe Length-                     , sColor       :: Maybe Color+data Shadow = Shadow { _inset        :: Bool+                     , _sOffsetX     :: Length+                     , _sOffsetY     :: Length+                     , _blurRadius   :: Maybe Length+                     , _spreadRadius :: Maybe Length+                     , _sColor       :: Maybe Color                      } deriving (Eq, Show)  instance ToText Shadow where

@@ -18,23 +18,25 @@   , StringType(..)   ) where -import Control.Applicative (liftA2, (<|>)) import Control.Monad.Reader (ask, Reader)+import Control.Monad (mzero)+import Control.Applicative ((<|>), many) import Data.Attoparsec.Text (Parser, parse, IResult(Done, Partial, Fail), maybeResult, feed) import Data.Monoid ((<>)) import Data.Text (Text)-import Data.Foldable (foldl')-import Data.Bits ((.|.), shiftL)-import Data.Text.Lazy.Builder (Builder)-import qualified Data.Text.Lazy.Builder as B import qualified Data.Attoparsec.Text as A-import qualified Data.Char as C import qualified Data.Text as T import qualified Data.Text.Lazy as TL+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as B+import qualified Data.Char as C+import Data.Bits ((.|.), shiftL)+import Data.Foldable (foldl')  import Hasmin.Config-import Hasmin.Parser.Utils import Hasmin.Class+import Hasmin.Parser.Primitives+import Hasmin.Parser.Utils  -- | The <https://drafts.csswg.org/css-values-3/#strings \<string\>> data type. -- It represents a string, formed by Unicode characters, delimited by either@@ -80,13 +82,13 @@ unquoteStringType g x@(SingleQuotes s) = maybe (Right x) Left (g s)  removeQuotes :: StringType -> Either Text StringType-removeQuotes = unquoteStringType toIdent+removeQuotes = unquoteStringType (unquote ident)  unquoteUrl :: StringType -> Either Text StringType-unquoteUrl = unquoteStringType toUnquotedURL+unquoteUrl = unquoteStringType (unquote unquotedURL)  unquoteFontFamily :: StringType -> Either Text StringType-unquoteFontFamily = unquoteStringType toUnquotedFontFamily+unquoteFontFamily = unquoteStringType (unquote fontfamilyname)  unquote :: Parser Text -> Text -> Maybe Text unquote p s = case parse p s of@@ -96,15 +98,6 @@                 par@Partial{} -> maybeResult (feed par mempty)                 Fail{}        -> Nothing -toIdent :: Text -> Maybe Text-toIdent = unquote ident--toUnquotedURL :: Text -> Maybe Text-toUnquotedURL = unquote unquotedURL--toUnquotedFontFamily :: Text -> Maybe Text-toUnquotedFontFamily = unquote fontfamilyname- -- TODO can the Parser be avoided by a fold, or one of the provided library -- functions? Apart from being cleaner, doing so would simplify other functions. -- | Parse and convert any escaped unicode to its underlying Char.@@ -124,7 +117,7 @@     parseEscapedAndContinue :: Builder -> Parser Builder     parseEscapedAndContinue b = do         u8 <- utf8-        (b `mappend` u8 `mappend`) <$>  go+        ((b <> u8) <>) <$>  go      utf8 :: Parser Builder     utf8 = do@@ -145,6 +138,26 @@                 | otherwise   = (a `shiftL` 4) .|. fromIntegral (w - 55)               where w = C.ord c -    atMost :: Int -> Parser a -> Parser [a]-    atMost 0 _ = pure []-    atMost n p = A.option [] $ liftA2 (:) p (atMost (n-1) p)+fontfamilyname :: Parser Text+fontfamilyname = do+    i  <- ident+    is <- many (skipComments *> ident)+    if T.toLower i `elem` invalidNames+       then mzero+       else pure $ i <> foldMap (" "<>) is+  where invalidNames = ["serif", "sans-serif", "monospace", "cursive",+                        "fantasy", "inherit", "initial", "unset", "default"]++-- | Parse a URL without enclosing quotes.+-- See <https://drafts.csswg.org/css-syntax-3/#consume-a-url-token §4.3.6. Consume a url token>+unquotedURL :: Parser Text+unquotedURL = do+    t <- many (escape <|> (B.singleton <$> A.satisfy validChar))+    pure $ TL.toStrict (B.toLazyText (mconcat t))+  where validChar x = x /= '\"' && x /= '\'' && x /= '(' && x /= ')'+                   && x /= '\\' && notWhitespace x && notNonprintable x+        notWhitespace x = x /= '\n' &&  x /= '\t' && x /= ' '+        notNonprintable x = not (C.chr 0 <= x && x <= C.chr 8)+                         && x /= '\t'+                         && not ('\SO' <= x && x <= C.chr 31)+                         && x /= '\DEL'

@@ -69,7 +69,7 @@ -- <https://drafts.csswg.org/css-timing-1/#step-timing-functions step timing function>. data StepPosition = Start                   | End -- End is the default value-  deriving (Eq, Show)+  deriving (Show, Eq, Enum, Bounded) instance ToText StepPosition where   toBuilder Start = "start"   toBuilder End   = "end"

@@ -8,8 +8,8 @@ -- Portability : unknown -- ------------------------------------------------------------------------------module Hasmin.Types.Value (-      Value(..)+module Hasmin.Types.Value+    ( Value(..)     , Values(..)     , TextV(..)     , Separator(..)@@ -24,14 +24,16 @@ import Control.Monad.Reader (ask, Reader, mapReader) import Data.Monoid ((<>)) import Data.Maybe (isJust, catMaybes, isNothing)-import Data.Text (Text, toCaseFold)+import Data.Text (Text) import qualified Data.Text as T import Data.Text.Lazy.Builder (fromText, singleton, Builder) import Data.String (IsString) +import Hasmin.Class import Hasmin.Config import Hasmin.Types.BgSize-import Hasmin.Class+import Hasmin.Types.BasicShape+import Hasmin.Types.BorderRadius import Hasmin.Types.Color import Hasmin.Types.Dimension import Hasmin.Types.FilterFunction@@ -53,7 +55,7 @@            | PercentageV Percentage            | LengthV Length            | AngleV Angle-           | DurationV Duration+           | TimeV Time            | FrequencyV Frequency            | ResolutionV Resolution            | ColorV Color@@ -66,15 +68,30 @@            | ShadowText Length Length (Maybe Length) (Maybe Color) -- <shadow-t> type            | PositionV Position            | RepeatStyleV RepeatStyle+           | BorderRadiusV BorderRadius+           | BasicShapeV BasicShape            | BgSizeV BgSize-           --          <bg-image> || <position> [ / <bg-size> ]?  || <repeat-style>    || <attachment>    || <box>{1,2}-           | BgLayer (Maybe Value) (Maybe Position) (Maybe BgSize) (Maybe RepeatStyle) (Maybe TextV) (Maybe TextV) (Maybe TextV)+           -- <bg-image> || <position> [ / <bg-size> ]? || <repeat-style> || <attachment> || <box>{1,2}+           | BgLayer+              { _bgimage      :: Maybe Value+              , _bgposition   :: Maybe Position+              , _bgsize       :: Maybe BgSize+              , _bgrepeat     :: Maybe RepeatStyle+              , _bgattachment :: Maybe TextV+              , _bgbox1       :: Maybe TextV+              , _bgbox2       :: Maybe TextV+              }            --              <bg-image> || <position> [ / <bg-size> ]? || <repeat-style> || <attachment> || <box> || <box> || <'background-color'>            | FinalBgLayer (Maybe Value) (Maybe Position) (Maybe BgSize) (Maybe RepeatStyle) (Maybe TextV) (Maybe TextV) (Maybe TextV) (Maybe Color)            -- [ none | <single-transition-property> ] || <time> || <single-transition-timing-function> || <time>-           | SingleTransition (Maybe TextV) (Maybe Duration) (Maybe TimingFunction) (Maybe Duration)+           | SingleTransition+              { _transitionproperty :: Maybe TextV+              , _time1 :: Maybe Time+              , _transitiontimingfunction :: Maybe TimingFunction+              , _time2 :: Maybe Time+              }            --                         <time> || <timing-function> || <time> || <iteration-count> || <animation-direction> || <animation-fill-mode> || <animation-play-state> || [ none | <keyframes-name> ]-           | SingleAnimation (Maybe Duration) (Maybe TimingFunction) (Maybe Duration) (Maybe Value)  (Maybe TextV) (Maybe TextV) (Maybe TextV) (Maybe Value)+           | SingleAnimation (Maybe Time) (Maybe TimingFunction) (Maybe Time) (Maybe Value)  (Maybe TextV) (Maybe TextV) (Maybe TextV) (Maybe Value)            -- [ [ <'font-style'> || <font-variant-css21> || <'font-weight'> || <'font-stretch'> ]? <'font-size'> [ / <'line-height'> ]? <'font-family'> ] |            | FontV (Maybe TextV) (Maybe TextV) (Maybe Value) (Maybe TextV) Value (Maybe Value) [Value]            | StringV StringType@@ -91,7 +108,7 @@   deriving (Show, Ord, IsString)  instance Eq TextV where-  TextV t1 == TextV t2 = toCaseFold t1 == toCaseFold t2+  TextV t1 == TextV t2 = T.toLower t1 == T.toLower t2 instance ToText TextV where   toText = getText @@ -121,7 +138,7 @@   toBuilder (ColorV c)      = toBuilder c   toBuilder (LengthV d)     = toBuilder d   toBuilder (AngleV a)      = toBuilder a-  toBuilder (DurationV d)   = toBuilder d+  toBuilder (TimeV d)       = toBuilder d   toBuilder (FrequencyV f)  = toBuilder f   toBuilder (ResolutionV r) = toBuilder r   toBuilder (FilterV f)     = toBuilder f@@ -140,6 +157,8 @@     where funcValues = mconcatIntersperse toBuilder (singleton ',') [a, b, c, d]   toBuilder (PositionV p)   = toBuilder p   toBuilder (RepeatStyleV r) = toBuilder r+  toBuilder (BorderRadiusV b) = toBuilder b+  toBuilder (BasicShapeV b)   = toBuilder b   toBuilder (BgSizeV b)     = toBuilder b   toBuilder (BgLayer a b c d e f g) =       let sz  = maybe mempty (\x -> singleton '/' <> toBuilder x) c@@ -177,22 +196,24 @@        <> maybeToBuilder ml <> maybeToBuilder mc  instance Minifiable Value where-  minify (ColorV c)       = ColorV <$> minify c-  minify (LengthV d)      = LengthV <$> minify d-  minify (AngleV a)       = AngleV <$> minify a-  minify (DurationV d)    = DurationV <$> minify d-  minify (FrequencyV f)   = FrequencyV <$> minify f-  minify (ResolutionV r)  = ResolutionV <$> minify r-  minify (GradientV t g)  = GradientV t <$> minify g-  minify (FilterV f)      = FilterV <$> minify f-  minify (TransformV tf)  = TransformV <$> minify tf-  minify (TimingFuncV tf) = TimingFuncV <$> minify tf-  minify (StringV s)      = StringV <$> minify s-  minify (UrlV u)         = UrlV <$> minify u-  minify (Format x)       = Format <$> mapM minify x-  minify (PositionV p)    = PositionV <$> minify p-  minify (RepeatStyleV r) = RepeatStyleV <$> minify r-  minify (BgSizeV b)      = BgSizeV <$> minify b+  minify (ColorV c)        = ColorV <$> minify c+  minify (LengthV d)       = LengthV <$> minify d+  minify (AngleV a)        = AngleV <$> minify a+  minify (TimeV d)         = TimeV <$> minify d+  minify (FrequencyV f)    = FrequencyV <$> minify f+  minify (ResolutionV r)   = ResolutionV <$> minify r+  minify (GradientV t g)   = GradientV t <$> minify g+  minify (FilterV f)       = FilterV <$> minify f+  minify (TransformV tf)   = TransformV <$> minify tf+  minify (TimingFuncV tf)  = TimingFuncV <$> minify tf+  minify (StringV s)       = StringV <$> minify s+  minify (UrlV u)          = UrlV <$> minify u+  minify (Format x)        = Format <$> mapM minify x+  minify (PositionV p)     = PositionV <$> minify p+  minify (RepeatStyleV r)  = RepeatStyleV <$> minify r+  minify (BgSizeV b)       = BgSizeV <$> minify b+  minify (BasicShapeV b)    = BasicShapeV <$> minify b+  minify (BorderRadiusV b) = BorderRadiusV <$> minify b   minify (ShadowV s)      = ShadowV <$> minify s   minify (ShadowText l1 l2 ml mc) = minifyPseudoShadow ShadowText l1 l2 ml mc   minify (BgLayer img pos sz rst att b1 b2) = do@@ -220,11 +241,11 @@       let p = if prop == Just "all"                  then Nothing                  else prop -- TODO lowercase here-      (tDuration, tDelay) <- handleTime tdur tdel-      tfunc               <- handleTimingFunction tf-      pure $ if isNothing p && isNothing tDuration && isNothing tDelay && isNothing tfunc-                then SingleTransition p (Just $ Duration 0 S) tfunc tDelay-                else SingleTransition p tDuration tfunc tDelay+      (tTime, tDelay) <- handleTime tdur tdel+      tfunc           <- handleTimingFunction tf+      pure $ if isNothing p && isNothing tTime && isNothing tDelay && isNothing tfunc+                then SingleTransition p (Just $ Time 0 S) tfunc tDelay+                else SingleTransition p tTime tfunc tDelay   minify (SingleAnimation t1 tf t2 ic ad af ap kf) = do       (tdur, tdel) <- handleTime t1 t2       tfunc        <- handleTimingFunction tf@@ -396,33 +417,32 @@     | otherwise = Just <$> minify tfunc  -- Used for SingleAnimation and SingleTransition minification.-handleTime :: Maybe Duration -> Maybe Duration -> Reader Config (Maybe Duration, Maybe Duration)-handleTime (Just t) Nothing = if t == Duration 0 S-                                 then pure (Nothing, Nothing)-                                 else do newT <- minify t-                                         pure (Just newT, Nothing)+handleTime :: Maybe Time -> Maybe Time -> Reader Config (Maybe Time, Maybe Time)+handleTime (Just t) Nothing+    | t == Time 0 S = pure (Nothing, Nothing)+    | otherwise     = mzip (Just <$> minify t) (pure Nothing) handleTime (Just t1) (Just t2)-    | t1 == Duration 0 S = if t2 == t1-                              then pure (Nothing, Nothing)-                              else do newT2 <- minify t2-                                      newT1 <- minify t1-                                      pure (Just newT1, Just newT2)+    | t1 == Time 0 S = if t2 == t1+                          then pure (Nothing, Nothing)+                          else do newT2 <- minify t2+                                  newT1 <- minify t1+                                  pure (Just newT1, Just newT2)     | otherwise = do newT1 <- minify t1-                     if t2 == Duration 0 S+                     if t2 == Time 0 S                         then pure (Just t1, Nothing)                         else do newT2 <- minify t2                                 pure (Just newT1, Just newT2) handleTime _ _ = pure (Nothing, Nothing)  removeIfEqualTo :: Text -> Maybe TextV -> Maybe TextV-removeIfEqualTo _ Nothing  = Nothing+removeIfEqualTo _ Nothing = Nothing removeIfEqualTo s (Just x)     | x == TextV s = Nothing     | otherwise    = Just x  -- Unquotes font family names when possible optimizeFontFamily :: Value -> Reader Config Value-optimizeFontFamily (Other t) = mkOther <$> lowercaseText (getText t)+optimizeFontFamily (Other t)   = mkOther <$> lowercaseText (getText t) optimizeFontFamily (StringV s) = do     conf <- ask     ffamily <- mapString lowercaseText s

@@ -17,10 +17,13 @@     , restrict     , textualLength     , replaceAt+    , mzip+    , reduceTRBL     ) where  import Data.Monoid ((<>)) import qualified Data.Text as T+import Data.List.NonEmpty (NonEmpty((:|)))  import Hasmin.Class @@ -58,3 +61,24 @@  eps :: Rational eps = 0.000001 -- See https://bug-30341-attachments.webkit.org/attachment.cgi?id=45276++-- Why does Attoparsec have no instance of MonadZip? :«+mzip :: Applicative f => f a -> f b -> f (a, b)+mzip f g = (,) <$> f <*> g++reduceTRBL :: Eq a => NonEmpty a -> NonEmpty a+reduceTRBL xs =+    case xs of+      t:|[r,b,l] -> reduce4 t r b l+      t:|[r,b]   -> reduce3 t r b+      t:|[r]     -> reduce2 t r+      _          -> xs+  where reduce4 tv rv bv lv+            | lv == rv  = reduce3 tv rv bv+            | otherwise = xs+        reduce3 tv rv bv+            | tv == bv  = reduce2 tv rv+            | otherwise = tv:|[rv, bv]+        reduce2 tv rv+            | tv == rv  = tv:|[]+            | otherwise = tv:|[rv]

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS -Wno-orphans #-}  module Hasmin.TestUtils     ( module Hasmin.TestUtils@@ -8,7 +9,8 @@     ) where  import Test.Hspec-import Test.QuickCheck+import Test.QuickCheck hiding (NonZero)+import Test.QuickCheck.Instances() import Test.Hspec.Attoparsec (parseSatisfies, (~>))  import Control.Applicative (liftA2, liftA3)@@ -28,6 +30,8 @@ import Hasmin.Types.Position import Hasmin.Types.TimingFunction import Hasmin.Types.RepeatStyle+import Hasmin.Types.BasicShape+import Hasmin.Types.BorderRadius import Hasmin.Utils  @@ -51,40 +55,33 @@   it (unpack textToParse) $     (toText <$> (textToParse ~> parser)) `parseSatisfies` (== expectedResult) -mkGen :: [a] -> Gen a-mkGen xs = (xs !!) <$> choose (0, length xs - 1)+chooseConstructor :: (Enum a, Bounded a) => Gen a+chooseConstructor = oneof $ fmap pure [minBound..]  newtype Declarations = Declarations [Declaration] instance ToText Declarations where   toText (Declarations ds) = mconcatIntersperse toText (singleton ';') ds  instance Arbitrary Length where-  arbitrary = liftA2 Length 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]+  arbitrary = liftA2 Length arbitrary chooseConstructor  instance Arbitrary Angle where-  arbitrary = liftA2 Angle arbitrary angleUnit-    where angleUnit = mkGen [Deg, Grad, Rad, Turn]+  arbitrary = liftA2 Angle arbitrary chooseConstructor -instance Arbitrary Duration where-  arbitrary = liftA2 Duration arbitrary durationUnit-    where durationUnit = mkGen [S, Ms]+instance Arbitrary Time where+  arbitrary = liftA2 Time arbitrary chooseConstructor  instance Arbitrary Frequency where-  arbitrary = liftA2 Frequency arbitrary frequencyUnit-    where frequencyUnit = mkGen [Hz, Khz]+  arbitrary = liftA2 Frequency arbitrary chooseConstructor  instance Arbitrary Resolution where-  arbitrary = liftA2 Resolution arbitrary resolutionUnit-    where resolutionUnit = mkGen [Dpi, Dpcm, Dppx]+  arbitrary = liftA2 Resolution arbitrary chooseConstructor  instance Arbitrary Number where   arbitrary = toNumber <$> (arbitrary :: Gen Rational)  instance Arbitrary PosKeyword where-  arbitrary = mkGen [PosCenter, PosLeft, PosRight, PosTop, PosBottom]+  arbitrary = chooseConstructor  instance Arbitrary Percentage where   arbitrary = fmap Percentage (arbitrary :: Gen Rational)@@ -112,7 +109,7 @@   arbitrary = pure Auto  instance Arbitrary StepPosition where-  arbitrary = oneof [pure Start, pure End]+  arbitrary = chooseConstructor  instance Arbitrary TimingFunction where   arbitrary = oneof [ liftM4 CubicBezier arbitrary arbitrary arbitrary arbitrary@@ -152,15 +149,47 @@                         ]  instance Arbitrary RSKeyword where-  arbitrary = mkGen [RsRepeat, RsSpace, RsRound, RsNoRepeat]+  arbitrary = oneof $ fmap pure [minBound..] +instance Arbitrary BasicShape where+  arbitrary = oneof+      [liftA2 Inset arbitrary arbitrary+      ,liftA2 Circle arbitrary arbitrary+      ,liftA2 Ellipse arbitrary arbitrary+      ,liftA2 Polygon arbitrary arbitrary+      ]++instance Arbitrary FillRule where+  arbitrary = oneof [pure NonZero, pure EvenOdd]++instance Arbitrary a => Arbitrary (AtMost2 a) where+  arbitrary = oneof+      [pure None+      ,One <$> arbitrary+      ,liftA2 Two arbitrary arbitrary+      ]++instance Arbitrary ShapeRadius where+  arbitrary = oneof+      [SRLength <$> arbitrary+      ,SRPercentage <$> arbitrary+      ,pure SRClosestSide+      ,pure SRFarthestSide+      ]++instance Arbitrary Position where+  arbitrary = Position <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary BorderRadius where+  arbitrary = BorderRadius <$> arbitrary <*> arbitrary+ -- | Generates color keywords uniformly distributed colorKeyword :: Gen Text-colorKeyword = mkGen $ fmap fst keywordColors+colorKeyword = oneof $ fmap (pure . fst) keywordColors  -- | Generates a hexadecimal character uniformly distributed hexChar :: Gen Char-hexChar = mkGen hexadecimals+hexChar = oneof $ fmap pure hexadecimals  hexString :: Gen String hexString = liftA2 (\x y -> [x,y]) hexChar hexChar

@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}++module Hasmin.Types.BasicShapeSpec where++import Data.Text (Text)+import Data.Foldable (traverse_)+import Data.Attoparsec.Text (Parser)+import Test.Hspec.QuickCheck (modifyMaxSuccess)++import Hasmin.Parser.Value+import Hasmin.Types.Value+import Hasmin.Types.BasicShape+import Hasmin.TestUtils++basicShapeTests :: Spec+basicShapeTests =+  describe "<basic-shape> tests" $ do+    traverse_ (matchSpec f) basicShapeTestsInfo+    modifyMaxSuccess (const 10000) . it "Minified <basic-shape> maintains semantical equivalence" $+      property (prop_minificationEq :: BasicShape -> Bool)+  where f :: Parser Value+        f = minifyWithTestConfig <$> value++basicShapeTestsInfo :: [(Text, Text)]+basicShapeTestsInfo =+  [("inset(1px 2px 1px 2px)",              "inset(1px 2px)")+  ,("inset(1px 1px round 4px / 4px)",      "inset(1px round 4px)")+  ,("inset(1px 1px round 0px 0% / 0 0 0)", "inset(1px)")+  ,("ellipse(12px 12px at left bottom)",   "ellipse(9pt 9pt at 0 100%)")+  ,("ellipse(12px 12px at center)",        "ellipse(9pt 9pt)")+  ,("ellipse(12px closest-side)",          "ellipse(9pt)")+  ,("ellipse(farthest-side closest-side)", "ellipse(farthest-side)")+  ,("ellipse(closest-side closest-side)",  "ellipse()")+  ,("polygon(nonzero, 12px 12px)",         "polygon(9pt 9pt)")+  ,("polygon(evenodd, 12px 12px)",         "polygon(evenodd,9pt 9pt)")+  ,("circle(closest-side at center)",      "circle()")+  ,("circle(closest-side at left bottom)", "circle(at 0 100%)")+  ,("circle(12px 12px at 45%)",            "circle(9pt 9pt at 45%)")+  ]++spec :: Spec+spec = basicShapeTests++main :: IO ()+main = hspec spec

@@ -13,7 +13,7 @@       it "Minified <angle>s are equivalent to the original ones" $         property (prop_minificationEq :: Angle -> Bool)       it "Minified <time>s are equivalent to the original ones" $-        property (prop_minificationEq :: Duration -> Bool)+        property (prop_minificationEq :: Time -> Bool)       it "Minified <frequency>s are equivalent to the original ones" $         property (prop_minificationEq :: Frequency -> Bool)       it "Minified <resolution>s are equivalent to the original ones" $@@ -65,7 +65,7 @@       it "1in != 1em" $         Length 1 IN `shouldNotBe` Length 1 EM     -- describe "<time> conversions" $ do-      -- it "" $ Duration 1 S `shouldBe` Duration 1000 Ms+      -- it "" $ Time 1 S `shouldBe` Time 1000 Ms     -- describe "<frequency> conversions" $ do       -- it "" $ Frequency 1 Khz `shouldBe` Frequency 1000 Hz     -- describe "<resolution> conversions" $ do

@@ -3,17 +3,19 @@ module Hasmin.Types.PositionSpec where  import Data.Text (Text)+import Test.Hspec.QuickCheck (modifyMaxSuccess)  import Hasmin.Parser.Value import Hasmin.TestUtils +import Hasmin.Types.Position+ positionMinificationTests :: Spec positionMinificationTests =-    describe "<position> minification" $-        mapM_ (matchSpec f) positionMinificationTestsInfo-      -- it "Minifies <position> properly" $-      -- it "Minified <position> maintains semantical equivalence" $ do-        -- property (prop_minificationEq :: Position -> Bool)+    describe "<position> minification" $ do+      mapM_ (matchSpec f) positionMinificationTestsInfo+      modifyMaxSuccess (const 200000) . it "Minified <position> maintains semantical equivalence" $+        property (prop_minificationEq :: Position -> Bool)   where f = minifyWithTestConfig <$> position  positionMinificationTestsInfo :: [(Text, Text)]@@ -60,6 +62,7 @@   ,("left 50% top 0%", "top")   ,("left 50% top",    "top")   ,("center top",      "top")+  ,("center 0%",       "top")    ,("100% 0%",         "100% 0")   ,("right top",       "100% 0")@@ -70,6 +73,7 @@   ,("top 0% right",    "100% 0")   ,("top right 0%",    "100% 0")   ,("top right",       "100% 0")+  ,("right 0%",        "100% 0")    ,("100%",             "100%")   ,("100% 50%",         "100%")@@ -130,6 +134,7 @@   ,("20px bottom",         "20px 100%")   ,("right 20px",          "100% 20px")   ,("top 30px right 0",    "100% 30px")+  -- ,("left -1% bottom -1%", "99% 99%") -- TODO   ]  spec :: Spec

@@ -3,7 +3,6 @@ module Hasmin.Types.RepeatStyleSpec where  import Data.Text (Text)-import Control.Applicative (liftA2) import Hasmin.Parser.Value import Hasmin.Types.RepeatStyle import Hasmin.TestUtils@@ -11,7 +10,7 @@ repeatStyleTests :: Spec repeatStyleTests =     describe "<repeat-style> minification tests" $ do-      it "Minified <repeat-style> maintains semantic equivalence" $ +      it "Minified <repeat-style> maintains semantic equivalence" $         property (prop_minificationEq :: RepeatStyle -> Bool)       mapM_ (matchSpec f) repeatStyleTestsInfo   where f = minifyWithTestConfig <$> repeatStyle