hasmin 1.0.2.1 → 1.0.3

raw patch · 11 files changed

+1532/−1434 lines, 11 filesdep ~optparse-applicativePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: optparse-applicative

API changes (from Hackage documentation)

Files

• CHANGELOG.md +48/−8
• Main.hs +7/−9
• README.md +6/−6
• hasmin.cabal +4/−3
• src/Hasmin/Parser/Value.hs +1/−0
• src/Hasmin/Properties.hs +6/−4
• src/Hasmin/Types/Declaration.hs +115/−87
• src/Hasmin/Types/Gradient.hs +316/−316
• src/Hasmin/Types/TransformFunction.hs +550/−550
• tests/DocTest.hs +6/−6
• tests/Hasmin/Types/DeclarationSpec.hs +473/−445

@@ -1,9 +1,43 @@ # Changelog This project adheres to [PVP](https://pvp.haskell.org). +## 1.0.3+### Fixed+* `overflow: visible hidden` minifying as `overflow:hidden`. Now it's left+  untouched. It's possible that there where other instances of this, which+  should now be fixed.+* quickcheck-instances upper bound not admitting version 0.3.19+  ([#5](https://github.com/contivero/hasmin/issues/5))+* Incorrect description for two flags in the usage info (when running `--help`).+  The descriptions for `-no-@kfsel-min` and `-no-transform-function-min` were+  swapped.++### Added+* Minification for properties with a pair of values whose second one defaults to+  the first when missing. For example: `overflow: clip clip` is minified to+  `overflow: clip`. This also properly interacts with property traits, i.e.+  `overflow: visible visible` is properly minified to `overflow: unset` (since+  `visible visible` is equivalent to `visible`, and `visible` is the initial+  value and overflow doesn't inherit, thus `unset`).+  Among the properties for which this is now done are:++  - `border-bottom-left-radius`+  - `border-bottom-right-radius`+  - `border-top-left-radius`+  - `border-top-right-radius`+  - `overscroll-behavior`++* Property traits for `overscroll-behavior` and its longhands,+  `overscroll-behavior-x` and `overscroll-behavior-y`.+* Minification for `object-position`. This property's value is now parsed as a+  `<position>`, allowing to apply all the minifications a `<position>` allows.+* Minification for `text-emphasis-position`. This property now correctly+  utilizes its traits, e.g. `text-emphasis-position: right over` minifies to+  `text-emphasis-position: unset`.+ ## 1.0.2.1 ### Fixed-* Parser not supporting CSS variables. #3+* Parser choking on CSS variables. ([#3](https://github.com/contivero/hasmin/issues/3))  ## 1.0.2 ### Added@@ -96,7 +130,7 @@ This version introduced a non-exhaustive pattern bug. Don't use it.  ### Added-Added a simple merging of adjacent media queries (`@media` rules), e.g.:+* Simple merging of adjacent media queries (`@media` rules), e.g.: ```css @media all and (min-width: 24rem) {   a { font-size: 1.2rem; }@@ -112,6 +146,7 @@   b { padding-left: .25rem; padding-right: .25rem; } } ```+This closes [#2](https://github.com/contivero/hasmin/issues/2).  ## 0.3.2.4 * Relaxed doctest upper bound once more, see [stackage issue 2663](https://github.com/fpco/stackage/issues/2663#issuecomment-319880160).@@ -126,19 +161,24 @@ * Relaxed optparse-applicative upper bound.  ## 0.3.2-* Fixed some dimensions minifying incorrectly.-* Fixed some Eq instances.+### Fixed+* Some dimensions minifying incorrectly.+* Some Eq instances. * <An+B> values data type modified to disallow invalid values. This makes the   data type safer, also simplifying the Quickcheck Arbitrary instance.-* Improved test coverage.+### Improved+* Test coverage.  ## 0.3.1.3-* Added support for `@supports` rules, and a slight minification for them: it+### Added+* Support for `@supports` rules, and a slight minification for them: it   removes adjacent negations, i.e.: @supports not (not ...) gets turn into   @supports ....-* Fixed a small bug with `:lang()` where spaces before the right parenthesis+### Fixed+* A small bug with `:lang()` where spaces before the right parenthesis   weren't being removed.-* Improved test coverage.+### Improved+* Test coverage.  ## 0.3.0.1 Initial release

@@ -30,15 +30,14 @@  type Instructions = (Commands, Config) -data Commands = Commands { shouldBeautify :: Bool-                         , shouldCompress :: Bool-                         , file :: FilePath-                         } deriving (Show)+data Commands = Commands+    { shouldCompress :: Bool+    , file :: FilePath+    } deriving (Show)  command :: Parser Commands command = Commands-    <$> switch (long "beautify" <> short 'b' <> help "Beautify output")-    <*> switch (long "zopfli" <> short 'z' <> help "Compress result using zopfli")+    <$> switch (long "zopfli" <> short 'z' <> help "Compress result using zopfli")     <*> argument str (metavar "FILE")  config :: Parser Config@@ -74,9 +73,9 @@                     <> help "Disable minification of An+B microsyntax")   <*> flag True False (long "no-@kfsel-min"                     <> short 'k'-                    <> help "Disable transform function minification")-  <*> flag True False (long "no-transform-function-min"                     <> help "Disable @keyframe selectors minification")+  <*> flag True False (long "no-transform-function-min"+                    <> help "Disable transform function minification")   <*> switch (long "convert-escaped-characters"            <> help "Convert escaped characters to their UTF-8 equivalent")   <*> flag True False (long "no-null-percentage-conversion"@@ -113,6 +112,5 @@       Left e   -> die e   where process :: Text -> Commands -> IO ()         process ts comm-          | shouldBeautify comm = error "Currently unsupported"           | shouldCompress comm = B.writeFile "output.gz" . compressWith defaultCompressOptions GZIP . TE.encodeUtf8 $ ts           | otherwise           = TIO.putStr ts

@@ -20,14 +20,14 @@ ## Building & Installing ### Stack The easiest and prefered way is using-[stack](https://docs.haskellstack.org/en/stable/README/). Clone the repo, then:+[stack](https://docs.haskellstack.org/en/stable/README/). To directly install, use the following one-liner: ```sh-$ cd path/to/hasmin/repo-$ stack build+git clone git@github.com:contivero/hasmin.git && cd hasmin && stack install ```-After that, you can install it with `stack install` (installs by default to `~/.local/bin`).-If you'd rather just try it out, use `stack exec hasmin` (keep in mind it has-a slight additional delay at the beginning when run this way).+Stack installs inside `~/.local/bin` by default. If you'd rather just try hasmin+out, replace `install` by `build`, and then use `stack exec hasmin` from inside+the hasmin directory (keep in mind it has a slight additional delay at the+beginning when run this way).  ### Cabal Alternatively, you can use [cabal](https://www.haskell.org/cabal/):

@@ -1,8 +1,9 @@ name:                hasmin-version:             1.0.2.1+version:             1.0.3 license:             BSD3 license-file:        LICENSE-author:              (c) 2017 Cristian Adrián Ontivero <cristianontivero@gmail.com>+copyright:           © 2016-2018 Cristian Adrián Ontivero+author:              Cristian Adrián Ontivero maintainer:          Cristian Adrián Ontivero <cristianontivero@gmail.com> synopsis:            CSS Minifier homepage:            https://github.com/contivero/hasmin#readme@@ -127,7 +128,7 @@                      , 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+                     , quickcheck-instances >=0.3.16  && <0.4                      , text                 >=1.2     && <1.3                      , hasmin 

@@ -338,6 +338,7 @@     ,("-webkit-perspective-origin", singleValue positionvalue)     ,("mask-position",              positionList)     ,("-webkit-mask-position",      positionList)+    ,("object-position",            singleValue positionvalue)     -- ,("transform-origin",           transformOrigin)     -- ,("-ms-transform-origin",       transformOrigin)     -- ,("-webkit-transform-origin",   transformOrigin)

@@ -288,8 +288,11 @@     ,("outline-width",                      "medium", NonInherited, ["outline"], mempty)     ,("overflow",                           "visible", NonInherited, mempty, mempty)     ,("overflow-wrap",                      "normal", Inherited, mempty, mempty) -- also called word-wrap-    ,("overflow-x",                         "visible", NonInherited, mempty, mempty) -- experimental-    ,("overflow-y",                         "visible", NonInherited, mempty, mempty) -- experimental+    ,("overflow-x",                         "visible", NonInherited, ["overflow"], mempty) -- experimental+    ,("overflow-y",                         "visible", NonInherited, ["overflow"], mempty) -- experimental+    ,("overscroll-behavior",                "auto", NonInherited, mempty, ["overscroll-behavior-x", "overscroll-behavior-y"]) -- experimental, shorthand+    ,("overscroll-behavior-x",              "auto", NonInherited, ["overscroll-behavior"], mempty) -- experimental+    ,("overscroll-behavior-y",              "auto", NonInherited, ["overscroll-behavior"], mempty) -- experimental     ,("padding",                            mempty {-shorthand-}, NonInherited, mempty, ["padding-top", "padding-right", "padding-bottom", "padding-left"])     -- ,("padding-block*",          ("0", NonInherited)) -- experimental     ,("padding-bottom",                     "0", NonInherited, ["padding"], mempty)@@ -307,7 +310,6 @@     ,("quotes",                             mempty {-UA dependent-}, Inherited, mempty, mempty)     ,("resize",                             "none", NonInherited, mempty, mempty)     ,("right",                              "auto", NonInherited, mempty, mempty)-    ,("right",                              "auto", NonInherited, mempty, mempty)     -- ,("ruby-*", -- experimental     ,("scroll-behavior",                    "auto", NonInherited, mempty, mempty)     -- ,("scroll-snap-coordinate", ("none", NonInherited)) -- experimental@@ -330,7 +332,7 @@     ,("text-decoration-style",              "solid", NonInherited, ["text-decoration"], mempty)     ,("text-emphasis",                      "none currentcolor", NonInherited, mempty, ["text-emphasis-color", "text-emphasis-style"]) -- shorthand     ,("text-emphasis-color",                "currentcolor", NonInherited, ["text-emphasis"], mempty)-    ,("text-emphasis-position",             mempty {-"over right"-}, NonInherited, mempty, mempty)+    ,("text-emphasis-position",             "over right", NonInherited, mempty, mempty)     ,("text-emphasis-style",                "none", NonInherited, ["text-emphasis"], mempty)     ,("text-indent",                        "0", Inherited, mempty, mempty)     ,("text-orientation",                   "mixed", Inherited, mempty, mempty) -- experimental

@@ -189,7 +189,7 @@           | otherwise                             = v         f _ _ = v --- Converts the keywords "normal" and "bold" to 400 and 700, respectively.+-- | Converts the keywords "normal" and "bold" to 400 and 700, respectively. fontWeightOptimizer :: Declaration -> Reader Config Declaration fontWeightOptimizer = optimizeValues f   where f :: Value -> Reader Config Value@@ -212,42 +212,35 @@     pure $ if shouldMinifyTransformOrigin conf               then d { valueList = optimizeTransformOrigin' vals}               else d-  where optimizeTransformOrigin' :: Values -> Values-        optimizeTransformOrigin' v =-          mkValues $ case valuesToList v of-                       [x, y, z] -> if isZeroVal z-                                       then transformOrigin2 x y-                                       else transformOrigin3 x y z-                       [x, y]    -> transformOrigin2 x y-                       [x]       -> transformOrigin1 x-                       x         -> x---- isZeroVal is needed because we are using a generic parser for--- transform-origin, so 0 parses as a number instead of a distance.-isZeroVal :: Value -> Bool-isZeroVal (LengthV (Length 0 _)) = True-isZeroVal (LengthV NullLength)   = True-isZeroVal (NumberV (Number 0))   = True-isZeroVal (PercentageV 0)        = True-isZeroVal _                      = False+  where+    optimizeTransformOrigin' :: Values -> Values+    optimizeTransformOrigin' v =+        mkValues $ case valuesToList v of+            [x, y, z] -> if isZeroVal z+                            then transformOrigin2 x y+                            else transformOrigin3 x y z+            [x, y]    -> transformOrigin2 x y+            [x]       -> transformOrigin1 x+            x         -> x -transformOrigin1 :: Value -> [Value]-transformOrigin1 (Other "top")    = [Other "top"]-transformOrigin1 (Other "bottom") = [Other "bottom"]-transformOrigin1 (Other "right")  = [PercentageV (Percentage 100)]-transformOrigin1 (Other "left")   = [LengthV NullLength]-transformOrigin1 (Other "center") = [PercentageV (Percentage 50)]-transformOrigin1 (PercentageV 0)  = [LengthV NullLength]-transformOrigin1 x                = [x]+    transformOrigin1 :: Value -> [Value]+    transformOrigin1 (Other "top")    = [Other "top"]+    transformOrigin1 (Other "bottom") = [Other "bottom"]+    transformOrigin1 (Other "right")  = [PercentageV (Percentage 100)]+    transformOrigin1 (Other "left")   = [LengthV NullLength]+    transformOrigin1 (Other "center") = [PercentageV (Percentage 50)]+    transformOrigin1 (PercentageV 0)  = [LengthV NullLength]+    transformOrigin1 x                = [x] -transformOrigin2 :: Value -> Value -> [Value]-transformOrigin2 x y-    | equalsCenter x     = firstIsCenter-    | equalsCenter y     = secondIsCenter-    | isYoffsetKeyword x = fmap convertValue [y,x]-    | isXoffsetKeyword y = fmap convertValue [y,x]-    | otherwise          = fmap convertValue [x,y]-  where firstIsCenter+    transformOrigin2 :: Value -> Value -> [Value]+    transformOrigin2 x y+        | equalsCenter x     = firstIsCenter+        | equalsCenter y     = secondIsCenter+        | isYoffsetKeyword x = fmap convertValue [y,x]+        | isXoffsetKeyword y = fmap convertValue [y,x]+        | otherwise          = fmap convertValue [x,y]+      where+        firstIsCenter             | equalsCenter y           = [per50]             | isYoffsetKeyword y       = [y]             | y == per100              = [Other "bottom"]@@ -272,15 +265,26 @@             | otherwise = n         convertValue i = i -transformOrigin3 :: Value -> Value -> Value -> [Value]-transformOrigin3 x y z-    | x == Other "top" || x == Other "bottom"-      || y == Other "left" || y == Other "right" = fmap replaceKeywords [y, x, z]-    | otherwise = fmap replaceKeywords [x, y, z]-  where replaceKeywords :: Value -> Value+    transformOrigin3 :: Value -> Value -> Value -> [Value]+    transformOrigin3 x y z+        | x == Other "top" || x == Other "bottom"+          || y == Other "left" || y == Other "right" = fmap replaceKeywords [y, x, z]+        | otherwise = fmap replaceKeywords [x, y, z]+      where+        replaceKeywords :: Value -> Value         replaceKeywords (Other t) = fromMaybe x (Map.lookup (getText t) transformOriginKeywords)         replaceKeywords e         = e +-- isZeroVal is needed because we are using a generic parser for+-- transform-origin, so 0 parses as a number instead of a distance.+isZeroVal :: Value -> Bool+isZeroVal (LengthV (Length 0 _)) = True+isZeroVal (LengthV NullLength)   = True+isZeroVal (NumberV (Number 0))   = True+isZeroVal (PercentageV 0)        = True+isZeroVal _                      = False++ -- transform-origin keyword meanings. transformOriginKeywords :: Map Text Value transformOriginKeywords = Map.fromList@@ -297,12 +301,12 @@ minifyDec d@(Declaration p vs _ _) mv inhs =     case mv of       -- Use the found initial values to try to reduce the declaration-      Just vals ->+      Just initialVals ->           case Map.lookup (T.toCaseFold p) declarationExceptions of             -- Use a specific function to reduce the property if             -- needed, otherwise use the general property reducer-            Just f  -> f d vals inhs-            Nothing -> reduceDeclaration d vals inhs+            Just f  -> f d initialVals inhs+            Nothing -> reduceDeclaration d initialVals inhs       -- Property with no defined initial values. Try to reduce css-wide keywords       Nothing   ->           if inhs == NonInherited && vs == initial || inhs == Inherited && vs == inherit@@ -322,66 +326,89 @@ -- normal declaration minification scheme and need special treatment. declarationExceptions :: Map Text (Declaration -> Values -> Inheritance -> Declaration) declarationExceptions = Map.fromList $ map (first T.toCaseFold)-  [("background-size",         backgroundSizeReduce)-  ,("-webkit-background-size", backgroundSizeReduce)-  ,("font-synthesis",          fontSynthesisReduce)-  -- Needed because otherwise the reducer replaces commas by spaces.-  -- i.e. text-shadow: 1px 1px red,2px 2px blue ==>-  --      text-shadow: 1px 1px red 2px 2px blue.-  ,("text-shadow",             \d _ _ -> d)-  ]+    [("background-size",            backgroundSizeReduce)+    ,("-webkit-background-size",    backgroundSizeReduce)+    ,("border-bottom-left-radius",  reduceDefaultingToFirst)+    ,("border-bottom-right-radius", reduceDefaultingToFirst)+    ,("border-top-left-radius",     reduceDefaultingToFirst)+    ,("border-top-right-radius",    reduceDefaultingToFirst)+    ,("font-synthesis",             reduceTwoKeywordInitial)+    ,("overflow",                   reduceDefaultingToFirst)+    ,("overscroll-behavior",        reduceDefaultingToFirst)+    ,("text-emphasis-position",     reduceTwoKeywordInitial)+    -- Needed because otherwise the reducer replaces commas by spaces.+    -- i.e. text-shadow: 1px 1px red,2px 2px blue ==>+    --      text-shadow: 1px 1px red 2px 2px blue.+    ,("text-shadow",             \d _ _ -> d)+    ]+  where+    -- For properties that take two keywords as initial value, such as:+    -- * font-synthesis: weight style+    -- * text-emphasis-position: right over+    reduceTwoKeywordInitial :: Declaration -> Values -> Inheritance -> Declaration+    reduceTwoKeywordInitial d@(Declaration _ vs _ _) initVals inhs =+        case valuesToList initVals \\ valuesToList vs of+          [] -> d {valueList = shortestEquiv initial initVals inhs}+          _  -> d {valueList = shortestEquiv vs initVals inhs} +    -- For properties whose second value, if omitted, is copied from the first+    -- (for instance 'overflow').+    reduceDefaultingToFirst :: Declaration -> Values -> Inheritance -> Declaration+    reduceDefaultingToFirst d@(Declaration _ vs _ _) initVals inhs =+        case valuesToList vs of+          [v1,v2] -> if v1 == v2+                        then reduceDeclaration (d { valueList = mkValues [v1] }) initVals inhs+                        else d+          _       -> reduceDeclaration d initVals inhs++    backgroundSizeReduce :: Declaration -> Values -> Inheritance -> Declaration+    backgroundSizeReduce d@(Declaration _ vs _ _) initVals inhs =+        case valuesToList vs of+          [v1,v2] -> if v2 == mkOther "auto"+                        then d { valueList = mkValues [v1] }+                        else d+          _       -> d { valueList = shortestEquiv vs initVals inhs }+ combineTransformFunctions :: Declaration -> Reader Config Declaration combineTransformFunctions d@(Declaration _ vs _ _) = do     combinedFuncs <- combine (toList tfValues)     let newVals = fmap TransformV combinedFuncs ++ toList otherValues     pure $ d { valueList = mkValues newVals}-  where decValues               = valuesToList vs-        (tfValues, otherValues) = splitValues decValues-        splitValues = splitValues' (mempty, mempty)-          where splitValues' :: (Seq TransformFunction, Seq Value) -> [Value]-                             -> (Seq TransformFunction, Seq Value)-                splitValues' (ts, os) (TransformV x:xs) = splitValues' (ts |> x, os) xs-                splitValues' (ts, os) (x:xs)            = splitValues' (ts, os |> x) xs-                splitValues' (ts, os) []                = (ts, os)--backgroundSizeReduce :: Declaration -> Values -> Inheritance -> Declaration-backgroundSizeReduce d@(Declaration _ vs _ _) initVals inhs =-    case valuesToList vs of-      [v1,v2] -> if v2 == mkOther "auto"-                    then d { valueList = mkValues [v1] }-                    else d-      _       -> d { valueList = shortestEquiv vs initVals inhs }--fontSynthesisReduce :: Declaration -> Values -> Inheritance -> Declaration-fontSynthesisReduce d@(Declaration _ vs _ _) initVals inhs =-    case valuesToList initVals \\ valuesToList vs of-      [] -> d {valueList = initial} -- "initial" is shorter than "weight style"-      _  -> d {valueList = shortestEquiv vs initVals inhs}+  where+    decValues               = valuesToList vs+    (tfValues, otherValues) = splitValues decValues+    splitValues = splitValues' (mempty, mempty)+      where+        splitValues' :: (Seq TransformFunction, Seq Value) -> [Value]+                     -> (Seq TransformFunction, Seq Value)+        splitValues' (ts, os) (TransformV x:xs) = splitValues' (ts |> x, os) xs+        splitValues' (ts, os) (x:xs)            = splitValues' (ts, os |> x) xs+        splitValues' (ts, os) []                = (ts, os)  -- Function to reduce the great mayority of properties. Requires that: -- 1. The order between values doesn't matter, which is true for most --    properties because they take only one value.--- 2. Any default value may be removed, which tends to hold for shorthands---    because the default value is used when it isn't present. An example of a---    property that qualifies is border-bottom, and one that doesn't is---    font-synthesis (because it isn't a shorthand).+-- 2. Any default value may be removed until a single one remains, which tends+--    to hold for shorthands because the default value is used when it isn't+--    present. An example of a property that qualifies is border-bottom, and+--    one that doesn't is font-synthesis (because it isn't a shorthand). reduceDeclaration :: Declaration -> Values -> Inheritance -> Declaration reduceDeclaration d@(Declaration _ vs _ _) initVals inhs =     case analyzeValueDifference vs initVals of       Just v  -> d {valueList = shortestEquiv v shortestInitialValue inhs}       Nothing -> d {valueList = minVal inhs shortestInitialValue}-  where comparator x y = compare (textualLength x) (textualLength y)-        shortestInitialValue = mkValues [minimumBy comparator (valuesToList initVals)]+  where+    charLen x y = compare (textualLength x) (textualLength y)+    shortestInitialValue = mkValues [minimumBy charLen (valuesToList initVals)]  -- If the value was a css-wide keyword, return the shortest between css-wide -- keywords and the shortest initial value for the property. -- Otherwise, no property specific reduction could be done, so just return the -- values. shortestEquiv :: Values -> Values -> Inheritance -> Values-shortestEquiv vs siv inhs-    | inhs == Inherited && vs == inherit = unset-    | inhs == NonInherited && vs == unset || vs == initial = minVal inhs siv+shortestEquiv vs siv i+    | i == Inherited && vs == inherit = unset+    | i == NonInherited && vs == unset || vs == initial = minVal i siv     | otherwise = vs  -- Returns the minimum value (in character length) between the shortest initial@@ -392,10 +419,11 @@     | otherwise                                       = vs   where globalKeyword = mkValues [if inhs == NonInherited then Unset else Initial] --- Substract declaration values to the property's initial value list.--- If nothing remains (i.e. every value declared was an initial one and may be--- left implicit), then just replace it with whatever initial value is the--- shortest, otherwise whatever remains is the shortest equivalent declaration.+-- Substract the property's initial value list from the declaration values.+-- If nothing remains (i.e. every value declared was an initial one, thus all of+-- them could be left implicit), then just replace it with whatever initial+-- value is the shortest, otherwise whatever remains is the shortest equivalent+-- declaration. analyzeValueDifference :: Values -> Values -> Maybe Values analyzeValueDifference vs initVals =     case valuesDifference of

@@ -1,316 +1,316 @@-{-# LANGUAGE OverloadedStrings #-}
------------------------------------------------------------------------------
--- |
--- Module      : Hasmin.Types.Gradient
--- Copyright   : (c) 2017 Cristian Adrián Ontivero
--- License     : BSD3
--- Stability   : experimental
--- Portability : non-portable
---
------------------------------------------------------------------------------
-module Hasmin.Types.Gradient
-    ( Gradient(..)
-    , Side(..)
-    , ColorStop(..)
-    , Size(..)
-    , Shape(..)
-    ) where
-
-import Control.Monad.Reader (Reader, ask)
-import Data.Monoid ((<>))
-import Data.Text.Lazy.Builder (singleton)
-import Data.Maybe (catMaybes, fromJust, isNothing, isJust)
-import Data.Either (isLeft)
-
-import Hasmin.Class
-import Hasmin.Config
-import Hasmin.Types.Color
-import Hasmin.Types.Dimension
-import Hasmin.Types.Numeric
-import Hasmin.Types.PercentageLength
-import Hasmin.Types.Position
-import Hasmin.Utils
-
--- | CSS <side-or-corner> data type
-data Side = LeftSide | RightSide | TopSide | BottomSide
-  deriving (Show, Eq)
-instance ToText Side where
-  toBuilder LeftSide   = "left"
-  toBuilder RightSide  = "right"
-  toBuilder TopSide    = "top"
-  toBuilder BottomSide = "bottom"
-
--- Possible pair of values, as expected by linear-gradient()
-type SideOrCorner = (Side, Maybe Side)
-
--- | CSS <color-stop> data type
-data ColorStop = ColorStop { csColor   :: Color
-                           , colorHint :: Maybe PercentageLength
-                           } deriving (Show, Eq)
-instance ToText ColorStop where
-  toBuilder (ColorStop c mpl) = toBuilder c <> maybe mempty f mpl
-    where f (Left p)  = singleton ' ' <> toBuilder p
-          f (Right l) = singleton ' ' <> toBuilder l
-instance Minifiable ColorStop where
-  minify (ColorStop c mlp) = do
-    newC   <- minify c
-    newMlp <- (mapM . mapM) minify mlp
-    pure $ ColorStop newC newMlp
-
--- minifies color hints in a \<color-stops\> list
-minifyColorHints :: [ColorStop] -> [ColorStop]
-minifyColorHints [c1,c2] = [newC1, newC2]
-  where ch1 = colorHint c1
-        ch2 = colorHint c2
-        newC1
-            | isJust ch1 && isZero (fromJust ch1) = c1 {colorHint = Nothing}
-            | otherwise = c1
-        newC2
-            | ch2 == Just (Left (Percentage 100)) = c2 {colorHint = Nothing}
-            | ch2 `notGreaterThan` ch1 = c2 {colorHint = Just $ Right NullLength}
-            | otherwise                = c2
-minifyColorHints (c@(ColorStop a x):xs) = case x of
-                       Nothing -> c : analyzeList (Left $ Percentage 0) 1 (c:xs) xs
-                       Just y  -> if isZero y
-                                     then ColorStop a Nothing : analyzeList y 1 (c:xs) xs
-                                     else c: analyzeList y 1 (c:xs) xs
-minifyColorHints xs = error ("invalid <color-stop> list: " ++ show xs)
-
--- Returns True if the first value is equal or less than the second one, and False
--- otherwise, or if a comparison isn't possible.
-notGreaterThan :: Maybe PercentageLength -> Maybe PercentageLength -> Bool
-y `notGreaterThan` x
-    | isNothing x || isZero (fromJust x) = notPositive y
-    | otherwise = case fromJust x of
-                    Left p  -> maybe False (either (<= p) (const False)) y
-                    Right d -> maybe False (either (const False) (notGreaterThanLength d)) y
-  where notPositive  = maybe False (either (<= 0) notPositiveLength)
-
-        notPositiveLength (Length d _) = d <= 0
-        notPositiveLength NullLength   = True
-
-        notGreaterThanLength NullLength NullLength   = True
-        notGreaterThanLength NullLength (Length r _) = r <= 0
-        notGreaterThanLength (Length r _) NullLength = 0 <= r
-        notGreaterThanLength (Length r1 u1) (Length r2 u2)
-            | u1 == u2 = r2 <= r1
-            | isRelative u1 || isRelative u2 = False
-            | otherwise = toInches r2 u2 <= toInches r1 u1
-
--- Gathers at least three color stops to interpolate between the first and
--- last, and see if the middle one can be removed. As long as the color hints
--- are Nothing, keeps accumulating until it finds a Just it can use to interpolate.
-analyzeList :: PercentageLength -> Int -> [ColorStop]
-            -> [ColorStop] -> [ColorStop]
-analyzeList start n list (ColorStop _ mpl:xs)
-    | n < 2 = analyzeList start (n+1) list xs
-    | otherwise =
-        case mpl of
-          Just y  -> let (newList, remainingList, startVal) = minifySegment start y n list
-                     in newList ++ analyzeList startVal 2 remainingList xs
-          Nothing -> analyzeList start (n+1) list xs
-analyzeList start n list [] =
-    case mpl of
-      Just (Left (Percentage 100)) -> [ColorStop x Nothing]
-      Nothing  -> let end = Left $ Percentage 100
-                      (newList, _, _) = minifySegment start end (n-1) list
-                  in newList ++ [(last list) {colorHint = Nothing}]
-      _        -> [c]
-  where c@(ColorStop x mpl) = last list
-
--- Given two values and a count of values, uses them to create a list of
--- interpolated values, and based on the list decides if it should remove a
--- color hint or not.
-minifySegment :: PercentageLength -> PercentageLength -> Int -> [ColorStop]
-              -> ([ColorStop], [ColorStop], PercentageLength)
-minifySegment start end n list
-    | all isPercentage segment = handlePercentages (fromLeft' start) (fromLeft' end) n remainingList
-    -- add here support for dimension interpolation
-    | otherwise = (take (n-1) remainingList, remainingList, fromJust $ colorHint (head remainingList))
-  where segment = take (n+1) list
-        (_, remainingList) = splitAt (n-1) list
-        isPercentage x = maybe True isLeft (colorHint x)
-
--- Handles the minification of color hint values between percentages
-handlePercentages :: Percentage -> Percentage -> Int
-                  -> [ColorStop] -> ([ColorStop], [ColorStop], PercentageLength)
-handlePercentages start end n remainingList =
-    let newList = zipWith simplifyValue remainingList interpolation
-    in (newList, remainingList, Left newStartVal)
-  where newStartVal = maybe (last interpolation) fromLeft' (colorHint $ head remainingList)
-        step = (end - start) / toPercentage n
-        interpolation = [start + toPercentage x * step | x <- [1..n-1]]
-        simplifyValue (ColorStop x mpl) y = ColorStop x $ mpl >>= \v ->
-            if fromLeft' v == y
-               then Nothing
-               else if fromLeft' v <= start
-                       then Just $ Right NullLength
-                       else Just v
-
--- | CSS <https://drafts.csswg.org/css-images-3/#typedef-gradient \<gradient\>>
--- data type.
-data Gradient = OldLinearGradient (Maybe (Either Angle SideOrCorner)) [ColorStop]
-              -- OldLinearGradient is for the old syntax. It should eventually be deleted.
-              | LinearGradient (Maybe (Either Angle SideOrCorner)) [ColorStop]
-              | RadialGradient (Maybe Shape) (Maybe Size) (Maybe Position) [ColorStop]
-                -- TODO: replace with Maybe (These Shape Size)
-  deriving (Show)
-              -- ,| RepeatingLinearGradient
-              -- ,| RepeatingRadialGradient
-
-
-{-
-  radial-gradient() = radial-gradient(
-    [ <ending-shape> || <size> ]? [ at <position> ]? ,
-    <color-stop-list>
-  )
-
-  radial-gradient(
-    [ [ circle || <length> ]                         [ at <position> ]? , |
-      [ ellipse || [ <length> | <percentage> ]{2} ]  [ at <position> ]? , |
-      [ [ circle | ellipse ] || <extent-keyword> ]   [ at <position> ]? , |
-      at <position> ,
-    ]?
-    <color-stop> [ , <color-stop> ]+
-  )
-  where <extent-keyword> = closest-corner | closest-side | farthest-corner | farthest-side
-    and <color-stop>     = <color> [ <percentage> | <length> ]?
--}
-
--- | CSS <https://drafts.csswg.org/css-images-3/#typedef-size \<size\>> data
--- type, used by @radial-gradient()@.
-data Size = ClosestCorner
-          | ClosestSide
-          | FarthestCorner
-          | FarthestSide
-          | SL Length
-          | PL PercentageLength PercentageLength
-  deriving (Eq, Show)
-
-instance ToText Size where
-  toBuilder ClosestCorner  = "closest-corner"
-  toBuilder ClosestSide    = "closest-side"
-  toBuilder FarthestCorner = "farthest-corner"
-  toBuilder FarthestSide   = "farthest-side"
-  toBuilder (SL d)         = toBuilder d
-  toBuilder (PL pl1 pl2)   = toBuilder pl1 <> singleton ' ' <> toBuilder pl2
-
--- TODO rename to EndingShape
--- | CSS <https://drafts.csswg.org/css-images-3/#valdef-radial-gradient-ending-shape \<ending-shape\>> data type, used by @radial-gradient()@.
-data Shape = Circle | Ellipse
-  deriving (Eq, Show)
-
-instance ToText Shape where
-  toBuilder Circle  = "circle"
-  toBuilder Ellipse = "ellipse"
-
--- If the argument is to top, to right, to bottom, or to left, the angle of
--- the gradient line is 0deg, 90deg, 180deg, or 270deg, respectively.
-instance Minifiable Gradient where
-  minify g@(OldLinearGradient x cs) = do
-      conf <- ask
-      case gradientSettings conf of
-        GradientMinOn  -> do css  <- mapM minify cs
-                             pure $ OldLinearGradient x (minifyColorHints css)
-        GradientMinOff -> pure g
-  minify g@(LinearGradient x cs) = do
-      conf <- ask
-      case gradientSettings conf of
-        GradientMinOn  -> do css  <- mapM minify cs
-                             newX <- minifyAngleOrSide x
-                             pure $ LinearGradient newX (minifyColorHints css)
-        GradientMinOff -> pure g
-  minify g@(RadialGradient sh sz p cs) = do
-      conf <- ask
-      case gradientSettings conf of
-        GradientMinOn  -> do css  <- mapM minify cs
-                             let np = minifyRadialPosition True {-shouldMinifyPosition conf-} p
-                             pure $ minShapeAndSize sh sz np (minifyColorHints css)
-        GradientMinOff -> pure g
-
--- If a single length was used, the default shape is circle, otherwise ellipse.
--- circle farthest-corner == circle
--- ellipse farthest-corner == ellipse == farthest-corner
-minShapeAndSize :: Maybe Shape -> Maybe Size -> Maybe Position -> [ColorStop] -> Gradient
-minShapeAndSize (Just Circle) sz@(Just (SL _))       = RadialGradient Nothing sz
-minShapeAndSize (Just Circle) (Just FarthestCorner)  = RadialGradient (Just Circle) Nothing
-minShapeAndSize (Just Ellipse) sz@(Just (PL _ _))    = RadialGradient Nothing sz
-minShapeAndSize (Just Ellipse) (Just FarthestCorner) = RadialGradient Nothing Nothing
-minShapeAndSize (Just Ellipse) sz@(Just _)           = RadialGradient Nothing sz
-minShapeAndSize (Just Ellipse) Nothing               = RadialGradient Nothing Nothing
-minShapeAndSize Nothing (Just FarthestCorner)        = RadialGradient Nothing Nothing
-minShapeAndSize x sz                                 = RadialGradient x sz
-
--- Minifies the position in the radial gradient based on the position
--- minification settings. If positions should be minified, and if it is
--- equivalent to 'center', it is removed. If positions should not be minified,
--- it still removes it if it is equivalent to 'center', but leaves it untouched
--- otherwise.
-minifyRadialPosition :: Bool -> Maybe Position -> Maybe Position
-minifyRadialPosition _ Nothing = Nothing
-minifyRadialPosition cond (Just p)
-    | minifiedPos == centerPos = Nothing
-    | cond                     = Just minifiedPos
-    | otherwise                = Just p
-  where centerPos = Position Nothing p50 Nothing Nothing
-        minifiedPos = minifyPosition p
-
-minifyAngleOrSide :: Maybe (Either Angle SideOrCorner)
-                  -> Reader Config (Maybe (Either Angle SideOrCorner))
-minifyAngleOrSide Nothing  = pure Nothing
-minifyAngleOrSide (Just (Left a))
-    | a == defaultGradientAngle = pure Nothing
-    | otherwise                 = (Just . Left) <$> minify a
-  where defaultGradientAngle = Angle 180 Deg
-minifyAngleOrSide (Just (Right b))
-    | b == defaultGradientSideOrCorner = pure Nothing
-    | otherwise                        = pure $ Just (minifySide b)
-  where defaultGradientSideOrCorner      = (BottomSide, Nothing)
-        minifySide (TopSide, Nothing)    = Left NullAngle
-        minifySide (RightSide, Nothing)  = Left (Angle 90 Deg)
-        minifySide (BottomSide, Nothing) = Left (Angle 180 Deg)
-        minifySide (LeftSide, Nothing)   = Left (Angle 270 Deg)
-        minifySide z                     = Right z
-
-instance ToText Gradient where
-  toBuilder (OldLinearGradient mas csl) = maybe mempty f mas
-      <> mconcatIntersperse id (singleton ',') (fmap toBuilder csl)
-    where f         = either ((<> singleton ',') . toBuilder) g
-          g (s, ms) = toBuilder s
-                   <> maybe mempty (\x -> singleton ' ' <> toBuilder x) ms
-                   <> singleton ','
-  toBuilder (LinearGradient mas csl) = maybe mempty f mas
-      <> mconcatIntersperse id (singleton ',') (fmap toBuilder csl)
-    where f         = either ((<> singleton ',') . toBuilder) g
-          g (s, ms) = "to " <> toBuilder s
-                   <> maybe mempty (\x -> singleton ' ' <> toBuilder x) ms
-                   <> singleton ','
-  toBuilder (RadialGradient sh sz p cs) = firstPart
-      <> mconcatIntersperse id (singleton ',') (fmap toBuilder cs)
-    where l = catMaybes [fmap toBuilder sh, fmap toBuilder sz, fmap (\x -> "at " <> toBuilder x) p]
-          firstPart
-              | null l    = mempty
-              | otherwise = mconcatIntersperse id (singleton ' ') l <> singleton ','
-
-instance Eq Gradient where
-  LinearGradient x1 csl1 == LinearGradient x2 csl2 =
-      handleMaybe x1 x2 && csl1 == csl2
-    where handleMaybe Nothing Nothing      = True
-          handleMaybe (Just x) (Just y)    = handleEither x y
-          handleMaybe _ _                  = False
-          handleEither (Left a1) (Left a2) = a1 == a2
-          handleEither (Left a) (Right s)  = angleSideEq a s
-          handleEither (Right s) (Left a)  = angleSideEq a s
-          handleEither s1 s2               = s1 == s2
-  LinearGradient{} == _ = False
-  _ == LinearGradient{} = False
-  _ == _ = False -- TODO implement other comparisons
-
-angleSideEq :: Angle -> SideOrCorner -> Bool
-angleSideEq (Angle 90 Deg) (RightSide, Nothing)   = True
-angleSideEq (Angle 180 Deg) (BottomSide, Nothing) = True
-angleSideEq (Angle 270 Deg) (LeftSide, Nothing)   = True
-angleSideEq a (TopSide, Nothing)
-    | isZeroAngle a = True
-    | otherwise     = False
-angleSideEq _ _                                   = False
+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Types.Gradient+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : non-portable+--+-----------------------------------------------------------------------------+module Hasmin.Types.Gradient+    ( Gradient(..)+    , Side(..)+    , ColorStop(..)+    , Size(..)+    , Shape(..)+    ) where++import Control.Monad.Reader (Reader, ask)+import Data.Monoid ((<>))+import Data.Text.Lazy.Builder (singleton)+import Data.Maybe (catMaybes, fromJust, isNothing, isJust)+import Data.Either (isLeft)++import Hasmin.Class+import Hasmin.Config+import Hasmin.Types.Color+import Hasmin.Types.Dimension+import Hasmin.Types.Numeric+import Hasmin.Types.PercentageLength+import Hasmin.Types.Position+import Hasmin.Utils++-- | CSS <side-or-corner> data type+data Side = LeftSide | RightSide | TopSide | BottomSide+  deriving (Show, Eq)+instance ToText Side where+  toBuilder LeftSide   = "left"+  toBuilder RightSide  = "right"+  toBuilder TopSide    = "top"+  toBuilder BottomSide = "bottom"++-- Possible pair of values, as expected by linear-gradient()+type SideOrCorner = (Side, Maybe Side)++-- | CSS <color-stop> data type+data ColorStop = ColorStop { csColor   :: Color+                           , colorHint :: Maybe PercentageLength+                           } deriving (Show, Eq)+instance ToText ColorStop where+  toBuilder (ColorStop c mpl) = toBuilder c <> maybe mempty f mpl+    where f (Left p)  = singleton ' ' <> toBuilder p+          f (Right l) = singleton ' ' <> toBuilder l+instance Minifiable ColorStop where+  minify (ColorStop c mlp) = do+    newC   <- minify c+    newMlp <- (mapM . mapM) minify mlp+    pure $ ColorStop newC newMlp++-- minifies color hints in a \<color-stops\> list+minifyColorHints :: [ColorStop] -> [ColorStop]+minifyColorHints [c1,c2] = [newC1, newC2]+  where ch1 = colorHint c1+        ch2 = colorHint c2+        newC1+            | isJust ch1 && isZero (fromJust ch1) = c1 {colorHint = Nothing}+            | otherwise = c1+        newC2+            | ch2 == Just (Left (Percentage 100)) = c2 {colorHint = Nothing}+            | ch2 `notGreaterThan` ch1 = c2 {colorHint = Just $ Right NullLength}+            | otherwise                = c2+minifyColorHints (c@(ColorStop a x):xs) = case x of+                       Nothing -> c : analyzeList (Left $ Percentage 0) 1 (c:xs) xs+                       Just y  -> if isZero y+                                     then ColorStop a Nothing : analyzeList y 1 (c:xs) xs+                                     else c: analyzeList y 1 (c:xs) xs+minifyColorHints xs = error ("invalid <color-stop> list: " ++ show xs)++-- Returns True if the first value is equal or less than the second one, and False+-- otherwise, or if a comparison isn't possible.+notGreaterThan :: Maybe PercentageLength -> Maybe PercentageLength -> Bool+y `notGreaterThan` x+    | isNothing x || isZero (fromJust x) = notPositive y+    | otherwise = case fromJust x of+                    Left p  -> maybe False (either (<= p) (const False)) y+                    Right d -> maybe False (either (const False) (notGreaterThanLength d)) y+  where notPositive  = maybe False (either (<= 0) notPositiveLength)++        notPositiveLength (Length d _) = d <= 0+        notPositiveLength NullLength   = True++        notGreaterThanLength NullLength NullLength   = True+        notGreaterThanLength NullLength (Length r _) = r <= 0+        notGreaterThanLength (Length r _) NullLength = 0 <= r+        notGreaterThanLength (Length r1 u1) (Length r2 u2)+            | u1 == u2 = r2 <= r1+            | isRelative u1 || isRelative u2 = False+            | otherwise = toInches r2 u2 <= toInches r1 u1++-- Gathers at least three color stops to interpolate between the first and+-- last, and see if the middle one can be removed. As long as the color hints+-- are Nothing, keeps accumulating until it finds a Just it can use to interpolate.+analyzeList :: PercentageLength -> Int -> [ColorStop]+            -> [ColorStop] -> [ColorStop]+analyzeList start n list (ColorStop _ mpl:xs)+    | n < 2 = analyzeList start (n+1) list xs+    | otherwise =+        case mpl of+          Just y  -> let (newList, remainingList, startVal) = minifySegment start y n list+                     in newList ++ analyzeList startVal 2 remainingList xs+          Nothing -> analyzeList start (n+1) list xs+analyzeList start n list [] =+    case mpl of+      Just (Left (Percentage 100)) -> [ColorStop x Nothing]+      Nothing  -> let end = Left $ Percentage 100+                      (newList, _, _) = minifySegment start end (n-1) list+                  in newList ++ [(last list) {colorHint = Nothing}]+      _        -> [c]+  where c@(ColorStop x mpl) = last list++-- Given two values and a count of values, uses them to create a list of+-- interpolated values, and based on the list decides if it should remove a+-- color hint or not.+minifySegment :: PercentageLength -> PercentageLength -> Int -> [ColorStop]+              -> ([ColorStop], [ColorStop], PercentageLength)+minifySegment start end n list+    | all isPercentage segment = handlePercentages (fromLeft' start) (fromLeft' end) n remainingList+    -- add here support for dimension interpolation+    | otherwise = (take (n-1) remainingList, remainingList, fromJust $ colorHint (head remainingList))+  where segment = take (n+1) list+        (_, remainingList) = splitAt (n-1) list+        isPercentage x = maybe True isLeft (colorHint x)++-- Handles the minification of color hint values between percentages+handlePercentages :: Percentage -> Percentage -> Int+                  -> [ColorStop] -> ([ColorStop], [ColorStop], PercentageLength)+handlePercentages start end n remainingList =+    let newList = zipWith simplifyValue remainingList interpolation+    in (newList, remainingList, Left newStartVal)+  where newStartVal = maybe (last interpolation) fromLeft' (colorHint $ head remainingList)+        step = (end - start) / toPercentage n+        interpolation = [start + toPercentage x * step | x <- [1..n-1]]+        simplifyValue (ColorStop x mpl) y = ColorStop x $ mpl >>= \v ->+            if fromLeft' v == y+               then Nothing+               else if fromLeft' v <= start+                       then Just $ Right NullLength+                       else Just v++-- | CSS <https://drafts.csswg.org/css-images-3/#typedef-gradient \<gradient\>>+-- data type.+data Gradient = OldLinearGradient (Maybe (Either Angle SideOrCorner)) [ColorStop]+              -- OldLinearGradient is for the old syntax. It should eventually be deleted.+              | LinearGradient (Maybe (Either Angle SideOrCorner)) [ColorStop]+              | RadialGradient (Maybe Shape) (Maybe Size) (Maybe Position) [ColorStop]+                -- TODO: replace with Maybe (These Shape Size)+  deriving (Show)+              -- ,| RepeatingLinearGradient+              -- ,| RepeatingRadialGradient+++{-+  radial-gradient() = radial-gradient(+    [ <ending-shape> || <size> ]? [ at <position> ]? ,+    <color-stop-list>+  )++  radial-gradient(+    [ [ circle || <length> ]                         [ at <position> ]? , |+      [ ellipse || [ <length> | <percentage> ]{2} ]  [ at <position> ]? , |+      [ [ circle | ellipse ] || <extent-keyword> ]   [ at <position> ]? , |+      at <position> ,+    ]?+    <color-stop> [ , <color-stop> ]++  )+  where <extent-keyword> = closest-corner | closest-side | farthest-corner | farthest-side+    and <color-stop>     = <color> [ <percentage> | <length> ]?+-}++-- | CSS <https://drafts.csswg.org/css-images-3/#typedef-size \<size\>> data+-- type, used by @radial-gradient()@.+data Size = ClosestCorner+          | ClosestSide+          | FarthestCorner+          | FarthestSide+          | SL Length+          | PL PercentageLength PercentageLength+  deriving (Eq, Show)++instance ToText Size where+  toBuilder ClosestCorner  = "closest-corner"+  toBuilder ClosestSide    = "closest-side"+  toBuilder FarthestCorner = "farthest-corner"+  toBuilder FarthestSide   = "farthest-side"+  toBuilder (SL d)         = toBuilder d+  toBuilder (PL pl1 pl2)   = toBuilder pl1 <> singleton ' ' <> toBuilder pl2++-- TODO rename to EndingShape+-- | CSS <https://drafts.csswg.org/css-images-3/#valdef-radial-gradient-ending-shape \<ending-shape\>> data type, used by @radial-gradient()@.+data Shape = Circle | Ellipse+  deriving (Eq, Show)++instance ToText Shape where+  toBuilder Circle  = "circle"+  toBuilder Ellipse = "ellipse"++-- If the argument is to top, to right, to bottom, or to left, the angle of+-- the gradient line is 0deg, 90deg, 180deg, or 270deg, respectively.+instance Minifiable Gradient where+  minify g@(OldLinearGradient x cs) = do+      conf <- ask+      case gradientSettings conf of+        GradientMinOn  -> do css  <- mapM minify cs+                             pure $ OldLinearGradient x (minifyColorHints css)+        GradientMinOff -> pure g+  minify g@(LinearGradient x cs) = do+      conf <- ask+      case gradientSettings conf of+        GradientMinOn  -> do css  <- mapM minify cs+                             newX <- minifyAngleOrSide x+                             pure $ LinearGradient newX (minifyColorHints css)+        GradientMinOff -> pure g+  minify g@(RadialGradient sh sz p cs) = do+      conf <- ask+      case gradientSettings conf of+        GradientMinOn  -> do css  <- mapM minify cs+                             let np = minifyRadialPosition True {-shouldMinifyPosition conf-} p+                             pure $ minShapeAndSize sh sz np (minifyColorHints css)+        GradientMinOff -> pure g++-- If a single length was used, the default shape is circle, otherwise ellipse.+-- circle farthest-corner == circle+-- ellipse farthest-corner == ellipse == farthest-corner+minShapeAndSize :: Maybe Shape -> Maybe Size -> Maybe Position -> [ColorStop] -> Gradient+minShapeAndSize (Just Circle) sz@(Just (SL _))       = RadialGradient Nothing sz+minShapeAndSize (Just Circle) (Just FarthestCorner)  = RadialGradient (Just Circle) Nothing+minShapeAndSize (Just Ellipse) sz@(Just (PL _ _))    = RadialGradient Nothing sz+minShapeAndSize (Just Ellipse) (Just FarthestCorner) = RadialGradient Nothing Nothing+minShapeAndSize (Just Ellipse) sz@(Just _)           = RadialGradient Nothing sz+minShapeAndSize (Just Ellipse) Nothing               = RadialGradient Nothing Nothing+minShapeAndSize Nothing (Just FarthestCorner)        = RadialGradient Nothing Nothing+minShapeAndSize x sz                                 = RadialGradient x sz++-- Minifies the position in the radial gradient based on the position+-- minification settings. If positions should be minified, and if it is+-- equivalent to 'center', it is removed. If positions should not be minified,+-- it still removes it if it is equivalent to 'center', but leaves it untouched+-- otherwise.+minifyRadialPosition :: Bool -> Maybe Position -> Maybe Position+minifyRadialPosition _ Nothing = Nothing+minifyRadialPosition cond (Just p)+    | minifiedPos == centerPos = Nothing+    | cond                     = Just minifiedPos+    | otherwise                = Just p+  where centerPos = Position Nothing p50 Nothing Nothing+        minifiedPos = minifyPosition p++minifyAngleOrSide :: Maybe (Either Angle SideOrCorner)+                  -> Reader Config (Maybe (Either Angle SideOrCorner))+minifyAngleOrSide Nothing  = pure Nothing+minifyAngleOrSide (Just (Left a))+    | a == defaultGradientAngle = pure Nothing+    | otherwise                 = (Just . Left) <$> minify a+  where defaultGradientAngle = Angle 180 Deg+minifyAngleOrSide (Just (Right b))+    | b == defaultGradientSideOrCorner = pure Nothing+    | otherwise                        = pure $ Just (minifySide b)+  where defaultGradientSideOrCorner      = (BottomSide, Nothing)+        minifySide (TopSide, Nothing)    = Left NullAngle+        minifySide (RightSide, Nothing)  = Left (Angle 90 Deg)+        minifySide (BottomSide, Nothing) = Left (Angle 180 Deg)+        minifySide (LeftSide, Nothing)   = Left (Angle 270 Deg)+        minifySide z                     = Right z++instance ToText Gradient where+  toBuilder (OldLinearGradient mas csl) = maybe mempty f mas+      <> mconcatIntersperse id (singleton ',') (fmap toBuilder csl)+    where f         = either ((<> singleton ',') . toBuilder) g+          g (s, ms) = toBuilder s+                   <> maybe mempty (\x -> singleton ' ' <> toBuilder x) ms+                   <> singleton ','+  toBuilder (LinearGradient mas csl) = maybe mempty f mas+      <> mconcatIntersperse id (singleton ',') (fmap toBuilder csl)+    where f         = either ((<> singleton ',') . toBuilder) g+          g (s, ms) = "to " <> toBuilder s+                   <> maybe mempty (\x -> singleton ' ' <> toBuilder x) ms+                   <> singleton ','+  toBuilder (RadialGradient sh sz p cs) = firstPart+      <> mconcatIntersperse id (singleton ',') (fmap toBuilder cs)+    where l = catMaybes [fmap toBuilder sh, fmap toBuilder sz, fmap (\x -> "at " <> toBuilder x) p]+          firstPart+              | null l    = mempty+              | otherwise = mconcatIntersperse id (singleton ' ') l <> singleton ','++instance Eq Gradient where+  LinearGradient x1 csl1 == LinearGradient x2 csl2 =+      handleMaybe x1 x2 && csl1 == csl2+    where handleMaybe Nothing Nothing      = True+          handleMaybe (Just x) (Just y)    = handleEither x y+          handleMaybe _ _                  = False+          handleEither (Left a1) (Left a2) = a1 == a2+          handleEither (Left a) (Right s)  = angleSideEq a s+          handleEither (Right s) (Left a)  = angleSideEq a s+          handleEither s1 s2               = s1 == s2+  LinearGradient{} == _ = False+  _ == LinearGradient{} = False+  _ == _ = False -- TODO implement other comparisons++angleSideEq :: Angle -> SideOrCorner -> Bool+angleSideEq (Angle 90 Deg) (RightSide, Nothing)   = True+angleSideEq (Angle 180 Deg) (BottomSide, Nothing) = True+angleSideEq (Angle 270 Deg) (LeftSide, Nothing)   = True+angleSideEq a (TopSide, Nothing)+    | isZeroAngle a = True+    | otherwise     = False+angleSideEq _ _                                   = False

@@ -1,550 +1,550 @@-{-# LANGUAGE OverloadedStrings #-}
------------------------------------------------------------------------------
--- |
--- Module      : Hasmin.Types.TransformFunction
--- Copyright   : (c) 2017 Cristian Adrián Ontivero
--- License     : BSD3
--- Stability   : experimental
--- Portability : non-portable
---
------------------------------------------------------------------------------
-module Hasmin.Types.TransformFunction
-    ( TransformFunction(..)
-    , mkMat
-    , mkMat3d
-    , combine
-    , simplify
-    ) where
-
-import Control.Monad.Reader (mapReader, Reader, ask, local)
-import Control.Applicative (liftA2)
-import Data.Monoid ((<>))
-import Data.Either (isRight)
-import qualified Data.Text as T
-import Data.Number.FixedFunctions (tan, atan)
-import Prelude hiding (sin, cos, acos, tan, atan)
-import qualified Data.Matrix as M
-import Data.Matrix (Matrix)
-import Data.List (groupBy)
-import Data.Maybe (fromMaybe, isNothing, isJust, fromJust)
-import Data.Text.Lazy.Builder (toLazyText, singleton, Builder)
-import Data.Text.Lazy (toStrict)
-
-import Hasmin.Config
-import Hasmin.Class
-import Hasmin.Utils
-import Hasmin.Types.Dimension
-import Hasmin.Types.PercentageLength
-import Hasmin.Types.Numeric
-
--- Note: In a previous specification, translate3d() took two
--- <https://www.w3.org/TR/css-transforms-1/#typedef-translation-value \<translation-value\>>,
--- however in the <https://drafts.csswg.org/css-transforms/ latest draft>, it
--- takes two \<length-percentage\> (which makes sense since translateX() and
--- translateY() also do).
-
--- | CSS <https://drafts.csswg.org/css-transforms/#typedef-transform-function \<transform-function\>>
--- data type.
-data TransformFunction = Mat (Matrix Number)
-                       | Mat3d (Matrix Number)
-                       | Perspective Length
-                       | Rotate Angle
-                       | RotateX Angle
-                       | RotateY Angle
-                       | RotateZ Angle
-                       | Rotate3d Number Number Number Angle
-                       | Scale Number (Maybe Number)
-                       | ScaleX Number
-                       | ScaleY Number
-                       | ScaleZ Number
-                       | Scale3d Number Number Number
-                       | Skew Angle (Maybe Angle)
-                       | SkewX Angle
-                       | SkewY Angle
-                       | Translate PercentageLength (Maybe PercentageLength)
-                       | TranslateX PercentageLength
-                       | TranslateY PercentageLength
-                       | TranslateZ Length
-                       | Translate3d PercentageLength PercentageLength Length
-  deriving (Eq, Show)
-
--- There are a series of equivalences to keep in mind: translate(0),
--- translate3d(0, 0, 0), translateX(0), translateY(0), translateZ(0), scale(1),
--- scaleX(1), scaleY(1), scaleZ(1), rotate(0), rotate3d(1,1,1,0), rotateX(0),
--- rotateY(0), rotateZ(0), perspective(infinity), matrix(1,0,0,1,0,0),
--- matrix3d(1,0,0,0,0,1,0,0,0,0,1,0,0,0,0,1), skewX(0), skewY(0), and the
--- shortest of them all: skew(0)
--- All of these translate to the 4x4 identity matrix.
-instance Minifiable TransformFunction where
-  minify (Mat3d m) = do
-      conf <- ask
-      if shouldMinifyTransformFunction conf
-         then case possibleRepresentations m of
-                []     -> pure (Mat3d m)
-                (x:xs) -> let simplifyAndConvertUnits a = local (const $ conf { dimensionSettings = DimMinOn }) (simplify a)
-                          in go simplifyAndConvertUnits x xs
-         else pure (Mat3d m)
-    where go f y []     = f y
-          go f y (z:zs) = do
-              currentLength <- textualLength <$> f y
-              newLength     <- textualLength <$> f z
-              if currentLength < newLength
-                 then go f y zs
-                 else go f z zs
-  minify x = do
-      conf <- ask
-      if shouldMinifyTransformFunction conf
-         then case toMatrix3d x of
-                Just mat3d -> minify mat3d
-                Nothing    -> simplify x
-         else simplify x
-
-{-
-s = SkewX (Angle 45 Deg)
-tx = TranslateX (Right $ Length (-6) PX)
-ry = RotateY (Angle (-9) Deg)
-ry2 = Rotate3d 0 (-1) 0 (Angle 9 Deg)
-t = TranslateZ (Length 100 PX)
-t2 = Translate (Right (Length 100 PX)) Nothing
-tr = Rotate3d 0 0 1 (Angle 90 Deg)
-tr1 = Rotate3d 0 0 1 (Angle 45 Deg)
-g x = runReader x defaultConfig
--}
-
-instance ToText TransformFunction where
-  toBuilder (Translate pl mpl)   = "translate("
-      <> toBuilder pl <> maybeWithComma mpl <> singleton ')'
-  toBuilder (TranslateX pl)      = "translatex("
-      <> either toBuilder toBuilder pl <> singleton ')'
-  toBuilder (TranslateY pl)      = "translatey(" <> either toBuilder toBuilder pl <> singleton ')'
-  toBuilder (TranslateZ d)       = "translatez(" <> toBuilder d <> singleton ')'
-  toBuilder (Scale n mn)         = "scale(" <> toBuilder n <> maybeWithComma mn <> singleton ')'
-  toBuilder (ScaleX n)           = "scalex(" <> toBuilder n <> singleton ')'
-  toBuilder (ScaleY n)           = "scaley(" <> toBuilder n <> singleton ')'
-  toBuilder (ScaleZ n)           = "scalez(" <> toBuilder n <> singleton ')'
-  toBuilder (Skew a ma)          = "skew(" <> toBuilder a <> maybeWithComma ma <> singleton ')'
-  toBuilder (SkewX a)            = "skewx(" <> toBuilder a <> singleton ')'
-  toBuilder (SkewY a)            = "skewy(" <> toBuilder a <> singleton ')'
-  toBuilder (Rotate a)           = "rotate(" <> toBuilder a <> singleton ')'
-  toBuilder (RotateX a)          = "rotatex(" <> toBuilder a <> singleton ')'
-  toBuilder (RotateY a)          = "rotatey(" <> toBuilder a <> singleton ')'
-  toBuilder (RotateZ a)          = "rotatez(" <> toBuilder a <> singleton ')'
-  toBuilder (Rotate3d x y z a)   = "rotate3d(" <> toBuilder x <> singleton ','
-      <> toBuilder y <> singleton ',' <> toBuilder z <> singleton ','
-      <> toBuilder a <> singleton ')'
-  toBuilder (Scale3d x y z)      = "scale3d(" <> toBuilder x <> singleton ','
-      <> toBuilder y <> singleton ',' <> toBuilder z <> singleton ')'
-  toBuilder (Perspective d)      = "perspective(" <> toBuilder d <> singleton ')'
-  toBuilder (Translate3d x y z ) = "translate3d(" <> toBuilder x <> singleton ','
-      <> toBuilder y <> singleton ',' <> toBuilder z <> singleton ')'
-  toBuilder (Mat m)              = "matrix("
-      <> mconcatIntersperse toBuilder (singleton ',') (M.toList m) <> singleton ')'
-  toBuilder (Mat3d m)            = "matrix3d("
-      <> mconcatIntersperse toBuilder (singleton ',') (M.toList m) <> singleton ')'
-
-maybeWithComma :: ToText a => Maybe a -> Builder
-maybeWithComma = maybe mempty (\x -> singleton ',' <> toBuilder x)
-
-mkMat :: [Number] -> TransformFunction
-mkMat = Mat . M.fromList 3 2
-
-mkMat3d :: [Number] -> TransformFunction
-mkMat3d = Mat3d . M.fromList 4 4
-
-toMatrix3d :: TransformFunction -> Maybe TransformFunction
-toMatrix3d m@Mat3d{} = Just m
-toMatrix3d (Mat x)   = Just $ toMat3d (M.toList x)
-  where toMat3d [a,b,c,d,e,f] = mkMat3d [a, c, 0, e,
-                                         b, d, 0, f,
-                                         0, 0, 1, 0,
-                                         0, 0, 0, 1]
-        toMat3d _ = error "invalid matrix size!"
-toMatrix3d (Translate pl mpl)
-    | isNonZeroPercentage pl = Nothing
-    | isJust mpl && isNonZeroPercentage (fromJust mpl) = Nothing
-    | otherwise = Just . Mat3d $ mkTranslate3dMatrix x y 0
-  where x = either (const 0) fromPixelsToNum pl
-        y = maybe 0 (fromPixelsToNum . fromRight') mpl
-toMatrix3d (TranslateX pl)
-    | isNonZeroPercentage pl = Nothing
-    | isRight pl && isRelativeLength (fromRight' pl) = Nothing
-    | otherwise = Just . Mat3d $ mkTranslate3dMatrix x 0 0
-  where x = either (const 0) fromPixelsToNum pl
-toMatrix3d (TranslateY pl)
-    | isNonZeroPercentage pl = Nothing
-    | isRight pl && isRelativeLength (fromRight' pl) = Nothing
-    | otherwise = Just . Mat3d $ mkTranslate3dMatrix 0 y 0
-  where y = either (const 0) fromPixelsToNum pl
-toMatrix3d (TranslateZ d)
-    | isRelativeLength d  = Nothing
-    | otherwise = Just . Mat3d $ mkTranslate3dMatrix 0 0 z
-  where z = fromPixelsToNum d
-toMatrix3d (Scale n mn) = Just . Mat3d $ mkScale3dMatrix n y 1
-  where y = fromMaybe n mn
-toMatrix3d (ScaleX n) = Just . Mat3d $ mkScale3dMatrix n 1 1
-toMatrix3d (ScaleY n) = Just . Mat3d $ mkScale3dMatrix 1 n 1
-toMatrix3d (ScaleZ n) = Just . Mat3d $ mkScale3dMatrix 1 1 n
-toMatrix3d (Skew a ma) = Just . Mat3d $ mkSkewMatrix α β
-  where α = tangent a
-        β = maybe 0 tangent ma
-toMatrix3d (SkewX a) = Just . Mat3d $ mkSkewMatrix (tangent a) 0
-toMatrix3d (SkewY a) = Just . Mat3d $ mkSkewMatrix 0 (tangent a)
-toMatrix3d (Translate3d pl1 pl2 d)
-    | isNonZeroPercentage pl1 || isNonZeroPercentage pl2 = Nothing
-    | isRight pl1 && isRelativeLength (fromRight' pl1) = Nothing
-    | isRight pl2 && isRelativeLength (fromRight' pl2) = Nothing
-    | isRelativeLength d = Nothing
-    | otherwise = let x = either (const 0) fromPixelsToNum pl1
-                      y = either (const 0) fromPixelsToNum pl2
-                      z = fromPixelsToNum d
-                  in Just . Mat3d $ mkTranslate3dMatrix x y z
-toMatrix3d (Scale3d x y z) = Just . Mat3d $ mkScale3dMatrix x y z
-toMatrix3d (Perspective d)
-    | isZeroLen d = Nothing
-    | otherwise   = let c = fromPixelsToNum d
-                    in Just . Mat3d $ mkPerspectiveMatrix c
--- Note: The commented code is fine, but until we implement the
--- function that converts a matrix back to a rotate function, uncommenting this
--- breaks the minification, e.g. it says that:
--- minify rotate(90deg) == matrix(0,1,-1,0,0,0)
-{-
-toMatrix3d (Rotate a) = Just $ rotateIn3d (0,0,1) (fromRadiansToNum a)
-toMatrix3d (Rotate3d x y z a) = Just $ rotateIn3d (x,y,z) (fromRadiansToNum a)
-toMatrix3d (RotateX a) = Just $ rotateIn3d (1,0,0) (fromRadiansToNum a)
-toMatrix3d (RotateY a) = Just $ rotateIn3d (0,1,0) (fromRadiansToNum a)
-toMatrix3d (RotateZ a) = Just $ rotateIn3d (0,0,1) (fromRadiansToNum a)
--}
-toMatrix3d _ = Nothing
-
--- Used for the rotate3d(), rotate(), ..., functions. Given an [x,y,z] vector
--- and an angle, create its corresponding rotation matrix.
-{-
-rotateIn3d :: (Number, Number, Number) -> Number -> TransformFunction
-rotateIn3d (b,c,d) a = mkMat3d $ fmap toNumber
-    [1-2*(y^2 + z^2)*sq, 2*(x*y*sq - z*sc),  2*(x*z*sq + y*sc),  0,
-     2*(x*y*sq + z*sc),  1-2*(x^2 + z^2)*sq, 2*(y*z*sq - x*sc),  0,
-     2*(x*z*sq - y*sc),  2*(y*z*sq + x*sc),  1-2*(x^2 + y^2)*sq, 0,
-     0,                  0,                  0,                  1]
-  where sc = sin epsilon (α/2) * cos epsilon (α/2)  :: Rational
-        sq = sin epsilon (α/2) ^ 2 :: Rational
-        x  = toRational b
-        y  = toRational c
-        z  = toRational d
-        α  = toRational a
--}
-
--- Code translated from: http://www.euclideanspace.com/maths/geometry/rotations/conversions/matrixToAngle/
--- TODO: see how to get different representations, so that negative values are
--- still properly handled, i.e. make things such as rotateY(-9deg) work.
-matrixToRotate3d :: Matrix Number -> [TransformFunction]
-matrixToRotate3d _ = []
-{-
-    -- if it has translation values, then we can't convert it to a rotation function
-    | M.unsafeGet 3 4 m /= 0 || M.unsafeGet 2 4 m /= 0 || M.unsafeGet 1 4 m /= 0 = []
-    -- | not isRotationMatrix = []
-    | abs (m12 - m21) < ep && abs (m13 - m31) < ep
-                           && abs (m23 - m32) < ep = [handleSingularity]
-    | otherwise = let a = arccos $ (m11 + m22 + m33 - 1)/2
-                      qx = (m32 - m23)/(2 * sine a)
-                      qy = (m13 - m31)/(2 * sine a)
-                      qz = (m21 - m12)/(2 * sine a)
-                  in [Rotate3d qx qy qz (Angle a Rad)]
-  where m11 = M.unsafeGet 1 1 m
-        m22 = M.unsafeGet 2 2 m
-        m33 = M.unsafeGet 3 3 m
-        m32 = M.unsafeGet 3 2 m
-        m23 = M.unsafeGet 2 3 m
-        m13 = M.unsafeGet 1 3 m
-        m31 = M.unsafeGet 3 1 m
-        m21 = M.unsafeGet 2 1 m
-        m12 = M.unsafeGet 1 2 m
-        ep = 0.01 -- margin to allow for rounding errors
-        ep2 = 0.1
--- Make sure that the input is a pure rotation matrix.
--- The condition for this is:
--- R' * R = I, and det(R) = 1
-        isRotationMatrix
-            |    abs (m11*m12 + m12*m22 + m13*m23) > ep
-              || abs (m11*m31 + m12*m32 + m13*m33) > ep
-              || abs (m21*m31 + m22*m32 + m23*m33) > ep
-              || abs (m11*m11 + m12*m12 + m13*m13 - 1) > ep
-              || abs (m21*m21 + m22*m11 + m23*m23 - 1) > ep
-              || abs (m31*m31 + m32*m32 + m33*m33 - 1) > ep = False
-            | otherwise = abs (detLU m - 1) < ep
-        handleSingularity
-            |    abs (m12 + m21) < ep2
-              && abs (m13 + m31) < ep2
-              && abs (m23 - m32) < ep2
-              && abs (m11 + m22 + m33 - 3) < ep2 = Rotate3d 1 0 0 NullAngle
-            | otherwise = let xx = (m11+1)/2
-                              yy = (m22+1)/2
-                              zz = (m33+1)/2
-                              xy = (m12 + m21)/4
-                              xz = (m13 + m31)/4
-                              yz = (m23 + m32)/4
-                          in handle180Singularity xx yy zz xy xz yz
-          where handle180Singularity xx yy zz xy xz yz
-                    | xx > yy && xx > zz = if xx < ep
-                                              then result 0 0.7071 0.7071
-                                              else let x = toNumber . sqrt $ fromNumber xx
-                                                   in result x (xy/x) (xz/x)
-                    | yy > zz = if yy < ep
-                                   then result 0.7071 0 0.7071
-                                   else let y = toNumber . sqrt $ fromNumber yy
-                                        in result (xy/y) y (yz/y)
-                    | otherwise = if zz < ep
-                                     then result 0.7071 0.7071 0
-                                     else let z = toNumber . sqrt $ fromNumber zz
-                                          in result (xz/z) (yz/z) z
-                  where result vx vy vz = Rotate3d vx vy vz (Angle 180 Deg)
--}
-
-fromPixelsToNum :: Length -> Number
-fromPixelsToNum (Length n u) = toPixels n u
-fromPixelsToNum NullLength   = 0
-
-fromRadiansToNum :: Angle -> Number
-fromRadiansToNum (Angle n u) = toRadians n u
-fromRadiansToNum NullAngle   = 0
-
-tangent :: Angle -> Number
-tangent =  toNumber . tan epsilon . fromNumber . fromRadiansToNum
-
-arctan :: Number -> Number
-arctan = toNumber . atan epsilon . fromNumber
-
--- sine :: Number -> Number
--- sine = toNumber . sin epsilon . fromNumber
-
--- arccos :: Number -> Number
--- arccos = toNumber . acos epsilon . fromNumber
-
-getMat :: TransformFunction -> Matrix Number
-getMat (Mat q)   = q
-getMat (Mat3d q) = q
-getMat _         = error "getMat: not a matrix!"
-
--- toMat :: TransformFunction -> Matrix Number
--- toMat x = getMat . fromJust $ toMatrix3d x
-
-------------------------------------------------------------------------------
-
--- | Convert a matrix to all the other possible equivalent
--- transformation functions (if any).
-possibleRepresentations :: Matrix Number -> [TransformFunction]
-possibleRepresentations m = matrixToRotate3d m ++ mconcat
-    [matrixToSkewFunctions m, matrixToTranslateFunctions m
-    ,matrixToMat m, matrixToPerspective m
-    ,matrixToScaleFunctions m] -- TODO add rotation when implemented
-
-matrixToSkewFunctions :: Matrix Number -> [TransformFunction]
-matrixToSkewFunctions m
-    | skewMatrix == m = Skew a (Just b) : others
-    | otherwise       = []
-  where α = M.unsafeGet 1 2 m
-        β = M.unsafeGet 2 1 m
-        a = Angle (arctan α) Rad
-        b = Angle (arctan β) Rad
-        skewMatrix = mkSkewMatrix α β
-        others
-            | α /= 0 && β == 0 = [SkewX a]
-            | β /= 0 && α == 0 = [SkewY b]
-            | otherwise        = [] -- The only case when we can use either of
-                                    -- them is when both α and β are zero, but if so
-                                    -- skew is already shorter, so don't return it.
-
-matrixToTranslateFunctions :: Matrix Number -> [TransformFunction]
-matrixToTranslateFunctions m
-    | mkTranslate3dMatrix x y z == m = Translate3d tx ty tz : others
-    | otherwise                      = []
-  where x  = M.unsafeGet 1 4 m
-        tx = Right $ Length x PX
-        y  = M.unsafeGet 2 4 m
-        ty = Right $ Length y PX
-        z  = M.unsafeGet 3 4 m
-        tz = Length z PX
-        others
-            | z == 0 && y == 0 = [TranslateX tx, Translate tx (Just ty)]
-            | x == 0 && z == 0 = [TranslateY ty, Translate tx (Just ty)]
-            | y == 0 && x == 0 = [TranslateZ tz]
-            | otherwise        = []
-
-matrixToScaleFunctions :: Matrix Number -> [TransformFunction]
-matrixToScaleFunctions m
-    | mkScale3dMatrix x y z == m = Scale3d x y z : others
-    | otherwise                  = []
-  where x = M.unsafeGet 1 1 m
-        y = M.unsafeGet 2 2 m
-        z = M.unsafeGet 3 3 m
-        others
-            | z == 1 && y == 1 = [ScaleX x, Scale x Nothing]
-            | y == 1 && x == 1 = [ScaleZ z]
-            | x == 1 && z == 1 = [ScaleY y, Scale x (Just y)]
-            | otherwise        = []
-
-matrixToPerspective :: Matrix Number -> [TransformFunction]
-matrixToPerspective m
-    | c /= 0 && mkPerspectiveMatrix d == m = [Perspective $ Length d PX]
-    | otherwise = []
-  where c = M.unsafeGet 4 3 m
-        d = (-1)/c
-
-matrixToMat :: Matrix Number -> [TransformFunction]
-matrixToMat m
-    | matrix == m = [mkMat [a,b,c,d,e,f]]
-    | otherwise   = []
-  where a = M.unsafeGet 1 1 m
-        b = M.unsafeGet 2 1 m
-        c = M.unsafeGet 1 2 m
-        d = M.unsafeGet 2 2 m
-        e = M.unsafeGet 1 4 m
-        f = M.unsafeGet 2 4 m
-        matrix = mkMatMatrix a b c d e f
-
-mkMatMatrix :: Number -> Number -> Number -> Number
-            -> Number -> Number -> Matrix Number
-mkMatMatrix a b c d e f = mk4x4Matrix [a, c, 0, e,
-                                       b, d, 0, f,
-                                       0, 0, 1, 0,
-                                       0, 0, 0, 1]
-mkTranslate3dMatrix :: Number -> Number -> Number -> Matrix Number
-mkTranslate3dMatrix x y z = mk4x4Matrix [1, 0, 0, x,
-                                         0, 1, 0, y,
-                                         0, 0, 1, z,
-                                         0, 0, 0, 1]
-
-mkScale3dMatrix :: Number -> Number -> Number -> Matrix Number
-mkScale3dMatrix x y z = mk4x4Matrix [x, 0, 0, 0,
-                                     0, y, 0, 0,
-                                     0, 0, z, 0,
-                                     0, 0, 0, 1]
-
-mkSkewMatrix :: Number -> Number -> Matrix Number
-mkSkewMatrix a b = mk4x4Matrix [1, a, 0, 0,
-                                b, 1, 0, 0,
-                                0, 0, 1, 0,
-                                0, 0, 0, 1]
-
-mkPerspectiveMatrix :: Number -> Matrix Number
-mkPerspectiveMatrix c = let d = (-1/c)
-                        in mk4x4Matrix [1, 0, 0, 0,
-                                        0, 1, 0, 0,
-                                        0, 0, 1, 0,
-                                        0, 0, d, 0]
-mk4x4Matrix :: [Number] -> Matrix Number
-mk4x4Matrix = M.fromList 4 4
-
--- | Simplifies a \<transform-function\> without converting it to a 4x4 matrix,
--- by doing some simple conversions between the different functions, or
--- minifying the dimension arguments (\<length\> and \<angle\> values)
-simplify :: TransformFunction -> Reader Config TransformFunction
-simplify (Translate pl mpl)
-    | isNothing mpl || isZero (fromJust mpl) = do
-        x <- mapM minify pl
-        pure $ Translate x Nothing
-    | otherwise = do x <- mapM minify pl
-                     y <- (mapM . mapM) minify mpl
-                     pure $ Translate x y
-simplify (TranslateX pl) = do
-    x <- mapM minify pl
-    simplify $ Translate x Nothing
--- Note: It always makes sense to convert from translateX to translate
--- Not sure about translateY. Converting to translate(0,a) might aid
--- compression, even when we are adding one character, because we might be
--- reducing entropy.
-simplify (TranslateY pl) = do
-    y <- mapM minify pl
-    pure $ TranslateY y
--- In scale(), if the second parameter isn't present, it defaults to the first.
--- Therefore:  scale(a,a) == scale(a)
-simplify s@(Scale n mn)  = pure $ maybe s removeDefaultArgument mn
-  where removeDefaultArgument x
-            | n == x    = Scale n Nothing
-            | otherwise = s
--- TODO see if it is better to leave them as is, or convert them to scale(x,1)
--- and scale(1,x), respectively, to aid gzip compression
-simplify s@(ScaleX _)    = pure s
-simplify s@(ScaleY _)    = pure s
--- In skew(), if the second parameter isn't present, it defaults to the zero.
-simplify (Skew a Nothing) = liftA2 Skew (minify a) (pure Nothing)
-simplify (Skew a (Just x))
-    | isZeroAngle x = liftA2 Skew (minify a) (pure Nothing)
-    | otherwise     = liftA2 Skew (minify a) (Just <$> minify x)
-simplify (SkewY a)
-      | isZeroAngle a = pure $ Skew NullAngle Nothing
-      | otherwise     = fmap SkewY (minify a)
-simplify (SkewX a)
-      | isZeroAngle a = pure $ Skew NullAngle Nothing
-      | otherwise     = fmap SkewX (minify a)
-simplify (Rotate a)
-      | isZeroAngle a = pure $ Skew NullAngle Nothing
-      | otherwise     = fmap Rotate (minify a)
-simplify (RotateX a)
-      | isZeroAngle a = pure $ Skew NullAngle Nothing
-      | otherwise     = fmap RotateX (minify a)
-simplify (RotateY a)
-      | isZeroAngle a = pure $ Skew NullAngle Nothing
-      | otherwise     = fmap RotateY (minify a)
--- rotateZ(a) is the same as rotate3d(0,0,1,a), which also equals rotate(a)
-simplify (RotateZ a)
-      | isZeroAngle a = pure $ Skew NullAngle Nothing
-      | otherwise        = fmap Rotate (minify a)
-simplify (Rotate3d x y z a)
-      | abs (x - 1) < ep && abs y < ep && abs z < ep = simplify $ RotateX a
-      | abs x < ep && abs (y - 1) < ep && abs z < ep = simplify $ RotateY a
-      | abs x < ep && abs y < ep && abs (z - 1) < ep = fmap Rotate (minify a)
-  where ep = toNumber epsilon
-simplify (ScaleZ n)
-      | n == 1    = pure $ Skew NullAngle Nothing
-      | otherwise = pure $ ScaleZ n
-simplify (Perspective d) = fmap Perspective (minify d)
-simplify (TranslateZ d)
-      | isZeroLen d = pure $ Skew NullAngle Nothing
-      | otherwise   = fmap TranslateZ (minify d)
-simplify s@(Scale3d x y z)
-      | z == 1           = simplify $ Scale x (Just y)
-      | x == 1 && y == 1 = simplify $ ScaleZ z
-      | otherwise        = pure s
-simplify (Translate3d x y z )
-      | isZero y && isZeroLen z = either (f TranslateX) (g TranslateX) x
-      | isZero x && isZero y    = simplify $ TranslateZ z
-      | isZero x && isZeroLen z = either (f TranslateY) (g TranslateY) y
-    where f con a | a == 0    = simplify . con . Right $ NullLength
-                  | otherwise = simplify . con . Left $ a
-          g con a = simplify . con $ Right a -- A distance, transform an minify
-simplify x = pure x
-
--- | Combines consecutive @\<transform-functions\>@ whenever possible, leaving
--- translate functions that can't be converted to a matrix (because they use
--- percentages or relative units) as they are, in the position they are in the
--- list (since matrix multiplication isn't commutative)
--- Example:
---
--- >>> import Control.Monad.Reader
--- >>> let t10 = Translate (Right (Length 10 PX)) Nothing
--- >>> let s45 = Skew (Angle 45 Deg) Nothing
--- >>> let sx5 = ScaleX 5
--- >>> let f x = runReader (combine x) defaultConfig
---
--- >>> fmap toText $ f [t10, s45, sx5]
--- ["matrix(5,0,1,1,10,0)"]
---
--- >>> let tp  = Translate (Left (Percentage 100)) Nothing
--- >>> fmap toText $ f [s45,tp,sx5,sx5,sx5]
--- ["skew(45deg)","translate(100%)","scale(125)"]
-combine :: [TransformFunction] -> Reader Config [TransformFunction]
-combine xs = do
-    combinedLength <- mapReader (getLength . asBuilder) combinedFunctions
-    originalLength <- mapReader (getLength . asBuilder) minifiedOriginal
-    if combinedLength < originalLength
-       then combinedFunctions
-       else minifiedOriginal
-  where getLength = T.length . toStrict . toLazyText
-        asBuilder = mconcatIntersperse toBuilder (singleton ' ')
-        combinedFunctions = mapM handleMatrices . groupByMatrices $ zip (fmap toMatrix3d xs) xs
-        minifiedOriginal = mapM minify xs
-        groupByMatrices   = groupBy (\(a,_) (b,_) -> isJust a && isJust b)
-        handleMatrices l@((x,a):_)
-            | isJust x  = minify . Mat3d . foldr (*) (M.identity 4 :: Matrix Number) $ fmap (getMat . fromJust . fst) l
-            | otherwise = simplify a
-        handleMatrices [] = error "empty list as argument to handleMatrices"
+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Hasmin.Types.TransformFunction+-- Copyright   : (c) 2017 Cristian Adrián Ontivero+-- License     : BSD3+-- Stability   : experimental+-- Portability : non-portable+--+-----------------------------------------------------------------------------+module Hasmin.Types.TransformFunction+    ( TransformFunction(..)+    , mkMat+    , mkMat3d+    , combine+    , simplify+    ) where++import Control.Monad.Reader (mapReader, Reader, ask, local)+import Control.Applicative (liftA2)+import Data.Monoid ((<>))+import Data.Either (isRight)+import qualified Data.Text as T+import Data.Number.FixedFunctions (tan, atan)+import Prelude hiding (sin, cos, acos, tan, atan)+import qualified Data.Matrix as M+import Data.Matrix (Matrix)+import Data.List (groupBy)+import Data.Maybe (fromMaybe, isNothing, isJust, fromJust)+import Data.Text.Lazy.Builder (toLazyText, singleton, Builder)+import Data.Text.Lazy (toStrict)++import Hasmin.Config+import Hasmin.Class+import Hasmin.Utils+import Hasmin.Types.Dimension+import Hasmin.Types.PercentageLength+import Hasmin.Types.Numeric++-- Note: In a previous specification, translate3d() took two+-- <https://www.w3.org/TR/css-transforms-1/#typedef-translation-value \<translation-value\>>,+-- however in the <https://drafts.csswg.org/css-transforms/ latest draft>, it+-- takes two \<length-percentage\> (which makes sense since translateX() and+-- translateY() also do).++-- | CSS <https://drafts.csswg.org/css-transforms/#typedef-transform-function \<transform-function\>>+-- data type.+data TransformFunction = Mat (Matrix Number)+                       | Mat3d (Matrix Number)+                       | Perspective Length+                       | Rotate Angle+                       | RotateX Angle+                       | RotateY Angle+                       | RotateZ Angle+                       | Rotate3d Number Number Number Angle+                       | Scale Number (Maybe Number)+                       | ScaleX Number+                       | ScaleY Number+                       | ScaleZ Number+                       | Scale3d Number Number Number+                       | Skew Angle (Maybe Angle)+                       | SkewX Angle+                       | SkewY Angle+                       | Translate PercentageLength (Maybe PercentageLength)+                       | TranslateX PercentageLength+                       | TranslateY PercentageLength+                       | TranslateZ Length+                       | Translate3d PercentageLength PercentageLength Length+  deriving (Eq, Show)++-- There are a series of equivalences to keep in mind: translate(0),+-- translate3d(0, 0, 0), translateX(0), translateY(0), translateZ(0), scale(1),+-- scaleX(1), scaleY(1), scaleZ(1), rotate(0), rotate3d(1,1,1,0), rotateX(0),+-- rotateY(0), rotateZ(0), perspective(infinity), matrix(1,0,0,1,0,0),+-- matrix3d(1,0,0,0,0,1,0,0,0,0,1,0,0,0,0,1), skewX(0), skewY(0), and the+-- shortest of them all: skew(0)+-- All of these translate to the 4x4 identity matrix.+instance Minifiable TransformFunction where+  minify (Mat3d m) = do+      conf <- ask+      if shouldMinifyTransformFunction conf+         then case possibleRepresentations m of+                []     -> pure (Mat3d m)+                (x:xs) -> let simplifyAndConvertUnits a = local (const $ conf { dimensionSettings = DimMinOn }) (simplify a)+                          in go simplifyAndConvertUnits x xs+         else pure (Mat3d m)+    where go f y []     = f y+          go f y (z:zs) = do+              currentLength <- textualLength <$> f y+              newLength     <- textualLength <$> f z+              if currentLength < newLength+                 then go f y zs+                 else go f z zs+  minify x = do+      conf <- ask+      if shouldMinifyTransformFunction conf+         then case toMatrix3d x of+                Just mat3d -> minify mat3d+                Nothing    -> simplify x+         else simplify x++{-+s = SkewX (Angle 45 Deg)+tx = TranslateX (Right $ Length (-6) PX)+ry = RotateY (Angle (-9) Deg)+ry2 = Rotate3d 0 (-1) 0 (Angle 9 Deg)+t = TranslateZ (Length 100 PX)+t2 = Translate (Right (Length 100 PX)) Nothing+tr = Rotate3d 0 0 1 (Angle 90 Deg)+tr1 = Rotate3d 0 0 1 (Angle 45 Deg)+g x = runReader x defaultConfig+-}++instance ToText TransformFunction where+  toBuilder (Translate pl mpl)   = "translate("+      <> toBuilder pl <> maybeWithComma mpl <> singleton ')'+  toBuilder (TranslateX pl)      = "translatex("+      <> either toBuilder toBuilder pl <> singleton ')'+  toBuilder (TranslateY pl)      = "translatey(" <> either toBuilder toBuilder pl <> singleton ')'+  toBuilder (TranslateZ d)       = "translatez(" <> toBuilder d <> singleton ')'+  toBuilder (Scale n mn)         = "scale(" <> toBuilder n <> maybeWithComma mn <> singleton ')'+  toBuilder (ScaleX n)           = "scalex(" <> toBuilder n <> singleton ')'+  toBuilder (ScaleY n)           = "scaley(" <> toBuilder n <> singleton ')'+  toBuilder (ScaleZ n)           = "scalez(" <> toBuilder n <> singleton ')'+  toBuilder (Skew a ma)          = "skew(" <> toBuilder a <> maybeWithComma ma <> singleton ')'+  toBuilder (SkewX a)            = "skewx(" <> toBuilder a <> singleton ')'+  toBuilder (SkewY a)            = "skewy(" <> toBuilder a <> singleton ')'+  toBuilder (Rotate a)           = "rotate(" <> toBuilder a <> singleton ')'+  toBuilder (RotateX a)          = "rotatex(" <> toBuilder a <> singleton ')'+  toBuilder (RotateY a)          = "rotatey(" <> toBuilder a <> singleton ')'+  toBuilder (RotateZ a)          = "rotatez(" <> toBuilder a <> singleton ')'+  toBuilder (Rotate3d x y z a)   = "rotate3d(" <> toBuilder x <> singleton ','+      <> toBuilder y <> singleton ',' <> toBuilder z <> singleton ','+      <> toBuilder a <> singleton ')'+  toBuilder (Scale3d x y z)      = "scale3d(" <> toBuilder x <> singleton ','+      <> toBuilder y <> singleton ',' <> toBuilder z <> singleton ')'+  toBuilder (Perspective d)      = "perspective(" <> toBuilder d <> singleton ')'+  toBuilder (Translate3d x y z ) = "translate3d(" <> toBuilder x <> singleton ','+      <> toBuilder y <> singleton ',' <> toBuilder z <> singleton ')'+  toBuilder (Mat m)              = "matrix("+      <> mconcatIntersperse toBuilder (singleton ',') (M.toList m) <> singleton ')'+  toBuilder (Mat3d m)            = "matrix3d("+      <> mconcatIntersperse toBuilder (singleton ',') (M.toList m) <> singleton ')'++maybeWithComma :: ToText a => Maybe a -> Builder+maybeWithComma = maybe mempty (\x -> singleton ',' <> toBuilder x)++mkMat :: [Number] -> TransformFunction+mkMat = Mat . M.fromList 3 2++mkMat3d :: [Number] -> TransformFunction+mkMat3d = Mat3d . M.fromList 4 4++toMatrix3d :: TransformFunction -> Maybe TransformFunction+toMatrix3d m@Mat3d{} = Just m+toMatrix3d (Mat x)   = Just $ toMat3d (M.toList x)+  where toMat3d [a,b,c,d,e,f] = mkMat3d [a, c, 0, e,+                                         b, d, 0, f,+                                         0, 0, 1, 0,+                                         0, 0, 0, 1]+        toMat3d _ = error "invalid matrix size!"+toMatrix3d (Translate pl mpl)+    | isNonZeroPercentage pl = Nothing+    | isJust mpl && isNonZeroPercentage (fromJust mpl) = Nothing+    | otherwise = Just . Mat3d $ mkTranslate3dMatrix x y 0+  where x = either (const 0) fromPixelsToNum pl+        y = maybe 0 (fromPixelsToNum . fromRight') mpl+toMatrix3d (TranslateX pl)+    | isNonZeroPercentage pl = Nothing+    | isRight pl && isRelativeLength (fromRight' pl) = Nothing+    | otherwise = Just . Mat3d $ mkTranslate3dMatrix x 0 0+  where x = either (const 0) fromPixelsToNum pl+toMatrix3d (TranslateY pl)+    | isNonZeroPercentage pl = Nothing+    | isRight pl && isRelativeLength (fromRight' pl) = Nothing+    | otherwise = Just . Mat3d $ mkTranslate3dMatrix 0 y 0+  where y = either (const 0) fromPixelsToNum pl+toMatrix3d (TranslateZ d)+    | isRelativeLength d  = Nothing+    | otherwise = Just . Mat3d $ mkTranslate3dMatrix 0 0 z+  where z = fromPixelsToNum d+toMatrix3d (Scale n mn) = Just . Mat3d $ mkScale3dMatrix n y 1+  where y = fromMaybe n mn+toMatrix3d (ScaleX n) = Just . Mat3d $ mkScale3dMatrix n 1 1+toMatrix3d (ScaleY n) = Just . Mat3d $ mkScale3dMatrix 1 n 1+toMatrix3d (ScaleZ n) = Just . Mat3d $ mkScale3dMatrix 1 1 n+toMatrix3d (Skew a ma) = Just . Mat3d $ mkSkewMatrix α β+  where α = tangent a+        β = maybe 0 tangent ma+toMatrix3d (SkewX a) = Just . Mat3d $ mkSkewMatrix (tangent a) 0+toMatrix3d (SkewY a) = Just . Mat3d $ mkSkewMatrix 0 (tangent a)+toMatrix3d (Translate3d pl1 pl2 d)+    | isNonZeroPercentage pl1 || isNonZeroPercentage pl2 = Nothing+    | isRight pl1 && isRelativeLength (fromRight' pl1) = Nothing+    | isRight pl2 && isRelativeLength (fromRight' pl2) = Nothing+    | isRelativeLength d = Nothing+    | otherwise = let x = either (const 0) fromPixelsToNum pl1+                      y = either (const 0) fromPixelsToNum pl2+                      z = fromPixelsToNum d+                  in Just . Mat3d $ mkTranslate3dMatrix x y z+toMatrix3d (Scale3d x y z) = Just . Mat3d $ mkScale3dMatrix x y z+toMatrix3d (Perspective d)+    | isZeroLen d = Nothing+    | otherwise   = let c = fromPixelsToNum d+                    in Just . Mat3d $ mkPerspectiveMatrix c+-- Note: The commented code is fine, but until we implement the+-- function that converts a matrix back to a rotate function, uncommenting this+-- breaks the minification, e.g. it says that:+-- minify rotate(90deg) == matrix(0,1,-1,0,0,0)+{-+toMatrix3d (Rotate a) = Just $ rotateIn3d (0,0,1) (fromRadiansToNum a)+toMatrix3d (Rotate3d x y z a) = Just $ rotateIn3d (x,y,z) (fromRadiansToNum a)+toMatrix3d (RotateX a) = Just $ rotateIn3d (1,0,0) (fromRadiansToNum a)+toMatrix3d (RotateY a) = Just $ rotateIn3d (0,1,0) (fromRadiansToNum a)+toMatrix3d (RotateZ a) = Just $ rotateIn3d (0,0,1) (fromRadiansToNum a)+-}+toMatrix3d _ = Nothing++-- Used for the rotate3d(), rotate(), ..., functions. Given an [x,y,z] vector+-- and an angle, create its corresponding rotation matrix.+{-+rotateIn3d :: (Number, Number, Number) -> Number -> TransformFunction+rotateIn3d (b,c,d) a = mkMat3d $ fmap toNumber+    [1-2*(y^2 + z^2)*sq, 2*(x*y*sq - z*sc),  2*(x*z*sq + y*sc),  0,+     2*(x*y*sq + z*sc),  1-2*(x^2 + z^2)*sq, 2*(y*z*sq - x*sc),  0,+     2*(x*z*sq - y*sc),  2*(y*z*sq + x*sc),  1-2*(x^2 + y^2)*sq, 0,+     0,                  0,                  0,                  1]+  where sc = sin epsilon (α/2) * cos epsilon (α/2)  :: Rational+        sq = sin epsilon (α/2) ^ 2 :: Rational+        x  = toRational b+        y  = toRational c+        z  = toRational d+        α  = toRational a+-}++-- Code translated from: http://www.euclideanspace.com/maths/geometry/rotations/conversions/matrixToAngle/+-- TODO: see how to get different representations, so that negative values are+-- still properly handled, i.e. make things such as rotateY(-9deg) work.+matrixToRotate3d :: Matrix Number -> [TransformFunction]+matrixToRotate3d _ = []+{-+    -- if it has translation values, then we can't convert it to a rotation function+    | M.unsafeGet 3 4 m /= 0 || M.unsafeGet 2 4 m /= 0 || M.unsafeGet 1 4 m /= 0 = []+    -- | not isRotationMatrix = []+    | abs (m12 - m21) < ep && abs (m13 - m31) < ep+                           && abs (m23 - m32) < ep = [handleSingularity]+    | otherwise = let a = arccos $ (m11 + m22 + m33 - 1)/2+                      qx = (m32 - m23)/(2 * sine a)+                      qy = (m13 - m31)/(2 * sine a)+                      qz = (m21 - m12)/(2 * sine a)+                  in [Rotate3d qx qy qz (Angle a Rad)]+  where m11 = M.unsafeGet 1 1 m+        m22 = M.unsafeGet 2 2 m+        m33 = M.unsafeGet 3 3 m+        m32 = M.unsafeGet 3 2 m+        m23 = M.unsafeGet 2 3 m+        m13 = M.unsafeGet 1 3 m+        m31 = M.unsafeGet 3 1 m+        m21 = M.unsafeGet 2 1 m+        m12 = M.unsafeGet 1 2 m+        ep = 0.01 -- margin to allow for rounding errors+        ep2 = 0.1+-- Make sure that the input is a pure rotation matrix.+-- The condition for this is:+-- R' * R = I, and det(R) = 1+        isRotationMatrix+            |    abs (m11*m12 + m12*m22 + m13*m23) > ep+              || abs (m11*m31 + m12*m32 + m13*m33) > ep+              || abs (m21*m31 + m22*m32 + m23*m33) > ep+              || abs (m11*m11 + m12*m12 + m13*m13 - 1) > ep+              || abs (m21*m21 + m22*m11 + m23*m23 - 1) > ep+              || abs (m31*m31 + m32*m32 + m33*m33 - 1) > ep = False+            | otherwise = abs (detLU m - 1) < ep+        handleSingularity+            |    abs (m12 + m21) < ep2+              && abs (m13 + m31) < ep2+              && abs (m23 - m32) < ep2+              && abs (m11 + m22 + m33 - 3) < ep2 = Rotate3d 1 0 0 NullAngle+            | otherwise = let xx = (m11+1)/2+                              yy = (m22+1)/2+                              zz = (m33+1)/2+                              xy = (m12 + m21)/4+                              xz = (m13 + m31)/4+                              yz = (m23 + m32)/4+                          in handle180Singularity xx yy zz xy xz yz+          where handle180Singularity xx yy zz xy xz yz+                    | xx > yy && xx > zz = if xx < ep+                                              then result 0 0.7071 0.7071+                                              else let x = toNumber . sqrt $ fromNumber xx+                                                   in result x (xy/x) (xz/x)+                    | yy > zz = if yy < ep+                                   then result 0.7071 0 0.7071+                                   else let y = toNumber . sqrt $ fromNumber yy+                                        in result (xy/y) y (yz/y)+                    | otherwise = if zz < ep+                                     then result 0.7071 0.7071 0+                                     else let z = toNumber . sqrt $ fromNumber zz+                                          in result (xz/z) (yz/z) z+                  where result vx vy vz = Rotate3d vx vy vz (Angle 180 Deg)+-}++fromPixelsToNum :: Length -> Number+fromPixelsToNum (Length n u) = toPixels n u+fromPixelsToNum NullLength   = 0++fromRadiansToNum :: Angle -> Number+fromRadiansToNum (Angle n u) = toRadians n u+fromRadiansToNum NullAngle   = 0++tangent :: Angle -> Number+tangent =  toNumber . tan epsilon . fromNumber . fromRadiansToNum++arctan :: Number -> Number+arctan = toNumber . atan epsilon . fromNumber++-- sine :: Number -> Number+-- sine = toNumber . sin epsilon . fromNumber++-- arccos :: Number -> Number+-- arccos = toNumber . acos epsilon . fromNumber++getMat :: TransformFunction -> Matrix Number+getMat (Mat q)   = q+getMat (Mat3d q) = q+getMat _         = error "getMat: not a matrix!"++-- toMat :: TransformFunction -> Matrix Number+-- toMat x = getMat . fromJust $ toMatrix3d x++------------------------------------------------------------------------------++-- | Convert a matrix to all the other possible equivalent+-- transformation functions (if any).+possibleRepresentations :: Matrix Number -> [TransformFunction]+possibleRepresentations m = matrixToRotate3d m ++ mconcat+    [matrixToSkewFunctions m, matrixToTranslateFunctions m+    ,matrixToMat m, matrixToPerspective m+    ,matrixToScaleFunctions m] -- TODO add rotation when implemented++matrixToSkewFunctions :: Matrix Number -> [TransformFunction]+matrixToSkewFunctions m+    | skewMatrix == m = Skew a (Just b) : others+    | otherwise       = []+  where α = M.unsafeGet 1 2 m+        β = M.unsafeGet 2 1 m+        a = Angle (arctan α) Rad+        b = Angle (arctan β) Rad+        skewMatrix = mkSkewMatrix α β+        others+            | α /= 0 && β == 0 = [SkewX a]+            | β /= 0 && α == 0 = [SkewY b]+            | otherwise        = [] -- The only case when we can use either of+                                    -- them is when both α and β are zero, but if so+                                    -- skew is already shorter, so don't return it.++matrixToTranslateFunctions :: Matrix Number -> [TransformFunction]+matrixToTranslateFunctions m+    | mkTranslate3dMatrix x y z == m = Translate3d tx ty tz : others+    | otherwise                      = []+  where x  = M.unsafeGet 1 4 m+        tx = Right $ Length x PX+        y  = M.unsafeGet 2 4 m+        ty = Right $ Length y PX+        z  = M.unsafeGet 3 4 m+        tz = Length z PX+        others+            | z == 0 && y == 0 = [TranslateX tx, Translate tx (Just ty)]+            | x == 0 && z == 0 = [TranslateY ty, Translate tx (Just ty)]+            | y == 0 && x == 0 = [TranslateZ tz]+            | otherwise        = []++matrixToScaleFunctions :: Matrix Number -> [TransformFunction]+matrixToScaleFunctions m+    | mkScale3dMatrix x y z == m = Scale3d x y z : others+    | otherwise                  = []+  where x = M.unsafeGet 1 1 m+        y = M.unsafeGet 2 2 m+        z = M.unsafeGet 3 3 m+        others+            | z == 1 && y == 1 = [ScaleX x, Scale x Nothing]+            | y == 1 && x == 1 = [ScaleZ z]+            | x == 1 && z == 1 = [ScaleY y, Scale x (Just y)]+            | otherwise        = []++matrixToPerspective :: Matrix Number -> [TransformFunction]+matrixToPerspective m+    | c /= 0 && mkPerspectiveMatrix d == m = [Perspective $ Length d PX]+    | otherwise = []+  where c = M.unsafeGet 4 3 m+        d = (-1)/c++matrixToMat :: Matrix Number -> [TransformFunction]+matrixToMat m+    | matrix == m = [mkMat [a,b,c,d,e,f]]+    | otherwise   = []+  where a = M.unsafeGet 1 1 m+        b = M.unsafeGet 2 1 m+        c = M.unsafeGet 1 2 m+        d = M.unsafeGet 2 2 m+        e = M.unsafeGet 1 4 m+        f = M.unsafeGet 2 4 m+        matrix = mkMatMatrix a b c d e f++mkMatMatrix :: Number -> Number -> Number -> Number+            -> Number -> Number -> Matrix Number+mkMatMatrix a b c d e f = mk4x4Matrix [a, c, 0, e,+                                       b, d, 0, f,+                                       0, 0, 1, 0,+                                       0, 0, 0, 1]+mkTranslate3dMatrix :: Number -> Number -> Number -> Matrix Number+mkTranslate3dMatrix x y z = mk4x4Matrix [1, 0, 0, x,+                                         0, 1, 0, y,+                                         0, 0, 1, z,+                                         0, 0, 0, 1]++mkScale3dMatrix :: Number -> Number -> Number -> Matrix Number+mkScale3dMatrix x y z = mk4x4Matrix [x, 0, 0, 0,+                                     0, y, 0, 0,+                                     0, 0, z, 0,+                                     0, 0, 0, 1]++mkSkewMatrix :: Number -> Number -> Matrix Number+mkSkewMatrix a b = mk4x4Matrix [1, a, 0, 0,+                                b, 1, 0, 0,+                                0, 0, 1, 0,+                                0, 0, 0, 1]++mkPerspectiveMatrix :: Number -> Matrix Number+mkPerspectiveMatrix c = let d = (-1/c)+                        in mk4x4Matrix [1, 0, 0, 0,+                                        0, 1, 0, 0,+                                        0, 0, 1, 0,+                                        0, 0, d, 0]+mk4x4Matrix :: [Number] -> Matrix Number+mk4x4Matrix = M.fromList 4 4++-- | Simplifies a \<transform-function\> without converting it to a 4x4 matrix,+-- by doing some simple conversions between the different functions, or+-- minifying the dimension arguments (\<length\> and \<angle\> values)+simplify :: TransformFunction -> Reader Config TransformFunction+simplify (Translate pl mpl)+    | isNothing mpl || isZero (fromJust mpl) = do+        x <- mapM minify pl+        pure $ Translate x Nothing+    | otherwise = do x <- mapM minify pl+                     y <- (mapM . mapM) minify mpl+                     pure $ Translate x y+simplify (TranslateX pl) = do+    x <- mapM minify pl+    simplify $ Translate x Nothing+-- Note: It always makes sense to convert from translateX to translate+-- Not sure about translateY. Converting to translate(0,a) might aid+-- compression, even when we are adding one character, because we might be+-- reducing entropy.+simplify (TranslateY pl) = do+    y <- mapM minify pl+    pure $ TranslateY y+-- In scale(), if the second parameter isn't present, it defaults to the first.+-- Therefore:  scale(a,a) == scale(a)+simplify s@(Scale n mn)  = pure $ maybe s removeDefaultArgument mn+  where removeDefaultArgument x+            | n == x    = Scale n Nothing+            | otherwise = s+-- TODO see if it is better to leave them as is, or convert them to scale(x,1)+-- and scale(1,x), respectively, to aid gzip compression+simplify s@(ScaleX _)    = pure s+simplify s@(ScaleY _)    = pure s+-- In skew(), if the second parameter isn't present, it defaults to the zero.+simplify (Skew a Nothing) = liftA2 Skew (minify a) (pure Nothing)+simplify (Skew a (Just x))+    | isZeroAngle x = liftA2 Skew (minify a) (pure Nothing)+    | otherwise     = liftA2 Skew (minify a) (Just <$> minify x)+simplify (SkewY a)+      | isZeroAngle a = pure $ Skew NullAngle Nothing+      | otherwise     = fmap SkewY (minify a)+simplify (SkewX a)+      | isZeroAngle a = pure $ Skew NullAngle Nothing+      | otherwise     = fmap SkewX (minify a)+simplify (Rotate a)+      | isZeroAngle a = pure $ Skew NullAngle Nothing+      | otherwise     = fmap Rotate (minify a)+simplify (RotateX a)+      | isZeroAngle a = pure $ Skew NullAngle Nothing+      | otherwise     = fmap RotateX (minify a)+simplify (RotateY a)+      | isZeroAngle a = pure $ Skew NullAngle Nothing+      | otherwise     = fmap RotateY (minify a)+-- rotateZ(a) is the same as rotate3d(0,0,1,a), which also equals rotate(a)+simplify (RotateZ a)+      | isZeroAngle a = pure $ Skew NullAngle Nothing+      | otherwise        = fmap Rotate (minify a)+simplify (Rotate3d x y z a)+      | abs (x - 1) < ep && abs y < ep && abs z < ep = simplify $ RotateX a+      | abs x < ep && abs (y - 1) < ep && abs z < ep = simplify $ RotateY a+      | abs x < ep && abs y < ep && abs (z - 1) < ep = fmap Rotate (minify a)+  where ep = toNumber epsilon+simplify (ScaleZ n)+      | n == 1    = pure $ Skew NullAngle Nothing+      | otherwise = pure $ ScaleZ n+simplify (Perspective d) = fmap Perspective (minify d)+simplify (TranslateZ d)+      | isZeroLen d = pure $ Skew NullAngle Nothing+      | otherwise   = fmap TranslateZ (minify d)+simplify s@(Scale3d x y z)+      | z == 1           = simplify $ Scale x (Just y)+      | x == 1 && y == 1 = simplify $ ScaleZ z+      | otherwise        = pure s+simplify (Translate3d x y z )+      | isZero y && isZeroLen z = either (f TranslateX) (g TranslateX) x+      | isZero x && isZero y    = simplify $ TranslateZ z+      | isZero x && isZeroLen z = either (f TranslateY) (g TranslateY) y+    where f con a | a == 0    = simplify . con . Right $ NullLength+                  | otherwise = simplify . con . Left $ a+          g con a = simplify . con $ Right a -- A distance, transform an minify+simplify x = pure x++-- | Combines consecutive @\<transform-functions\>@ whenever possible, leaving+-- translate functions that can't be converted to a matrix (because they use+-- percentages or relative units) as they are, in the position they are in the+-- list (since matrix multiplication isn't commutative)+-- Example:+--+-- >>> import Control.Monad.Reader+-- >>> let t10 = Translate (Right (Length 10 PX)) Nothing+-- >>> let s45 = Skew (Angle 45 Deg) Nothing+-- >>> let sx5 = ScaleX 5+-- >>> let f x = runReader (combine x) defaultConfig+--+-- >>> fmap toText $ f [t10, s45, sx5]+-- ["matrix(5,0,1,1,10,0)"]+--+-- >>> let tp  = Translate (Left (Percentage 100)) Nothing+-- >>> fmap toText $ f [s45,tp,sx5,sx5,sx5]+-- ["skew(45deg)","translate(100%)","scale(125)"]+combine :: [TransformFunction] -> Reader Config [TransformFunction]+combine xs = do+    combinedLength <- mapReader (getLength . asBuilder) combinedFunctions+    originalLength <- mapReader (getLength . asBuilder) minifiedOriginal+    if combinedLength < originalLength+       then combinedFunctions+       else minifiedOriginal+  where getLength = T.length . toStrict . toLazyText+        asBuilder = mconcatIntersperse toBuilder (singleton ' ')+        combinedFunctions = mapM handleMatrices . groupByMatrices $ zip (fmap toMatrix3d xs) xs+        minifiedOriginal = mapM minify xs+        groupByMatrices   = groupBy (\(a,_) (b,_) -> isJust a && isJust b)+        handleMatrices l@((x,a):_)+            | isJust x  = minify . Mat3d . foldr (*) (M.identity 4 :: Matrix Number) $ fmap (getMat . fromJust . fst) l+            | otherwise = simplify a+        handleMatrices [] = error "empty list as argument to handleMatrices"

@@ -1,6 +1,6 @@--- {-# OPTIONS_GHC -F -pgmF doctest-discover #-}
-
-import Test.DocTest (doctest)
-
-main :: IO ()
-main = doctest ["src"]
+-- {-# OPTIONS_GHC -F -pgmF doctest-discover #-}++import Test.DocTest (doctest)++main :: IO ()+main = doctest ["src"]

@@ -1,445 +1,473 @@-{-# LANGUAGE OverloadedStrings #-}
-
-module Hasmin.Types.DeclarationSpec where
-
-import Data.Foldable (traverse_)
-import Data.Monoid ((<>))
-import Data.Text (Text)
-
-import Hasmin.Parser.Internal
-import Hasmin.TestUtils
-import Hasmin.Types.Declaration
-
-declarationTests :: Spec
-declarationTests =
-    describe "declaration" $
-      mapM_ (matchSpec declaration) declarationTestsInfo
-
-propertySpecificTests :: Spec
-propertySpecificTests =
-    describe "property specific changes" $
-      mapM_ (matchSpec f) propertySpecificTestsInfo
-  where f = minifyWithTestConfig <$> declaration
-
-propertySpecificTestsInfo :: [(Text, Text)]
-propertySpecificTestsInfo =
-  [("font-family:Arial Black Long Name", "font-family:arial black long name")
-  ,("font:9px Arial Black Long Name", "font:9px arial black long name")
-  ,("font-family:\"SANS-SERIF\"", "font-family:\"sans-serif\"")
-  ,("font-family:'Helvetica','Arial',sans-serif", "font-family:helvetica,arial,sans-serif")
-  -- TODO make this work
-  -- should fallback and parse till ';'
-  -- ,("font-size:1em\nline-height:1.38;", "font-size:1em\nline-height:1.38;")
-
-  ,("background-size:1px auto, 2px auto", "background-size:1px,2px")
-
-  ,("text-shadow: 1px 1px 1px #ff0000", "text-shadow:1px 1px 1px red")
-  ,("text-shadow: 12px 12px 12px", "text-shadow:9pt 9pt 9pt")
-  ,("text-shadow: 1px 1px 0 green", "text-shadow:1px 1px green")
-  ,("text-shadow: 1px 1px 0 green, 2px 2px 0 blue", "text-shadow:1px 1px green,2px 2px blue")
-
-  ,("font-weight:normal", "font-weight:400")
-  ,("font-weight:bold",   "font-weight:700")
-
-  ,("word-spacing:normal",  "word-spacing:0")
-  ,("word-spacing:initial", "word-spacing:0")
-  ,("word-spacing:unset",   "word-spacing:unset")
-  ,("word-spacing:inherit", "word-spacing:unset")
-
-  ,("vertical-align:baseline", "vertical-align:0")
-  ,("vertical-align:initial",  "vertical-align:0")
-  ,("vertical-align:unset",    "vertical-align:0")
-
-  ,("transform-origin:left top", "transform-origin:0 0")
-  ,("transform-origin:left 0",   "transform-origin:0 0")
-  ,("transform-origin:0 top",    "transform-origin:0 0")
-  ,("transform-origin:0 0",      "transform-origin:0 0")
-  ,("transform-origin:top left", "transform-origin:0 0")
-  ,("transform-origin:top 0",    "transform-origin:0 0")
-  ,("transform-origin:0 left",   "transform-origin:0 0")
-
-  ,("transform-origin:left bottom", "transform-origin:0 100%")
-  ,("transform-origin:0 bottom",    "transform-origin:0 100%")
-  ,("transform-origin:left 100%",   "transform-origin:0 100%")
-  ,("transform-origin:0 100%",      "transform-origin:0 100%")
-  ,("transform-origin:bottom left", "transform-origin:0 100%")
-  ,("transform-origin:100% left",   "transform-origin:0 100%")
-  ,("transform-origin:bottom 0",    "transform-origin:0 100%")
-
-  ,("transform-origin:right top", "transform-origin:100% 0")
-  ,("transform-origin:100% top",  "transform-origin:100% 0")
-  ,("transform-origin:right 0",   "transform-origin:100% 0")
-  ,("transform-origin:top 100%",  "transform-origin:100% 0")
-  ,("transform-origin:0% right",  "transform-origin:100% 0")
-  ,("transform-origin:top right", "transform-origin:100% 0")
-
-  ,("transform-origin:right bottom", "transform-origin:100% 100%")
-  ,("transform-origin:100% bottom",  "transform-origin:100% 100%")
-  ,("transform-origin:right 100%",   "transform-origin:100% 100%")
-  ,("transform-origin:bottom 100%",  "transform-origin:100% 100%")
-  ,("transform-origin:100% right",   "transform-origin:100% 100%")
-  ,("transform-origin:bottom right", "transform-origin:100% 100%")
-
-  ,("transform-origin:center bottom", "transform-origin:bottom")
-  ,("transform-origin:50% bottom",    "transform-origin:bottom")
-  ,("transform-origin:center 100%",   "transform-origin:bottom")
-  ,("transform-origin:bottom 50%",    "transform-origin:bottom")
-  ,("transform-origin:bottom center", "transform-origin:bottom")
-
-  ,("transform-origin:center top", "transform-origin:top")
-  ,("transform-origin:50% top",    "transform-origin:top")
-  ,("transform-origin:center 0px", "transform-origin:top")
-  ,("transform-origin:top 50%",    "transform-origin:top")
-  ,("transform-origin:top center", "transform-origin:top")
-
-  ,("transform-origin:center right", "transform-origin:100%")
-  ,("transform-origin:50% right",    "transform-origin:100%")
-  ,("transform-origin:right 50%",    "transform-origin:100%")
-  ,("transform-origin:100% center",  "transform-origin:100%")
-  ,("transform-origin:right center", "transform-origin:100%")
-
-  ,("transform-origin:center left", "transform-origin:0")
-  ,("transform-origin:50% left",    "transform-origin:0")
-  ,("transform-origin:left 50%",    "transform-origin:0")
-  ,("transform-origin:0% center",   "transform-origin:0")
-  ,("transform-origin:left center", "transform-origin:0")
-
-  ,("transform-origin:center",            "transform-origin:50%")
-  ,("transform-origin:center center",     "transform-origin:50%")
-  ,("transform-origin:center 50%",        "transform-origin:50%")
-  ,("transform-origin:50% center",        "transform-origin:50%")
-  ,("transform-origin:50% 50%",           "transform-origin:50%")
-  ,("transform-origin:center center 0",   "transform-origin:50%")
-  ,("transform-origin:center center 1px", "transform-origin:50% 50% 1px")
-
-  ,("transform-origin:left 30px",   "transform-origin:0 30px")
-  ,("transform-origin:30px left",   "transform-origin:0 30px")
-  ,("transform-origin:right 30px",  "transform-origin:100% 30px")
-  ,("transform-origin:30px right",  "transform-origin:100% 30px")
-  ,("transform-origin:bottom 30px", "transform-origin:30px 100%")
-  ,("transform-origin:30px bottom", "transform-origin:30px 100%")
-  ,("transform-origin:top 30px",    "transform-origin:30px 0")
-  ,("transform-origin:30px top",    "transform-origin:30px 0")
-  ,("transform-origin:center 30px", "transform-origin:50% 30px")
-  ,("transform-origin:30px center", "transform-origin:30px")
-
-  -- 3 value syntax
-  ,("transform-origin:left top 1px",        "transform-origin:0 0 1px")
-  ,("transform-origin:top left 1px",        "transform-origin:0 0 1px")
-  ,("transform-origin:left bottom 1px",     "transform-origin:0 100% 1px")
-  ,("transform-origin:bottom left 1px",     "transform-origin:0 100% 1px")
-  ,("transform-origin:right top 1px",       "transform-origin:100% 0 1px")
-  ,("transform-origin:top right 1px",       "transform-origin:100% 0 1px")
-  ,("transform-origin:right bottom 1px",    "transform-origin:100% 100% 1px")
-  ,("transform-origin:bottom right 1px",    "transform-origin:100% 100% 1px")
-  ,("transform-origin:center bottom 1px",   "transform-origin:50% 100% 1px")
-  ,("transform-origin:bottom center 1px",   "transform-origin:50% 100% 1px")
-  ,("transform-origin:center top 1px",      "transform-origin:50% 0 1px")
-  ,("transform-origin:top center 1px",      "transform-origin:50% 0 1px")
-  ,("transform-origin:center right 1px",    "transform-origin:100% 50% 1px")
-  ,("transform-origin:right center 1px",    "transform-origin:100% 50% 1px")
-  ,("transform-origin:center left 1px",     "transform-origin:0 50% 1px")
-  ,("transform-origin:left center 1px",     "transform-origin:0 50% 1px")
-  ]
-
-
-declarationTestsInfo :: [(Text, Text)]
-declarationTestsInfo =
-  [("box-shadow:0 7px 0 #fefefe, 0 14px 0 #fefefe",
-    "box-shadow:0 7px 0 #fefefe,0 14px 0 #fefefe")
-  ]
-
-cleaningTests :: Spec
-cleaningTests =
-    describe "cleaning function" $
-      mapM_ (matchSpecWithDesc f) cleaningTestsInfo
-  where f = (Declarations . clean) <$> declarations
-
-cleaningTestsInfo :: [(String, Text, Text)]
-cleaningTestsInfo =
-  [("Merge margin with later margin-top",
-        "margin:0;margin-top:5px",
-        "margin:5px 0 0")
-  ,("Merge margin with later margin-right",
-        "margin:2px;margin-right:1in",
-        "margin:2px 1in 2px 2px")
-  ,("Merge margin with later margin-bottom",
-        "margin:auto;margin-bottom:.2em",
-        "margin:auto auto .2em")
-  ,("Merge margin with later margin-left",
-        "margin:fill;margin-left:9px",
-        "margin:fill fill fill 9px")
-  ,("Merge margin with later margin-top, with declaration in-between",
-        "margin:0;color:red;margin-top:5px",
-        "margin:5px 0 0;color:red")
-  ,("Merge margin with later margin-right, with declaration in-between",
-        "margin:2px;color:red;margin-right:1in",
-        "margin:2px 1in 2px 2px;color:red")
-  ,("Merge margin with later margin-bottom, with declaration in-between",
-        "margin:auto;color:red;margin-bottom:.2em",
-        "margin:auto auto .2em;color:red")
-  ,("Merge margin with later margin-left, with declaration in-between",
-        "margin:fill;color:red;margin-left:9px",
-        "margin:fill fill fill 9px;color:red")
-  ,("Drop a margin-top overwritten by a following margin",
-        "margin-top:5px;margin:0",
-        "margin:0")
-  ,("Drop a margin-right overwritten by a following margin",
-        "margin-right:1px;margin:2px",
-        "margin:2px")
-  ,("Drop a margin-bottom overwritten by a following margin",
-        "margin-bottom:.2em;margin:auto",
-        "margin:auto")
-  ,("Drop a margin-left overwritten by a following margin",
-        "margin-left:9px;margin:fill",
-        "margin:fill")
-  ,("Drop a margin-top overwritten by later margin, with a declaration in-between",
-        "margin-top:5px;padding:0;margin:0",
-        "padding:0;margin:0")
-  ,("Drop a margin-right overwritten by later margin, with a declaration in-between",
-        "margin-right:1px;padding:0;margin:2px",
-        "padding:0;margin:2px")
-  ,("Drop a margin-bottom overwritten by later margin, with a declaration in-between",
-        "margin-bottom:.2em;padding:0;margin:auto",
-        "padding:0;margin:auto")
-  ,("Drop a margin-left overwritten by later margin, with a declaration in-between",
-        "margin-left:9px;padding:0;margin:fill",
-        "padding:0;margin:fill")
-  ,("Drop a margin-top overwritten by a later margin-top, with a declaration in-between",
-        "margin-top:99px;color:red;margin-top:0",
-        "color:red;margin-top:0")
-  ,("Drop a margin-right overwritten by a later margin-right, with a declaration in-between",
-        "margin-right:99px;color:red;margin-right:0",
-        "color:red;margin-right:0")
-  ,("Drop a margin-bottom overwritten by a later margin-bottom, with a declaration in-between",
-        "margin-bottom:99px;color:red;margin-bottom:0",
-        "color:red;margin-bottom:0")
-  ,("Drop a margin-left overwritten by a later margin-left, with a declaration in-between",
-        "margin-left:99px;color:red;margin-left:0",
-        "color:red;margin-left:0")
-  ,("Drop a margin-top overwritten by a previous margin-top with !important",
-        "margin-top:99px!important;margin-top:0",
-        "margin-top:99px!important")
-  ,("Drop a margin-right overwritten by a previous margin-right with !important",
-        "margin-right:99px!important;margin-right:0",
-        "margin-right:99px!important")
-  ,("Drop a margin-bottom overwritten by a previous margin-bottom with !important",
-        "margin-bottom:99px!important;margin-bottom:0",
-        "margin-bottom:99px!important")
-  ,("Drop a margin-left overwritten by a previous margin-left with !important",
-        "margin-left:99px!important;margin-left:0",
-        "margin-left:99px!important")
-  ,("Drop a margin-top overwritten by a previous margin-top with !important, with a declaration in-between",
-        "margin-top:99px!important;margin:auto;margin-top:0",
-        "margin-top:99px!important;margin:auto")
-  ,("Drop a margin-right overwritten by a previous margin-right with !important, with a declaration in-between",
-        "margin-right:99px!important;margin:auto;margin-right:0",
-        "margin-right:99px!important;margin:auto")
-  ,("Drop a margin-bottom overwritten by a previous margin-bottom with !important, with a declaration in-between",
-        "margin-bottom:99px!important;margin:auto;margin-bottom:0",
-        "margin-bottom:99px!important;margin:auto")
-  ,("Drop a margin-left overwritten by a previous margin-left with !important, with a declaration in-between",
-        "margin-left:99px!important;margin:auto;margin-left:0",
-        "margin-left:99px!important;margin:auto")
-  -- ,("When merging, translate initial keyword to the initial value",
-        -- "margin:0;margin-top:initial",
-        -- "margin:0")
-  -- ,("When merging, translate unset keyword of a property that inherits to the initial value",
-        -- "margin:0;margin-top:unset",
-        -- "margin:0")
-  -- ,("Don't merge properties with inherit keyword",
-        -- "margin:0;margin-top:inherit",
-        -- "margin:0;margin-top:inherit")
-  ]
-
-minifyDecTests :: Spec
-minifyDecTests =
-    describe "minifyDec function" $
-      mapM_ (matchSpec (minifyWithTestConfig <$> declaration)) minifyDecTestsInfo
-
-shorthandInitialValuesTests :: Spec
-shorthandInitialValuesTests = do
-    testMatches "background minification" backgroundTestsInfo
-    testMatches "transition minification" transitionTestsInfo
-    testMatches "animation minification" animationTestsInfo
-    testMatches "font minification" fontTestsInfo
-    testMatches "outline minification" outlineTestsInfo
-    anyOrderShorthandTests
-  where testMatches :: String -> [(String, Text, Text)] -> SpecWith ()
-        testMatches desc i = describe desc $
-                          mapM_ (matchSpecWithDesc (minifyWithTestConfig <$> declaration)) i
-
-backgroundTestsInfo :: [(String, Text, Text)]
-backgroundTestsInfo =
-  [("Does not remove <position> from background when the <bg-size> cannot be removed",
-    "background: 0 0 / 3px", "background:0 0/3px")
-  ,("Removes <position> when it is the default and no <bg-size> is present",
-    "background: #fff 0 0", "background:#fff")
-  ,("Removes both <position> and <bg-size> when they are the default",
-    "background: #fff 0 0/auto", "background:#fff")
-  ,("Removes background-clip keyword when it equals the background-origin keyword",
-    "background: border-box #fff border-box", "background:border-box #fff")
-  ,("Removes the keywords for background-origin and background-clip when both are the initial ones",
-    "background: #fff padding-box border-box", "background:#fff")
-  ,("Removes the background-attachment keyword when it is the initial one",
-    "background: #fff scroll", "background:#fff")
-  ,("Removes the background-color value when it is the initial one",
-    "background: url(img.png) transparent", "background:url(img.png)")
-  ,("Removes background-image when it is the default (i.e. none)",
-    "background: none #fff", "background:#fff")
-  ,("Removes background-repeat when it is the default (i.e. repeat)",
-    "background: repeat #fff", "background:#fff")
-  ]
-
-transitionTestsInfo :: [(String, Text, Text)]
-transitionTestsInfo =
-  [("Removes transition-duration when it is the default",
-    "transition: ease-out some-property 0s", "transition:ease-out some-property")
-  ,("Removes transition-delay when it is the default",
-    "transition: ease-out 1s some-property 0s", "transition:ease-out 1s some-property")
-  ,("Leaves an initial (i.e. 0s) transition-duration when the transition-delay is not initial (i.e. also 0s)",
-    "transition: all 0s 1s ease", "transition:0s 1s")
-  ,("Removes transition-timing-function when it is the default",
-    "transition: some-property 1s ease", "transition:1s some-property")
-  ,("Removes transition-property when it is the default",
-    "transition: ease-out all 1s", "transition:ease-out 1s")
-  ,("Leaves only 0s when every present value is initial",
-    "transition: all 0s 0s ease", "transition:0s")
-  ]
-
-animationTestsInfo :: [(String, Text, Text)]
-animationTestsInfo =
-  [("Removes default animation-fill-mode when the animation-name doesn't overlap with its keywords",
-    "animation:none animName", "animation:animName")
-  ,("Leaves default animation-fill-mode when the animation-name overlaps with one of its keywords",
-    "animation:none backwards", "animation:none backwards")
-  ,("Removes default animation-fill-mode and default animation-name when both are used simultaneously",
-    "animation:ease-out none none", "animation:ease-out")
-  ,("Removes default animation-timing-function",
-    "animation:animName ease", "animation:animName")
-  ,("Removes default animation-duration",
-    "animation:0s ease-out", "animation:ease-out")
-  ,("Removes default animation-delay",
-    "animation:1s 0s ease-out", "animation:1s ease-out")
-  ,("Leaves default animation-duration when animation-delay is not the default",
-    "animation:0s 1s ease-out", "animation:0s 1s ease-out")
-  ,("Removes default animation-iteration-count",
-    "animation:1 ease-out", "animation:ease-out")
-  ,("Removes default animation-direction when the animation-name doesn't overlap with its keywords",
-    "animation:normal animName", "animation:animName")
-  ,("Leaves default animation-direction when the animation-name overlaps with one of its keywords",
-    "animation:normal alternate", "animation:normal alternate")
-  ,("Removes default animation-play-state when the animation-name doesn't overlap with its keywords",
-    "animation:running animName", "animation:animName")
-  ,("Leaves default animation-play-state when the animation-name overlaps with one of its keywords",
-    "animation:running paused", "animation:running paused")
-  ]
-
-fontTestsInfo :: [(String, Text, Text)]
-fontTestsInfo =
-  [("Removes default font-style",
-    "font:normal condensed bolder small-caps 9px/1 sans", "font:small-caps bolder condensed 9px/1 sans")
-  ,("Removes default font-variant",
-    "font:normal italic condensed bolder 9px/1 sans", "font:italic bolder condensed 9px/1 sans")
-  ,("Removes default font-weight",
-    "font:italic normal condensed small-caps 9px/1 sans", "font:italic small-caps condensed 9px/1 sans")
-  ,("Converts bold font-weight into 700",
-    "font:bold 9px sans", "font:700 9px sans")
-  ,("Removes default font-stretch",
-    "font:italic normal small-caps bolder 9px/1 sans", "font:italic small-caps bolder 9px/1 sans")
-  ,("Removes default line-height",
-    "font:9px/normal sans", "font:9px sans")
-  ,("Lowercases and removes quotes from font-family values",
-    "font:9px 'Arial Black', \"sans-serif\", sans", "font:9px arial black,\"sans-serif\",sans")
-  ]
-
--- Tests for the removal of outline initial values. Almost identical to those
--- shorthands in the anyOrderShorthandTests, except for the invert color.
-outlineTestsInfo :: [(String, Text, Text)]
-outlineTestsInfo =
-  [("Removes default outline-color",
-    "outline:invert solid 1px", "outline:solid 1px")
-  ,("Removes default outline-style",
-    "outline:#fff none 1px", "outline:#fff 1px")
-  ,("Removes default outline-width",
-    "outline:#fff solid medium", "outline:#fff solid")
-  ,("Leaves none as the shortest initial value",
-    "outline:invert", "outline:none")
-  ]
-
--- Tests for shorthands whose initial values are "medium none currentColor",
--- and can go on any order.
-anyOrderShorthandTests :: Spec
-anyOrderShorthandTests =
-    describe "Shorthands that accept values in any order (mostly: medium none currentColor)" $
-      traverse_ (mapM_ (matchSpec (minifyWithTestConfig <$> declaration))) d
-  where d = fmap f shorthandsToTest
-        f z = fmap (\(x,y) -> (z <> ":" <> x, z <> ":" <> y)) shorthandEquivalences
-        shorthandsToTest = ["border"
-                           ,"border-top"
-                           ,"border-right"
-                           ,"border-bottom"
-                           ,"border-left"
-                           ,"column-rule"]
-        shorthandEquivalences = [("initial",                   "none")
-                                ,("unset",                     "none")
-                                ,("none",                      "none")
-                                ,("medium",                    "none")
-                                ,("currentColor",              "none")
-                                ,("medium none",               "none")
-                                ,("medium currentColor",       "none")
-                                ,("none currentColor",         "none")
-                                ,("medium none currentColor",  "none")
-                                ,("medium none red",           "red")
-                                ,("thick none currentColor",   "thick")
-                                ,("thick dotted currentColor", "thick dotted")]
-
-minifyDecTestsInfo :: [(Text, Text)]
-minifyDecTestsInfo =
-  [("BORDER-bottom: initial",                   "border-bottom:none")
-  ,("BORDER-bottom: unset",                     "border-bottom:none")
-  ,("BORDER-bottom: none",                      "border-bottom:none")
-  ,("BORDER-bottom: medium",                    "border-bottom:none")
-  ,("BORDER-bottom: currentColor",              "border-bottom:none")
-  ,("BORDER-bottom: medium none",               "border-bottom:none")
-  ,("BORDER-bottom: medium currentColor",       "border-bottom:none")
-  ,("BORDER-bottom: none currentColor",         "border-bottom:none")
-  ,("BORDER-bottom: medium none currentColor",  "border-bottom:none")
-  ,("BORDER-bottom: medium none red",           "border-bottom:red")
-  ,("BORDER-bottom: thick none currentColor",   "border-bottom:thick")
-  ,("BORDER-bottom: thick dotted currentColor", "border-bottom:thick dotted")
-  ,("BORDER-bottom: 12px red",                  "border-bottom:9pt red")
--- widows inherits, and its initial value is 2
-  ,("widows: unset",   "widows:unset")
-  ,("widows: inherit", "widows:unset")
-  ,("widows: initial", "widows:2")
--- font-synthesis inherits, and its initial value is "weight style",
--- which are two keywords, both needed, in any order.
-  ,("font-synthesis: unset",        "font-synthesis:unset")
-  ,("font-synthesis: inherit",      "font-synthesis:unset")
-  ,("font-synthesis: initial",      "font-synthesis:initial")
-  ,("Font-synthesis: weight style", "font-synthesis:initial")
-  ,("font-synthesis: style weight", "font-synthesis:initial")
-  ,("font-synthesis: weight",       "font-synthesis:weight")
-  ,("font-synthesis: style",        "font-synthesis:style")
--- background-size: The first value gives the width of the corresponding image,
--- the second value its height. Its initial value is 'auto', and it doesn't
--- inherit. If only one value is given the second is assumed to be ‘auto’.
-  ,("background-size: 96px",      "background-size:6pc")
-  ,("background-size: auto",      "background-size:auto")
-  ,("background-size: unset",     "background-size:auto")
-  ,("background-size: initial",   "background-size:auto")
-  ,("background-size: auto auto", "background-size:auto")
-  ,("background-size: auto 96px", "background-size:auto 6pc")
-  ,("background-size: 96px auto", "background-size:6pc")
-  ]
-
-spec :: Spec
-spec = do cleaningTests
-          minifyDecTests
-          shorthandInitialValuesTests
-          declarationTests
-          propertySpecificTests
-
-main :: IO ()
-main = hspec spec
+{-# LANGUAGE OverloadedStrings #-}++module Hasmin.Types.DeclarationSpec where++import Data.Foldable (traverse_)+import Data.Monoid ((<>))+import Data.Text (Text)++import Hasmin.Parser.Internal+import Hasmin.TestUtils+import Hasmin.Types.Declaration++declarationTests :: Spec+declarationTests =+    describe "declaration" $+      mapM_ (matchSpec declaration) declarationTestsInfo++propertySpecificTests :: Spec+propertySpecificTests =+    describe "property specific changes" $+      mapM_ (matchSpec f) propertySpecificTestsInfo+  where f = minifyWithTestConfig <$> declaration++propertySpecificTestsInfo :: [(Text, Text)]+propertySpecificTestsInfo =+  [("font-family:Arial Black Long Name", "font-family:arial black long name")+  ,("font:9px Arial Black Long Name", "font:9px arial black long name")+  ,("font-family:\"SANS-SERIF\"", "font-family:\"sans-serif\"")+  ,("font-family:'Helvetica','Arial',sans-serif", "font-family:helvetica,arial,sans-serif")+  -- TODO make this work+  -- should fallback and parse till ';'+  -- ,("font-size:1em\nline-height:1.38;", "font-size:1em\nline-height:1.38;")++  ,("background-size:1px auto, 2px auto", "background-size:1px,2px")++  ,("text-shadow: 1px 1px 1px #ff0000", "text-shadow:1px 1px 1px red")+  ,("text-shadow: 12px 12px 12px", "text-shadow:9pt 9pt 9pt")+  ,("text-shadow: 1px 1px 0 green", "text-shadow:1px 1px green")+  ,("text-shadow: 1px 1px 0 green, 2px 2px 0 blue", "text-shadow:1px 1px green,2px 2px blue")++  ,("font-weight:normal", "font-weight:400")+  ,("font-weight:bold",   "font-weight:700")++  ,("word-spacing:normal",  "word-spacing:0")+  ,("word-spacing:initial", "word-spacing:0")+  ,("word-spacing:unset",   "word-spacing:unset")+  ,("word-spacing:inherit", "word-spacing:unset")++  ,("vertical-align:baseline", "vertical-align:0")+  ,("vertical-align:initial",  "vertical-align:0")+  ,("vertical-align:unset",    "vertical-align:0")++  ,("transform-origin:left top", "transform-origin:0 0")+  ,("transform-origin:left 0",   "transform-origin:0 0")+  ,("transform-origin:0 top",    "transform-origin:0 0")+  ,("transform-origin:0 0",      "transform-origin:0 0")+  ,("transform-origin:top left", "transform-origin:0 0")+  ,("transform-origin:top 0",    "transform-origin:0 0")+  ,("transform-origin:0 left",   "transform-origin:0 0")++  ,("transform-origin:left bottom", "transform-origin:0 100%")+  ,("transform-origin:0 bottom",    "transform-origin:0 100%")+  ,("transform-origin:left 100%",   "transform-origin:0 100%")+  ,("transform-origin:0 100%",      "transform-origin:0 100%")+  ,("transform-origin:bottom left", "transform-origin:0 100%")+  ,("transform-origin:100% left",   "transform-origin:0 100%")+  ,("transform-origin:bottom 0",    "transform-origin:0 100%")++  ,("transform-origin:right top", "transform-origin:100% 0")+  ,("transform-origin:100% top",  "transform-origin:100% 0")+  ,("transform-origin:right 0",   "transform-origin:100% 0")+  ,("transform-origin:top 100%",  "transform-origin:100% 0")+  ,("transform-origin:0% right",  "transform-origin:100% 0")+  ,("transform-origin:top right", "transform-origin:100% 0")++  ,("transform-origin:right bottom", "transform-origin:100% 100%")+  ,("transform-origin:100% bottom",  "transform-origin:100% 100%")+  ,("transform-origin:right 100%",   "transform-origin:100% 100%")+  ,("transform-origin:bottom 100%",  "transform-origin:100% 100%")+  ,("transform-origin:100% right",   "transform-origin:100% 100%")+  ,("transform-origin:bottom right", "transform-origin:100% 100%")++  ,("transform-origin:center bottom", "transform-origin:bottom")+  ,("transform-origin:50% bottom",    "transform-origin:bottom")+  ,("transform-origin:center 100%",   "transform-origin:bottom")+  ,("transform-origin:bottom 50%",    "transform-origin:bottom")+  ,("transform-origin:bottom center", "transform-origin:bottom")++  ,("transform-origin:center top", "transform-origin:top")+  ,("transform-origin:50% top",    "transform-origin:top")+  ,("transform-origin:center 0px", "transform-origin:top")+  ,("transform-origin:top 50%",    "transform-origin:top")+  ,("transform-origin:top center", "transform-origin:top")++  ,("transform-origin:center right", "transform-origin:100%")+  ,("transform-origin:50% right",    "transform-origin:100%")+  ,("transform-origin:right 50%",    "transform-origin:100%")+  ,("transform-origin:100% center",  "transform-origin:100%")+  ,("transform-origin:right center", "transform-origin:100%")++  ,("transform-origin:center left", "transform-origin:0")+  ,("transform-origin:50% left",    "transform-origin:0")+  ,("transform-origin:left 50%",    "transform-origin:0")+  ,("transform-origin:0% center",   "transform-origin:0")+  ,("transform-origin:left center", "transform-origin:0")++  ,("transform-origin:center",            "transform-origin:50%")+  ,("transform-origin:center center",     "transform-origin:50%")+  ,("transform-origin:center 50%",        "transform-origin:50%")+  ,("transform-origin:50% center",        "transform-origin:50%")+  ,("transform-origin:50% 50%",           "transform-origin:50%")+  ,("transform-origin:center center 0",   "transform-origin:50%")+  ,("transform-origin:center center 1px", "transform-origin:50% 50% 1px")++  ,("transform-origin:left 30px",   "transform-origin:0 30px")+  ,("transform-origin:30px left",   "transform-origin:0 30px")+  ,("transform-origin:right 30px",  "transform-origin:100% 30px")+  ,("transform-origin:30px right",  "transform-origin:100% 30px")+  ,("transform-origin:bottom 30px", "transform-origin:30px 100%")+  ,("transform-origin:30px bottom", "transform-origin:30px 100%")+  ,("transform-origin:top 30px",    "transform-origin:30px 0")+  ,("transform-origin:30px top",    "transform-origin:30px 0")+  ,("transform-origin:center 30px", "transform-origin:50% 30px")+  ,("transform-origin:30px center", "transform-origin:30px")++  -- 3 value syntax+  ,("transform-origin:left top 1px",        "transform-origin:0 0 1px")+  ,("transform-origin:top left 1px",        "transform-origin:0 0 1px")+  ,("transform-origin:left bottom 1px",     "transform-origin:0 100% 1px")+  ,("transform-origin:bottom left 1px",     "transform-origin:0 100% 1px")+  ,("transform-origin:right top 1px",       "transform-origin:100% 0 1px")+  ,("transform-origin:top right 1px",       "transform-origin:100% 0 1px")+  ,("transform-origin:right bottom 1px",    "transform-origin:100% 100% 1px")+  ,("transform-origin:bottom right 1px",    "transform-origin:100% 100% 1px")+  ,("transform-origin:center bottom 1px",   "transform-origin:50% 100% 1px")+  ,("transform-origin:bottom center 1px",   "transform-origin:50% 100% 1px")+  ,("transform-origin:center top 1px",      "transform-origin:50% 0 1px")+  ,("transform-origin:top center 1px",      "transform-origin:50% 0 1px")+  ,("transform-origin:center right 1px",    "transform-origin:100% 50% 1px")+  ,("transform-origin:right center 1px",    "transform-origin:100% 50% 1px")+  ,("transform-origin:center left 1px",     "transform-origin:0 50% 1px")+  ,("transform-origin:left center 1px",     "transform-origin:0 50% 1px")++  ,("overflow:unset",           "overflow:unset")+  ,("overflow:initial",         "overflow:unset")+  ,("overflow:visible",         "overflow:unset")+  ,("overflow:visible visible", "overflow:unset")+  ,("overflow:clip visible",    "overflow:clip visible")+  ,("overflow:visible clip",    "overflow:visible clip")+  ,("overflow:clip clip",       "overflow:clip")++  ,("overscroll-behavior:unset",           "overscroll-behavior:auto")+  ,("overscroll-behavior:initial",         "overscroll-behavior:auto")+  ,("overscroll-behavior:auto",            "overscroll-behavior:auto")+  ,("overscroll-behavior:auto auto",       "overscroll-behavior:auto")+  ,("overscroll-behavior:none auto",       "overscroll-behavior:none auto")+  ,("overscroll-behavior:auto none",       "overscroll-behavior:auto none")+  ,("overscroll-behavior:contain contain", "overscroll-behavior:contain")+  ,("overscroll-behavior:none none",       "overscroll-behavior:none")++  ,("border-bottom-left-radius:40% 40%",  "border-bottom-left-radius:40%")+  ,("border-bottom-right-radius:0 0",     "border-bottom-right-radius:0")+  ,("border-top-left-radius:initial",     "border-top-left-radius:0")+  ,("border-top-right-radius:5px 6px",    "border-top-right-radius:5px 6px")++  ,("text-emphasis-position:right over",  "text-emphasis-position:unset")+  ,("text-emphasis-position:over right",  "text-emphasis-position:unset")+  ,("text-emphasis-position:initial",     "text-emphasis-position:unset")+  ,("text-emphasis-position:over left",   "text-emphasis-position:over left")+  ,("text-emphasis-position:right under", "text-emphasis-position:right under")+  ]+++declarationTestsInfo :: [(Text, Text)]+declarationTestsInfo =+  [("box-shadow:0 7px 0 #fefefe, 0 14px 0 #fefefe",+    "box-shadow:0 7px 0 #fefefe,0 14px 0 #fefefe")+  ]++cleaningTests :: Spec+cleaningTests =+    describe "cleaning function" $+      mapM_ (matchSpecWithDesc f) cleaningTestsInfo+  where f = (Declarations . clean) <$> declarations++cleaningTestsInfo :: [(String, Text, Text)]+cleaningTestsInfo =+  [("Merge margin with later margin-top",+        "margin:0;margin-top:5px",+        "margin:5px 0 0")+  ,("Merge margin with later margin-right",+        "margin:2px;margin-right:1in",+        "margin:2px 1in 2px 2px")+  ,("Merge margin with later margin-bottom",+        "margin:auto;margin-bottom:.2em",+        "margin:auto auto .2em")+  ,("Merge margin with later margin-left",+        "margin:fill;margin-left:9px",+        "margin:fill fill fill 9px")+  ,("Merge margin with later margin-top, with declaration in-between",+        "margin:0;color:red;margin-top:5px",+        "margin:5px 0 0;color:red")+  ,("Merge margin with later margin-right, with declaration in-between",+        "margin:2px;color:red;margin-right:1in",+        "margin:2px 1in 2px 2px;color:red")+  ,("Merge margin with later margin-bottom, with declaration in-between",+        "margin:auto;color:red;margin-bottom:.2em",+        "margin:auto auto .2em;color:red")+  ,("Merge margin with later margin-left, with declaration in-between",+        "margin:fill;color:red;margin-left:9px",+        "margin:fill fill fill 9px;color:red")+  ,("Drop a margin-top overwritten by a following margin",+        "margin-top:5px;margin:0",+        "margin:0")+  ,("Drop a margin-right overwritten by a following margin",+        "margin-right:1px;margin:2px",+        "margin:2px")+  ,("Drop a margin-bottom overwritten by a following margin",+        "margin-bottom:.2em;margin:auto",+        "margin:auto")+  ,("Drop a margin-left overwritten by a following margin",+        "margin-left:9px;margin:fill",+        "margin:fill")+  ,("Drop a margin-top overwritten by later margin, with a declaration in-between",+        "margin-top:5px;padding:0;margin:0",+        "padding:0;margin:0")+  ,("Drop a margin-right overwritten by later margin, with a declaration in-between",+        "margin-right:1px;padding:0;margin:2px",+        "padding:0;margin:2px")+  ,("Drop a margin-bottom overwritten by later margin, with a declaration in-between",+        "margin-bottom:.2em;padding:0;margin:auto",+        "padding:0;margin:auto")+  ,("Drop a margin-left overwritten by later margin, with a declaration in-between",+        "margin-left:9px;padding:0;margin:fill",+        "padding:0;margin:fill")+  ,("Drop a margin-top overwritten by a later margin-top, with a declaration in-between",+        "margin-top:99px;color:red;margin-top:0",+        "color:red;margin-top:0")+  ,("Drop a margin-right overwritten by a later margin-right, with a declaration in-between",+        "margin-right:99px;color:red;margin-right:0",+        "color:red;margin-right:0")+  ,("Drop a margin-bottom overwritten by a later margin-bottom, with a declaration in-between",+        "margin-bottom:99px;color:red;margin-bottom:0",+        "color:red;margin-bottom:0")+  ,("Drop a margin-left overwritten by a later margin-left, with a declaration in-between",+        "margin-left:99px;color:red;margin-left:0",+        "color:red;margin-left:0")+  ,("Drop a margin-top overwritten by a previous margin-top with !important",+        "margin-top:99px!important;margin-top:0",+        "margin-top:99px!important")+  ,("Drop a margin-right overwritten by a previous margin-right with !important",+        "margin-right:99px!important;margin-right:0",+        "margin-right:99px!important")+  ,("Drop a margin-bottom overwritten by a previous margin-bottom with !important",+        "margin-bottom:99px!important;margin-bottom:0",+        "margin-bottom:99px!important")+  ,("Drop a margin-left overwritten by a previous margin-left with !important",+        "margin-left:99px!important;margin-left:0",+        "margin-left:99px!important")+  ,("Drop a margin-top overwritten by a previous margin-top with !important, with a declaration in-between",+        "margin-top:99px!important;margin:auto;margin-top:0",+        "margin-top:99px!important;margin:auto")+  ,("Drop a margin-right overwritten by a previous margin-right with !important, with a declaration in-between",+        "margin-right:99px!important;margin:auto;margin-right:0",+        "margin-right:99px!important;margin:auto")+  ,("Drop a margin-bottom overwritten by a previous margin-bottom with !important, with a declaration in-between",+        "margin-bottom:99px!important;margin:auto;margin-bottom:0",+        "margin-bottom:99px!important;margin:auto")+  ,("Drop a margin-left overwritten by a previous margin-left with !important, with a declaration in-between",+        "margin-left:99px!important;margin:auto;margin-left:0",+        "margin-left:99px!important;margin:auto")+  -- ,("When merging, translate initial keyword to the initial value",+        -- "margin:0;margin-top:initial",+        -- "margin:0")+  -- ,("When merging, translate unset keyword of a property that inherits to the initial value",+        -- "margin:0;margin-top:unset",+        -- "margin:0")+  -- ,("Don't merge properties with inherit keyword",+        -- "margin:0;margin-top:inherit",+        -- "margin:0;margin-top:inherit")+  ]++minifyDecTests :: Spec+minifyDecTests =+    describe "minifyDec function" $+      mapM_ (matchSpec (minifyWithTestConfig <$> declaration)) minifyDecTestsInfo++shorthandInitialValuesTests :: Spec+shorthandInitialValuesTests = do+    testMatches "background minification" backgroundTestsInfo+    testMatches "transition minification" transitionTestsInfo+    testMatches "animation minification" animationTestsInfo+    testMatches "font minification" fontTestsInfo+    testMatches "outline minification" outlineTestsInfo+    anyOrderShorthandTests+  where testMatches :: String -> [(String, Text, Text)] -> SpecWith ()+        testMatches desc i = describe desc $+                          mapM_ (matchSpecWithDesc (minifyWithTestConfig <$> declaration)) i++backgroundTestsInfo :: [(String, Text, Text)]+backgroundTestsInfo =+  [("Does not remove <position> from background when the <bg-size> cannot be removed",+    "background: 0 0 / 3px", "background:0 0/3px")+  ,("Removes <position> when it is the default and no <bg-size> is present",+    "background: #fff 0 0", "background:#fff")+  ,("Removes both <position> and <bg-size> when they are the default",+    "background: #fff 0 0/auto", "background:#fff")+  ,("Removes background-clip keyword when it equals the background-origin keyword",+    "background: border-box #fff border-box", "background:border-box #fff")+  ,("Removes the keywords for background-origin and background-clip when both are the initial ones",+    "background: #fff padding-box border-box", "background:#fff")+  ,("Removes the background-attachment keyword when it is the initial one",+    "background: #fff scroll", "background:#fff")+  ,("Removes the background-color value when it is the initial one",+    "background: url(img.png) transparent", "background:url(img.png)")+  ,("Removes background-image when it is the default (i.e. none)",+    "background: none #fff", "background:#fff")+  ,("Removes background-repeat when it is the default (i.e. repeat)",+    "background: repeat #fff", "background:#fff")+  ]++transitionTestsInfo :: [(String, Text, Text)]+transitionTestsInfo =+  [("Removes transition-duration when it is the default",+    "transition: ease-out some-property 0s", "transition:ease-out some-property")+  ,("Removes transition-delay when it is the default",+    "transition: ease-out 1s some-property 0s", "transition:ease-out 1s some-property")+  ,("Leaves an initial (i.e. 0s) transition-duration when the transition-delay is not initial (i.e. also 0s)",+    "transition: all 0s 1s ease", "transition:0s 1s")+  ,("Removes transition-timing-function when it is the default",+    "transition: some-property 1s ease", "transition:1s some-property")+  ,("Removes transition-property when it is the default",+    "transition: ease-out all 1s", "transition:ease-out 1s")+  ,("Leaves only 0s when every present value is initial",+    "transition: all 0s 0s ease", "transition:0s")+  ]++animationTestsInfo :: [(String, Text, Text)]+animationTestsInfo =+  [("Removes default animation-fill-mode when the animation-name doesn't overlap with its keywords",+    "animation:none animName", "animation:animName")+  ,("Leaves default animation-fill-mode when the animation-name overlaps with one of its keywords",+    "animation:none backwards", "animation:none backwards")+  ,("Removes default animation-fill-mode and default animation-name when both are used simultaneously",+    "animation:ease-out none none", "animation:ease-out")+  ,("Removes default animation-timing-function",+    "animation:animName ease", "animation:animName")+  ,("Removes default animation-duration",+    "animation:0s ease-out", "animation:ease-out")+  ,("Removes default animation-delay",+    "animation:1s 0s ease-out", "animation:1s ease-out")+  ,("Leaves default animation-duration when animation-delay is not the default",+    "animation:0s 1s ease-out", "animation:0s 1s ease-out")+  ,("Removes default animation-iteration-count",+    "animation:1 ease-out", "animation:ease-out")+  ,("Removes default animation-direction when the animation-name doesn't overlap with its keywords",+    "animation:normal animName", "animation:animName")+  ,("Leaves default animation-direction when the animation-name overlaps with one of its keywords",+    "animation:normal alternate", "animation:normal alternate")+  ,("Removes default animation-play-state when the animation-name doesn't overlap with its keywords",+    "animation:running animName", "animation:animName")+  ,("Leaves default animation-play-state when the animation-name overlaps with one of its keywords",+    "animation:running paused", "animation:running paused")+  ]++fontTestsInfo :: [(String, Text, Text)]+fontTestsInfo =+  [("Removes default font-style",+    "font:normal condensed bolder small-caps 9px/1 sans", "font:small-caps bolder condensed 9px/1 sans")+  ,("Removes default font-variant",+    "font:normal italic condensed bolder 9px/1 sans", "font:italic bolder condensed 9px/1 sans")+  ,("Removes default font-weight",+    "font:italic normal condensed small-caps 9px/1 sans", "font:italic small-caps condensed 9px/1 sans")+  ,("Converts bold font-weight into 700",+    "font:bold 9px sans", "font:700 9px sans")+  ,("Removes default font-stretch",+    "font:italic normal small-caps bolder 9px/1 sans", "font:italic small-caps bolder 9px/1 sans")+  ,("Removes default line-height",+    "font:9px/normal sans", "font:9px sans")+  ,("Lowercases and removes quotes from font-family values",+    "font:9px 'Arial Black', \"sans-serif\", sans", "font:9px arial black,\"sans-serif\",sans")+  ]++-- Tests for the removal of outline initial values. Almost identical to those+-- shorthands in the anyOrderShorthandTests, except for the invert color.+outlineTestsInfo :: [(String, Text, Text)]+outlineTestsInfo =+  [("Removes default outline-color",+    "outline:invert solid 1px", "outline:solid 1px")+  ,("Removes default outline-style",+    "outline:#fff none 1px", "outline:#fff 1px")+  ,("Removes default outline-width",+    "outline:#fff solid medium", "outline:#fff solid")+  ,("Leaves none as the shortest initial value",+    "outline:invert", "outline:none")+  ]++-- Tests for shorthands whose initial values are "medium none currentColor",+-- and can go on any order.+anyOrderShorthandTests :: Spec+anyOrderShorthandTests =+    describe "Shorthands that accept values in any order (mostly: medium none currentColor)" $+      traverse_ (mapM_ (matchSpec (minifyWithTestConfig <$> declaration))) d+  where d = fmap f shorthandsToTest+        f z = fmap (\(x,y) -> (z <> ":" <> x, z <> ":" <> y)) shorthandEquivalences+        shorthandsToTest = ["border"+                           ,"border-top"+                           ,"border-right"+                           ,"border-bottom"+                           ,"border-left"+                           ,"column-rule"]+        shorthandEquivalences = [("initial",                   "none")+                                ,("unset",                     "none")+                                ,("none",                      "none")+                                ,("medium",                    "none")+                                ,("currentColor",              "none")+                                ,("medium none",               "none")+                                ,("medium currentColor",       "none")+                                ,("none currentColor",         "none")+                                ,("medium none currentColor",  "none")+                                ,("medium none red",           "red")+                                ,("thick none currentColor",   "thick")+                                ,("thick dotted currentColor", "thick dotted")]++minifyDecTestsInfo :: [(Text, Text)]+minifyDecTestsInfo =+  [("BORDER-bottom: initial",                   "border-bottom:none")+  ,("BORDER-bottom: unset",                     "border-bottom:none")+  ,("BORDER-bottom: none",                      "border-bottom:none")+  ,("BORDER-bottom: medium",                    "border-bottom:none")+  ,("BORDER-bottom: currentColor",              "border-bottom:none")+  ,("BORDER-bottom: medium none",               "border-bottom:none")+  ,("BORDER-bottom: medium currentColor",       "border-bottom:none")+  ,("BORDER-bottom: none currentColor",         "border-bottom:none")+  ,("BORDER-bottom: medium none currentColor",  "border-bottom:none")+  ,("BORDER-bottom: medium none red",           "border-bottom:red")+  ,("BORDER-bottom: thick none currentColor",   "border-bottom:thick")+  ,("BORDER-bottom: thick dotted currentColor", "border-bottom:thick dotted")+  ,("BORDER-bottom: 12px red",                  "border-bottom:9pt red")+-- widows inherits, and its initial value is 2+  ,("widows: unset",   "widows:unset")+  ,("widows: inherit", "widows:unset")+  ,("widows: initial", "widows:2")+-- font-synthesis inherits, and its initial value is "weight style",+-- which are two keywords, both needed, in any order.+  ,("font-synthesis: unset",        "font-synthesis:unset")+  ,("font-synthesis: inherit",      "font-synthesis:unset")+  ,("font-synthesis: initial",      "font-synthesis:initial")+  ,("Font-synthesis: weight style", "font-synthesis:initial")+  ,("font-synthesis: style weight", "font-synthesis:initial")+  ,("font-synthesis: weight",       "font-synthesis:weight")+  ,("font-synthesis: style",        "font-synthesis:style")+-- background-size: The first value gives the width of the corresponding image,+-- the second value its height. Its initial value is 'auto', and it doesn't+-- inherit. If only one value is given the second is assumed to be ‘auto’.+  ,("background-size: 96px",      "background-size:6pc")+  ,("background-size: auto",      "background-size:auto")+  ,("background-size: unset",     "background-size:auto")+  ,("background-size: initial",   "background-size:auto")+  ,("background-size: auto auto", "background-size:auto")+  ,("background-size: auto 96px", "background-size:auto 6pc")+  ,("background-size: 96px auto", "background-size:6pc")+  ]++spec :: Spec+spec = do cleaningTests+          minifyDecTests+          shorthandInitialValuesTests+          declarationTests+          propertySpecificTests++main :: IO ()+main = hspec spec