diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,41 @@ # Changelog +This project adheres to [PVP](https://pvp.haskell.org). -## 0.3.3 +## 1.0 + +### Added +* `border-color-*`, `border-width-*` and `border-style-*` longhands are now + replaced by their shorthand, when the four corresponding longhands are + present in a rule. +* Style rules merging: merges pairs of rules that either have all the + same selectors, or all the same declarations. For it to be safe, it only does + so whenever two conditions don't meet: + 1. There is a rule in between with the same specificity + 2. This rule has a declaration that "clashes" (interferes) with one of the + declarations of the rules to be merged. + + By default it is enabled, but it can be disabled with `--no-rule-merging` (or + using a `Config` with `MergeRulesOn`). + +### Changed +* Replaced `--no-property-sorting` for `--sort-properties`. Now Hasmin doesn't + sort properties by default; sorting declarations became opt-in rather than + opt-out. This is because: + 1. Whether lexicographical sorting of properties aids compression varies a + lot from stylesheet to stylesheet, for some files it helps, for others it + hurts. + 2. The current implementation doesn't take into account all the possible + interactions between properties, making it unsafe. + +### Fixed +* Fixed non-exhaustive pattern bug introduced in 0.3.3 +* Fixed parser choking with rules that contained a semicolon but no + declarations, e.g. `div { ; }`. + +## 0.3.3 [YANKED] +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.: ```css @media all and (min-width: 24rem) { diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -12,21 +12,31 @@ import Codec.Compression.Hopfli import Control.Applicative (liftA2) +import System.Exit (die) +import Paths_hasmin (version) import Data.Monoid ((<>)) -import Data.Text (Text) -import Options.Applicative hiding (command) +import Data.Text (Text) +import Options.Applicative (Parser, ParserInfo, long, infoOption, fullDesc, + helper, execParser, help, header, flag, short, str, switch, info, + argument, metavar) import Data.Version (showVersion) import Development.GitRev (gitHash) -import Paths_hasmin (version) import qualified Data.ByteString as B import qualified Data.Text.Encoding as TE import qualified Data.Text.IO as TIO -import System.Exit (die) + import Hasmin.Config import Hasmin +type Instructions = (Commands, Config) + +data Commands = Commands { shouldBeautify :: Bool + , shouldCompress :: Bool + , file :: FilePath + } deriving (Show) + command :: Parser Commands -command = Commands +command = Commands <$> switch (long "beautify" <> short 'b' <> help "Beautify output") <*> switch (long "zopfli" <> short 'z' <> help "Compress result using zopfli") <*> argument str (metavar "FILE") @@ -40,7 +50,8 @@ <> short 'd' <> help "Enable normalization of absolute dimensions") <*> flag GradientMinOn GradientMinOff (long "-no-gradient-min" - <> short 'g' <> help "Disable minification") + <> short 'g' + <> help "Disable minification") <*> flag True False (long "no-property-traits" <> short 't' <> help "Disable use of property traits for declaration minification") @@ -51,44 +62,46 @@ <> help "Disable minifications") <*> flag True False (long "no-filter-function-min" <> help "Disable minifications") - <*> flag True False (long "no-quotes-removal" - <> short 'q' - <> help "Disable removing quotes whenever possible") - <*> flag FontWeightMinOn FontWeightMinOff (long "no-font-weight-minification" - <> help "Disable converting normal to 400 and bold to 700 in font-weight") - <*> flag True False (long "no-transform-origin-minification" - <> help "Disable converting left and top to 0%, bottom and right to 100%, and center to 50%") - <*> flag True False (long "no-microsyntax-min" - <> short 'm' - <> 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") - <*> switch (long "convert-escaped-characters" - <> help "Convert escaped characters to their UTF-8 equivalent") - <*> flag True False (long "no-null-percentage-conversion" - <> help "Disable converting 0% to 0 when possible") - <*> flag True False (long "no-empty-block-removal" - <> short 'e' - <> help "Disable empty block removal") - <*> flag True False (long "no-duplicate-selector-removal" - <> help "Disable removal of duplicate selectors") - <*> flag True False (long "no-quote-normalization" - <> help "Disable trying to convert all quotation marks to either \" or \'") - <*> flag Lowercase Original (long "no-lowercasing" - <> short 'l' - <> help "Disable lowercasing everything possible") - <*> flag Lexicographical NoSorting (long "no-selector-sorting" - <> help "Disable sorting selectors lexicographically") - <*> flag Lexicographical NoSorting (long "no-property-sorting" - <> help "Disable sorting properties lexicographically") + <*> flag True False (long "no-quotes-removal" + <> short 'q' + <> help "Disable removing quotes whenever possible") + <*> flag FontWeightMinOn FontWeightMinOff (long "no-font-weight-minification" + <> help "Disable converting normal to 400 and bold to 700 in font-weight") + <*> flag True False (long "no-transform-origin-minification" + <> help "Disable converting left and top to 0%, bottom and right to 100%, and center to 50%") + <*> flag True False (long "no-microsyntax-min" + <> short 'm' + <> 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") + <*> switch (long "convert-escaped-characters" + <> help "Convert escaped characters to their UTF-8 equivalent") + <*> flag True False (long "no-null-percentage-conversion" + <> help "Disable converting 0% to 0 when possible") + <*> flag True False (long "no-empty-block-removal" + <> short 'e' + <> help "Disable empty block removal") + <*> flag True False (long "no-duplicate-selector-removal" + <> help "Disable removal of duplicate selectors") + <*> flag True False (long "no-quote-normalization" + <> help "Disable trying to convert all quotation marks to either \" or \'") + <*> flag Lowercase Original (long "no-lowercasing" + <> short 'l' + <> help "Disable lowercasing everything possible") + <*> flag Lexicographical NoSorting (long "no-selector-sorting" + <> help "Disable sorting selectors lexicographically") + <*> flag NoSorting Lexicographical (long "sort-properties" + <> help "Disable sorting properties lexicographically") + <*> flag MergeRulesOn MergeRulesOff (long "no-rule-merging" + <> help "Disable merging style rules") instructions :: ParserInfo Instructions instructions = info (helper <*> versionOption <*> liftA2 (,) command config) (fullDesc <> header "Hasmin - A Haskell CSS Minifier") - where versionOption = infoOption (showVersion version <> " " <> $(gitHash)) + where versionOption = infoOption ("Hasmin " <> showVersion version <> " " <> take 8 $(gitHash)) (long "version" <> help "Show version and commit hash") main :: IO () diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,9 +5,6 @@ [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hasmin.svg?style=flat)](http://packdeps.haskellers.com/specific?package=hasmin) [![License](https://img.shields.io/badge/License-BSD%203--Clause-blue.svg)](https://opensource.org/licenses/BSD-3-Clause) -Hasmin is a CSS minifier written entirely in Haskell. To use it as a library, -see [below](https://github.com/contivero/hasmin#library) - Aside from the usual techniques (e.g. whitespace removal, color minification, etc.), the idea was to explore new possibilities, by implementing things other minifiers weren't doing, or they were, but not taking full advantage of. @@ -16,36 +13,69 @@ sizes, but attempt to improve post-compression sizes (at least when using DEFLATE, i.e. gzip). -For a list of techniques, see [Minification Techniques](https://github.com/contivero/hasmin/wiki/Minification-Techniques). +For a list of techniques, see [the wiki](https://github.com/contivero/hasmin/wiki). +To use it as a library, see +[below](https://github.com/contivero/hasmin#library). -## Building -To compile, just run `stack build`. +## Building & Installing +### Stack +The easiest and prefered way is using +[stack](https://docs.haskellstack.org/en/stable/README/). Clone the repo, then: +```sh +$ cd path/to/hasmin/repo +$ stack build +``` +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). +### Cabal +Alternatively, you can use [cabal](https://www.haskell.org/cabal/): +```sh +$ cd path/to/hasmin/repo +$ cabal update # Make sure to have the latest package list +$ cabal sandbox init # Initialise a sandbox +$ cabal install --only-dependencies # Install dependencies into the sandbox +$ cabal build # Build hasmin inside the sandbox +``` + ## Minifier Usage Hasmin expects a path to the CSS file, and outputs the minified result to -stdout. +stdout. Say you have a `sheet.css` and want to minify it, and save it as +`sheet.min.css`. Then, run: +```sh +$ hasmin sheet.css > sheet.min.css +``` Every technique is enabled by default, except for: - 1. Escaped character conversions (e.g. converting `\2714` to `✔`, which can be enabled with `--convert-escaped-characters`) - 2. Dimension minifications (e.g. converting `12px` to `9pt`, which can be enabled with `--dimension-min`, or just `-d`) + 1. Escaped character conversions (e.g. converting `\2714` into `✔`, enabled + with `--convert-escaped-characters`). + 2. Dimension minifications (e.g. converting `12px` to `9pt`, enabled with + `--dimension-min`, or just `-d`). + 3. Lexicographical sorting of declarations (enabled with + `--sort-declarations`). -These two are disabled mainly because they are—on average, not -always—detrimental for DEFLATE compression. When something needs to be -disabled, use the appropriate flag. Not every technique can be toggled yet, but -a good amount of them allow it. +The first two are disabled mainly because they are—on average, not +always—detrimental for DEFLATE compression. As for declaration sorting, whether +it benefits or hurts compression rates is very stylesheet-dependent, and the +current implementation is quite naive, hence unsafe. +When something needs to be disabled, use the appropriate flag. Not every +technique can be toggled, but if there is any one in particular that you need to +and can't, open an issue about it. + Note: there is a problem in Windows when using the `--convert-escaped-characters` flag to enable the conversion of escaped characters. A workaround is changing the code page, which can be done by running `chcp 65001` in the terminal (whether cmd, or cygwin). ## Library -The preferable way to use Hasmin as a library is to `import Hasmin`, as -exemplified in the module's documentation. That is currently the only module -that is sure to abide by [PVP](https://pvp.haskell.org/). Most other exposed -modules are so because tests need it, and thus definitions there may be changed -anytime. In case something internal is needed though, feel free to open an issue -about it. +The preferable way to use Hasmin as a library is to `import Hasmin`; a usage +example can be seen in the [module's documentation](https://hackage.haskell.org/package/hasmin/docs/Hasmin.html). +That is currently the only module that is sure to abide by +[PVP](https://pvp.haskell.org/). Most other exposed modules are so because tests +need it, and thus definitions there may be changed anytime. In case something +internal is needed though, feel free to open an issue about it. ## Zopfli Integration Hasmin uses bindings to Google's @@ -57,4 +87,4 @@ slower, so it is only a good idea if you don't need compression on the fly. -Zopfli is released under the Apache License, Version 2.0. +Zopfli is [released under the Apache License, Version 2.0](https://github.com/google/zopfli/blob/master/COPYING). diff --git a/hasmin.cabal b/hasmin.cabal --- a/hasmin.cabal +++ b/hasmin.cabal @@ -1,5 +1,5 @@ name: hasmin -version: 0.3.3.1 +version: 1.0 license: BSD3 license-file: LICENSE author: (c) 2017 Cristian Adrián Ontivero @@ -53,7 +53,7 @@ ghc-options: -O2 -Wall -fwarn-tabs -fwarn-unused-do-bind -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -Wredundant-constraints exposed-modules: Hasmin , Hasmin.Config - , Hasmin.Types.Class + , Hasmin.Class , Hasmin.Types.Stylesheet -- exposed because it is needed by tests: , Hasmin.Parser.Internal @@ -92,7 +92,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Spec.hs - ghc-options: -O2 -Wall -fwarn-tabs -fwarn-unused-do-bind -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-import-lists -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -Wredundant-constraints + ghc-options: -O2 -Wall -fwarn-tabs -fwarn-unused-do-bind -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -Wredundant-constraints default-extensions: OverloadedStrings other-modules: Hasmin.Parser.InternalSpec , Hasmin.Parser.ValueSpec diff --git a/src/Hasmin.hs b/src/Hasmin.hs --- a/src/Hasmin.hs +++ b/src/Hasmin.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : Hasmin @@ -25,7 +24,7 @@ import qualified Data.Text.Lazy as TL import Hasmin.Parser.Internal -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.Stylesheet import Hasmin.Config @@ -37,8 +36,9 @@ let rs = runReader (minifyRules sheet) cfg pure . TL.toStrict . toLazyText . mconcat $ map toBuilder rs --- | Minify Text CSS, using a default set of configurations (with most --- minification techniques enabled). +-- | Minify 'Text' CSS, using a default set of configurations (with most +-- minification techniques enabled). 'minifyCSS' is equivalent to +-- @'minifyCSSWith' 'defaultConfig'@. minifyCSS :: Text -> Either String Text minifyCSS = minifyCSSWith defaultConfig @@ -48,6 +48,8 @@ -- -- Given a style sheet, say: -- +-- > -- Note: We are using the OverloadedStrings extension here +-- > -- > sampleSheet :: Text -- > sampleSheet = "body { color: #ff0000 } div { margin: 0 0 0 0 }" -- diff --git a/src/Hasmin/Class.hs b/src/Hasmin/Class.hs new file mode 100644 --- /dev/null +++ b/src/Hasmin/Class.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE Safe #-} +----------------------------------------------------------------------------- +-- | +-- Module : Hasmin.Class +-- Copyright : (c) 2017 Cristian Adrián Ontivero +-- License : BSD3 +-- Stability : experimental +-- Portability : non-portable +-- +----------------------------------------------------------------------------- +module Hasmin.Class + ( ToText(..) + , Minifiable(..) + ) where + +import Control.Monad.Reader (Reader) +import Data.Word (Word8) +import Data.Text (pack, Text) +import Data.Text.Lazy (toStrict) +import Data.Text.Lazy.Builder (Builder, fromText, toLazyText) + +import Hasmin.Config + +-- | Class for types that can be minified +class Minifiable a where + {-# MINIMAL minify #-} + minify :: a -> Reader Config a + +-- | Class for types that can be converted to Text. Used for printing the +-- minified results. +class ToText a where + {-# MINIMAL toText | toBuilder #-} + toText :: a -> Text + toBuilder :: a -> Builder + toText = toStrict . toLazyText . toBuilder + toBuilder = fromText . toText +instance ToText Word8 where + toText = pack . show +instance ToText Int where + toText = pack . show +instance ToText Text where + toText = id +instance (ToText a, ToText b) => ToText (Either a b) where + toText = either toText toText + toBuilder = either toBuilder toBuilder diff --git a/src/Hasmin/Config.hs b/src/Hasmin/Config.hs --- a/src/Hasmin/Config.hs +++ b/src/Hasmin/Config.hs @@ -8,8 +8,8 @@ -- Portability : non-portable -- ----------------------------------------------------------------------------- -module Hasmin.Config ( - Config(..) +module Hasmin.Config + ( Config(..) , ColorSettings(..) , DimensionSettings(..) , GradientSettings(..) @@ -17,17 +17,9 @@ , LetterCase(..) , SortingMethod(..) , defaultConfig - , Instructions - , Commands(..) + , RulesMergeSettings(..) ) where -type Instructions = (Commands, Config) - -data Commands = Commands { shouldBeautify :: Bool - , shouldCompress :: Bool - , file :: FilePath - } deriving (Show) - data ColorSettings = ColorMinOff | ColorMinOn deriving (Show, Eq) data DimensionSettings = DimMinOff | DimMinOn @@ -41,39 +33,42 @@ deriving (Show, Eq) data FontWeightSettings = FontWeightMinOff | FontWeightMinOn deriving (Show, Eq) +data RulesMergeSettings = MergeRulesOn | MergeRulesOff + deriving (Show, Eq) -- TODO: * avoid boolean blindness -- * Use a more declarative style for the names, e.g. shouldLowercase vs. -- preferredCasing, shouldSortSelectors vs. selectorSorting, etc. -- | The configuration used for minifying. -data Config = Config { colorSettings :: ColorSettings - , dimensionSettings :: DimensionSettings - , gradientSettings :: GradientSettings - , shouldUsePropertyTraits :: Bool - , shouldCleanRules :: Bool - , shouldMinifyTimingFunctions :: Bool - , shouldMinifyFilterFunctions :: Bool - , shouldRemoveQuotes :: Bool - , fontweightSettings :: FontWeightSettings - , shouldMinifyTransformOrigin :: Bool - , shouldMinifyMicrosyntax :: Bool - , shouldMinifyKeyframeSelectors :: Bool - , shouldMinifyTransformFunction :: Bool - , shouldConvertEscaped :: Bool - , shouldConvertNullPercentages :: Bool - , shouldRemoveEmptyBlocks :: Bool +data Config = Config { colorSettings :: ColorSettings + , dimensionSettings :: DimensionSettings + , gradientSettings :: GradientSettings + , shouldUsePropertyTraits :: Bool + , shouldCleanRules :: Bool + , shouldMinifyTimingFunctions :: Bool + , shouldMinifyFilterFunctions :: Bool + , shouldRemoveQuotes :: Bool + , fontweightSettings :: FontWeightSettings + , shouldMinifyTransformOrigin :: Bool + , shouldMinifyMicrosyntax :: Bool + , shouldMinifyKeyframeSelectors :: Bool + , shouldMinifyTransformFunction :: Bool + , shouldConvertEscaped :: Bool + , shouldConvertNullPercentages :: Bool + , shouldRemoveEmptyBlocks :: Bool , shouldRemoveDuplicateSelectors :: Bool - , shouldNormalizeQuotes :: Bool - , letterCase :: LetterCase - , selectorSorting :: SortingMethod - , declarationSorting :: SortingMethod + , shouldNormalizeQuotes :: Bool + , letterCase :: LetterCase + , selectorSorting :: SortingMethod + , declarationSorting :: SortingMethod + , rulesMergeSettings :: RulesMergeSettings } deriving (Show) -- | A default config with most settings enabled. Used by the minify function, -- mainly for testing purposes. defaultConfig :: Config defaultConfig = Config { colorSettings = ColorMinOn - , dimensionSettings = DimMinOn + , dimensionSettings = DimMinOff , gradientSettings = GradientMinOn , shouldUsePropertyTraits = True , shouldCleanRules = True @@ -93,4 +88,5 @@ , letterCase = Lowercase , selectorSorting = NoSorting , declarationSorting = NoSorting + , rulesMergeSettings = MergeRulesOn } diff --git a/src/Hasmin/Parser/Internal.hs b/src/Hasmin/Parser/Internal.hs --- a/src/Hasmin/Parser/Internal.hs +++ b/src/Hasmin/Parser/Internal.hs @@ -8,10 +8,12 @@ -- Portability : unknown -- ----------------------------------------------------------------------------- -module Hasmin.Parser.Internal ( - stylesheet +module Hasmin.Parser.Internal + ( stylesheet , atRule + , styleRule , rule + , rules , declaration , declarations , selector @@ -45,9 +47,10 @@ import Hasmin.Types.Declaration import Hasmin.Types.String +-- | Parser for CSS complex selectors (see 'Selector' for more details). selector :: Parser Selector -selector = Selector <$> compoundSelector - <*> many ((,) <$> combinator <* skipComments <*> compoundSelector) +selector = Selector <$> compoundSelector <*> combinatorsAndSelectors + where combinatorsAndSelectors = many ((,) <$> combinator <* skipComments <*> compoundSelector) -- First tries with '>>' (descendant), '>' (child), '+' (adjacent sibling), and -- '~' (general sibling) combinators. If those fail, it tries with the @@ -69,12 +72,13 @@ <*> many p <|> ((Universal mempty :|) <$> many1 p) where p = idSel <|> classSel <|> attributeSel <|> pseudo - +-- | Parses a \"number sign\" (U+0023, \#) immediately followed by the ID value, +-- which must be a CSS identifier. idSel :: Parser SimpleSelector idSel = do - _ <- char '#' + _ <- char '#' name <- mconcat <$> many1 nmchar - pure $ IdSel (TL.toStrict (toLazyText name)) + pure . IdSel . TL.toStrict $ toLazyText name -- class: '.' IDENT classSel :: Parser SimpleSelector @@ -218,10 +222,11 @@ selectors :: Parser [Selector] selectors = lexeme selector `sepBy` char ',' +-- | Parser for a declaration, starting by the property name. declaration :: Parser Declaration declaration = do p <- property <* colon - v <- values p <|> valuesFallback + v <- valuesFor p <|> valuesFallback i <- important ie <- lexeme iehack pure $ Declaration p v i ie @@ -242,10 +247,12 @@ iehack :: Parser Bool iehack = option False (string "\\9" $> True) --- | Parses a list of declarations, ignoring spaces, comments, and empty +-- Note: The handleSemicolons outside is needed to handle parsing "h1 { ; }". +-- +-- | Parser for a list of declarations, ignoring spaces, comments, and empty -- declarations (e.g. ; ;) declarations :: Parser [Declaration] -declarations = many (declaration <* handleSemicolons) +declarations = many (declaration <* handleSemicolons) <* handleSemicolons where handleSemicolons = many (string ";" *> skipComments) -- | Parser for CSS at-rules (e.g. \@keyframes, \@media) @@ -336,12 +343,20 @@ _ <- char '}' pure $ AtSupports sc r +-- | Parser for a , +-- needed by @\@supports@ rules. supportsCondition :: Parser SupportsCondition supportsCondition = asciiCI "not" *> skipComments *> (Not <$> supportsCondInParens) - <|> supportsConjunction - <|> supportsDisjunction - <|> (Parens <$> supportsCondInParens) + <|> supportsConjunction + <|> supportsDisjunction + <|> (Parens <$> supportsCondInParens) + where + supportsDisjunction :: Parser SupportsCondition + supportsDisjunction = supportsHelper Or "or" + supportsConjunction :: Parser SupportsCondition + supportsConjunction = supportsHelper And "and" + supportsCondInParens :: Parser SupportsCondInParens supportsCondInParens = do _ <- char '(' @@ -352,7 +367,7 @@ atSupportsDeclaration :: Parser Declaration atSupportsDeclaration = do p <- property <* colon - v <- values p <|> valuesInParens + v <- valuesFor p <|> valuesInParens pure $ Declaration p v False False -- customPropertyIdent :: Parser Text @@ -365,12 +380,6 @@ xs <- some (asciiCI t *> lexeme supportsCondInParens) pure $ c x (NE.fromList xs) -supportsConjunction :: Parser SupportsCondition -supportsConjunction = supportsHelper And "and" - -supportsDisjunction :: Parser SupportsCondition -supportsDisjunction = supportsHelper Or "or" - -- TODO clean code -- the "manyTill .. lookAhead" was added because if we only used "rules", it -- doesn't know when to stop, and breaks the parser @@ -398,17 +407,18 @@ rules :: Parser [Rule] rules = manyTill (rule <* skipComments) endOfInput +-- | Parse a stylesheet, starting by the \@charset, \@import and \@namespace +-- rules, followed by the list of rules, and ignoring any unneeded whitespace +-- and comments. stylesheet :: Parser [Rule] stylesheet = do - charset <- option [] ((:[]) <$> atCharset <* skipComments) - imports <- many (atImport <* skipComments) + charset <- option [] ((:[]) <$> atCharset <* skipComments) + imports <- many (atImport <* skipComments) namespaces <- many (atNamespace <* skipComments) _ <- skipComments -- if there is no charset, import, or namespace at rule we need this here. rest <- rules pure $ charset <> imports <> namespaces <> rest --- data AtRule = AtMedia (Maybe [MediaQuery]) - -- | Media Feature values. Per the -- , -- \ only accepts dpi and dpcm units, dppx was added later. @@ -441,6 +451,7 @@ h = lexeme (asciiCI "and" *> satisfy C.isSpace) optionalNotOrOnly = option mempty (asciiCI "not" <|> asciiCI "only") +-- https://www.w3.org/TR/mediaqueries-4/#typedef-media-condition-without-or expression :: Parser Expression expression = char '(' *> skipComments *> (expr <|> expFallback) where expr = do @@ -450,8 +461,7 @@ pure $ Expression e v expFallback = InvalidExpression <$> A.takeWhile (/= ')') <* char ')' - - +-- TODO implement the whole spec 4, or at least 3. -- Note: The code below pertains to CSS Media Queries Level 4. -- Since it is still too new and nobody implements it (afaik), -- I leave it here for future reference, when the need to cater for it diff --git a/src/Hasmin/Parser/Utils.hs b/src/Hasmin/Parser/Utils.hs --- a/src/Hasmin/Parser/Utils.hs +++ b/src/Hasmin/Parser/Utils.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | --- Module : Hasmin.Parser.Internal +-- Module : Hasmin.Parser.Utils -- Copyright : (c) 2017 Cristian Adrián Ontivero -- License : BSD3 -- Stability : experimental @@ -11,10 +11,11 @@ module Hasmin.Parser.Utils ( ident , fontfamilyname - , nonquotedurl + , unquotedURL , skipComments , lexeme , functionParser + , digits , comma , colon , opt @@ -23,7 +24,7 @@ import Control.Applicative ((<|>), many) import Control.Monad (void, mzero) -import Data.Attoparsec.Text (char, +import Data.Attoparsec.Text (char, many1, digit, option, Parser, satisfy, skipSpace, string, takeWhile1, ()) import Data.Monoid ((<>)) import Data.Text (Text) @@ -37,6 +38,7 @@ skipComments :: Parser () skipComments = void $ many (skipSpace *> comment) <* skipSpace +-- | Parse a comment, i.e. a string starting with \"\/\*\" and ending with \"\*\/\" comment :: Parser Text comment = mappend <$> string "/*" <*> (string "*/" <|> untilAsterisk) where untilAsterisk = mappend <$> A.takeWhile (/= '*') <*> checkAsterisk @@ -51,11 +53,15 @@ lexeme :: Parser a -> Parser a lexeme p = skipComments *> p <* skipComments +-- | Given a parser, makes it optional, defaulting to whatever value its 'Monoid' +-- instance defines for 'mempty'. opt :: Monoid m => Parser m -> Parser m opt = option mempty -nonquotedurl :: Parser Text -nonquotedurl = do +-- | Parse a URL without enclosing quotes. +-- See +unquotedURL :: Parser Text +unquotedURL = do t <- many (escape <|> (LB.singleton <$> satisfy validChar)) pure $ TL.toStrict (toLazyText (mconcat t)) where validChar x = x /= '\"' && x /= '\'' && x /= '(' && x /= ')' @@ -119,7 +125,11 @@ where ws x = x == ' ' || x == '\n' || x == '\r' || x == '\t' || x == '\f' -- | Assumes the identifier and the left parenthesis have been parsed --- Parses p, ignoring comments before and after it, and consumes the final --- right parenthesis +-- Parses p, ignoring surrounding whitespace and comments, and consumes the +-- final right parenthesis. functionParser :: Parser a -> Parser a functionParser p = lexeme p <* char ')' + +-- | Parser one or more digits. +digits :: Parser String +digits = many1 digit diff --git a/src/Hasmin/Parser/Value.hs b/src/Hasmin/Parser/Value.hs --- a/src/Hasmin/Parser/Value.hs +++ b/src/Hasmin/Parser/Value.hs @@ -12,18 +12,17 @@ -- ----------------------------------------------------------------------------- module Hasmin.Parser.Value ( - values - , percentage - , value + valuesFor , valuesFallback + , value , valuesInParens , stringOrUrl + , percentage , url , stringtype - , digits , textualvalue - , stringvalue - , shadowList + , stringvalue -- used in StringSpec + , shadowList -- used in ShadowSpec , timingFunction , repeatStyle , position @@ -36,8 +35,8 @@ import Control.Arrow (first, (&&&)) import Control.Monad (mzero) import Data.Functor (($>)) -import Data.Attoparsec.Text (asciiCI, char, choice, count, many1, - option, Parser, satisfy, skipSpace, string, digit) +import Data.Attoparsec.Text (asciiCI, char, count, option, Parser, satisfy, + skipSpace, string) import Data.Map.Strict (Map) import Data.Monoid ((<>)) import Data.Maybe (fromMaybe, isNothing) @@ -45,16 +44,17 @@ import Data.Word (Word8) import Data.Char (isAscii) import Text.Parser.Permutation ((<|?>), (<$$>), (<$?>), (<||>), permute) -import qualified Data.Set as Set import Numeric (readSigned, readFloat) +import qualified Data.Set as Set import qualified Data.Attoparsec.Text as A import qualified Data.Char as C import qualified Data.Map.Strict as Map +import qualified Data.List as L import qualified Data.Text as T import Hasmin.Parser.Utils import Hasmin.Types.BgSize -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.Color import Hasmin.Types.Dimension import Hasmin.Types.FilterFunction @@ -69,11 +69,15 @@ import Hasmin.Types.TransformFunction import Hasmin.Types.Value -values :: Text -> Parser Values -values p = case Map.lookup (T.toLower p) propertyValueParsersMap of - Just x -> x <* skipComments - Nothing -> mzero +-- | Given a propery name, it returns a specific parser of values for that +-- property. Fails if no specific parser is found. +valuesFor :: Text -> Parser Values +valuesFor propName = + case Map.lookup (T.toLower propName) propertyValueParsersMap of + Just x -> x <* skipComments + Nothing -> mzero +-- | Parser for >. number :: Parser Number number = Number <$> rational @@ -113,17 +117,26 @@ hexvalue :: Parser Value hexvalue = ColorV <$> hex --- TODO improve this parser hex :: Parser Color -hex = char '#' *> (constructHex <$> choice ps) - where hexadecimal = satisfy C.isHexDigit - ps = [count 8 hexadecimal, count 6 hexadecimal, - count 4 hexadecimal, count 3 hexadecimal] - constructHex [r,g,b] = mkHex3 r g b - constructHex [r,g,b,a] = mkHex4 r g b a - constructHex [r1,r2,g1,g2,b1,b2] = mkHex6 [r1,r2] [g1,g2] [b1,b2] - constructHex [r1,r2,g1,g2,b1,b2,a1,a2] = mkHex8 [r1,r2] [g1,g2] [b1,b2] [a1,a2] - constructHex _ = error "invalid list size for a hex color" +hex = do + _ <- char '#' + a <- hexadecimal + b <- hexadecimal + c <- hexadecimal + x <- optional hexadecimal + case x of + Nothing -> pure $ mkHex3 a b c + Just d -> do y <- optional hexadecimal + case y of + Nothing -> pure $ mkHex4 a b c d + Just e -> do f <- hexadecimal + z <- optional hexadecimal + case z of + Nothing -> pure $ mkHex6 [a,b] [c,d] [e,f] + Just g -> do h <- hexadecimal + pure $ mkHex8 [a,b] [c,d] [e,f] [g,h] + where optional w = option Nothing (Just <$> w) + hexadecimal = satisfy C.isHexDigit -- --------------------------------------------------------------------------- -- Dimensions Parsers @@ -146,7 +159,7 @@ ,("dpcm", resolutionFunc Dpcm) ,("dppx", resolutionFunc Dppx) ,("%", \x -> PercentageV (Percentage $ toRational x)) - ] ++ (fmap . fmap) (DistanceV .) distanceConstructorsList + ] ++ (fmap . fmap) (LengthV .) distanceConstructorsList ++ (fmap . fmap) (AngleV .) angleConstructorsList -- Unified numerical parser. @@ -175,12 +188,12 @@ Just f -> pure $ f n Nothing -> mzero -- parsed units aren't angle units, fail -distance :: Parser Distance -distance = dimensionParser distanceConstructorsMap (Distance 0 Q) +distance :: Parser Length +distance = dimensionParser distanceConstructorsMap NullLength where distanceConstructorsMap = Map.fromList distanceConstructorsList angle :: Parser Angle -angle = dimensionParser angleConstructorsMap (Angle 0 Deg) +angle = dimensionParser angleConstructorsMap NullAngle where angleConstructorsMap = Map.fromList angleConstructorsList duration :: Parser Duration @@ -199,10 +212,11 @@ angleConstructorsList = fmap (toText &&& flip Angle) [Deg, Grad, Rad, Turn] -distanceConstructorsList :: [(Text, Number -> Distance)] -distanceConstructorsList = fmap (toText &&& flip Distance) +distanceConstructorsList :: [(Text, Number -> Length)] +distanceConstructorsList = fmap (toText &&& flip Length) [EM, EX, CH, VH, VW, VMIN, VMAX, REM, Q, CM, MM, IN, PC, PT, PX] +-- | Parser for >. percentage :: Parser Percentage percentage = Percentage <$> rational <* char '%' @@ -225,16 +239,13 @@ int :: Parser Int int = read <$> int' -digits :: Parser String -digits = many1 digit - word8 :: Parser Word8 word8 = read <$> digits -- Note that many properties that allow an integer or real number as a value -- actually restrict the value to some range, often to a non-negative value. -- --- | Real numbers parser. \: <'int' integer> | [0-9]*.[0-9]+ +-- | Real number parser. \: <'int' integer> | [0-9]*.[0-9]+ rational :: Parser Rational rational = do sign <- option [] (wrapMinus <$> (char '-' <|> char '+')) @@ -244,10 +255,10 @@ pure . fst . head $ readSigned readFloat (sign ++ dgts ++ e) where fractionalPart = (:) <$> char '.' <*> digits expo = (:) <$> satisfy (\c -> c == 'e' || c == 'E') <*> int' - wrapMinus x = if x == '-' -- we use this since read fails with leading '+' - then [x] - else [] + wrapMinus x = [x | x == '-'] -- we use this since read fails with leading '+' +-- | Parser for >, +-- used in the @font-style@ and @font@ properties. fontStyle :: Parser Value fontStyle = do k <- ident @@ -269,7 +280,7 @@ fontSize :: Parser Value fontSize = fontSizeKeyword - <|> (DistanceV <$> distance) + <|> (LengthV <$> distance) <|> (PercentageV <$> percentage) where fontSizeKeyword = do v1 <- ident @@ -287,10 +298,11 @@ -} --- TODO clean this parser!! +-- TODO clean parsers pos1, pos2, and pos4 positionvalue :: Parser Value positionvalue = PositionV <$> position +-- | Parser for >. position :: Parser Position position = pos4 <|> pos2 <|> pos1 @@ -358,7 +370,7 @@ (v1, v2) <- ((,) <$> yAxis <*> (skipComments *> (xAxis <|> numericalvalue))) <|> ((,) <$> xAxis <*> (skipComments *> (yAxis <|> numericalvalue))) <|> ((,) <$> numericalvalue <*> (skipComments *> (yAxis <|> xAxis))) - option (mkValues [v1,v2]) ((\x -> mkValues [v1,v2, DistanceV x]) <$> distance) + option (mkValues [v1,v2]) ((\x -> mkValues [v1,v2, LengthV x]) <$> distance) yAxis = do v1 <- ident if v1 == "top" || v1 == "bottom" || v1 == "center" @@ -376,10 +388,9 @@ where cover = asciiCI "cover" $> Cover contain = asciiCI "contain" $> Contain twovaluesyntax = do - v1 <- (Left <$> percentageLength) <|> (Right <$> auto) - _ <- skipComments - v2 <- option Nothing (Just <$> ((Left <$> percentageLength) <|> (Right <$> auto))) - pure $ BgSize v1 v2 + x <- bgsizeValue <* skipComments + (BgSize2 x <$> bgsizeValue) <|> pure (BgSize1 x) + bgsizeValue = (Left <$> percentageLength) <|> (Right <$> auto) bgAttachment :: Parser TextV bgAttachment = matchKeywords ["scroll", "fixed", "local"] @@ -493,6 +504,7 @@ else pure $ TextV i excludedKeywords = Set.fromList ["initial", "inherit", "unset", "default", "none"] +-- | Parser for >. timingFunction :: Parser TimingFunction timingFunction = do i <- ident @@ -580,13 +592,6 @@ singleValue :: Parser Value -> Parser Values singleValue = (flip Values [] <$>) -value :: Parser Value -value = textualvalue - <|> numericalvalue - <|> hexvalue - <|> (StringV <$> stringtype) - <|> invalidvalue - -- | Parses until the end of the declaration, i.e. ';' or '}'. -- Used to deal with invalid input, or an IE specific hack. invalidvalue :: Parser Value @@ -610,7 +615,7 @@ case n of NumberV _ -> pure n PercentageV _ -> pure n - DistanceV _ -> pure n + LengthV _ -> pure n _ -> mzero in (Other <$> parseIdents ["normal"]) <|> validNum fontWeightNumber :: Parser Value @@ -760,23 +765,22 @@ where someUrl :: Parser Url someUrl = asciiCI "url" *> char '(' *> url --- parser, for background-repeat. +-- | Parser for >, +-- used in @background-repeat@ and @background@. repeatStyle :: Parser RepeatStyle repeatStyle = do i <- ident let lowercased = T.toLower i - case Map.lookup lowercased singleKeywords of + case L.lookup lowercased singleKeywords of Nothing -> case Map.lookup lowercased keywordPairs of Nothing -> mzero - Just y -> do j <- option Nothing secondKeyword - pure $ RSPair y j + Just y -> (RepeatStyle2 y <$> secondKeyword) + <|> pure (RepeatStyle1 y) Just x -> pure x where secondKeyword = do z <- skipComments *> ident - case Map.lookup (T.toLower z) keywordPairs of - Nothing -> mzero - Just a -> pure $ Just a - singleKeywords = Map.fromList [("repeat-x", RepeatX), ("repeat-y", RepeatY)] + maybe mzero pure $ Map.lookup (T.toLower z) keywordPairs + singleKeywords = [("repeat-x", RepeatX), ("repeat-y", RepeatY)] keywordPairs = Map.fromList [("repeat", RsRepeat) ,("no-repeat", RsNoRepeat) ,("space", RsSpace) @@ -894,6 +898,8 @@ l3 <- option Nothing ((Just <$> distance) <* skipComments) pure (l1,l2,l3) +-- | Parser for > +-- values, used in the @box-shadow@ property. shadowList :: Parser Values shadowList = parseCommaSeparated (ShadowV <$> shadow) @@ -996,6 +1002,7 @@ colorStop = ColorStop <$> color <* skipComments <*> option Nothing (Just <$> percentageLength <* skipComments) +-- | Parser for >. color :: Parser Color color = hex <|> othercolor where othercolor = do @@ -1010,8 +1017,8 @@ n <- numericalvalue case n of PercentageV p -> pure $ Left p - NumberV 0 -> pure $ Right (Distance 0 PX) - DistanceV d -> pure $ Right d + NumberV 0 -> pure $ Right NullLength + LengthV d -> pure $ Right d _ -> mzero numberPercentage :: Parser (Either Number Percentage) @@ -1098,11 +1105,13 @@ where startOrEnd = (asciiCI "end" $> End) <|> (asciiCI "start" $> Start) --- We use skipSpace instead of skipComments, since comments aren't valid inside +-- It uses skipSpace instead of skipComments, since comments aren't valid inside -- the url-token. From the spec: -- COMMENT tokens cannot occur within other tokens: thus, "url(/*x*/pic.png)" -- denotes the URI "/*x*/pic.png", not "pic.png". --- Assumes "url(" has been already parsed +-- +-- | Parser for >. Assumes +-- @\"url(\"@ has already been parsed. url :: Parser Url url = Url <$> (skipSpace *> someUri <* skipSpace <* char ')') where someUri = (Right <$> stringtype) <|> (Left <$> nonQuotedUri) @@ -1119,10 +1128,16 @@ where f x xs = let a = fst x in (a, pure $ ColorV (Named a)) : xs --- | For cases when CSS hacks are used, e.g.: --- margin-top: 1px \9; +-- | For cases when CSS hacks are used, e.g.: @margin-top: 1px \\9;@. valuesFallback :: Parser Values valuesFallback = Values <$> value <*> many ((,) <$> separator <*> value) <* skipComments + +value :: Parser Value +value = textualvalue + <|> numericalvalue + <|> hexvalue + <|> (StringV <$> stringtype) + <|> invalidvalue separator :: Parser Separator separator = lexeme $ (char ',' $> Comma) diff --git a/src/Hasmin/Properties.hs b/src/Hasmin/Properties.hs --- a/src/Hasmin/Properties.hs +++ b/src/Hasmin/Properties.hs @@ -10,495 +10,376 @@ ----------------------------------------------------------------------------- module Hasmin.Properties ( PropertyInfo(..) - , shorthandAndLonghandsMap + , Inheritance(..) , propertiesTraits ) where +import Control.Applicative ((<|>)) import Data.Attoparsec.Text (parseOnly) import Data.Text (Text) -import Control.Applicative ((<|>)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map + import Hasmin.Types.Value import Hasmin.Parser.Value --- TODO see if this can be extended to contain all the information from a --- property (such as initial value). Otherwise, delete it. -data PropertyInfo = - PropertyInfo { overwrittenBy :: [Text] -- shorthands that overwrite it - , subproperties :: [Text] -- longhands that can be merged into it - } deriving (Show) - -shorthandAndLonghandsMap :: Map Text PropertyInfo -shorthandAndLonghandsMap = Map.fromList properties +data Inheritance = Inherited | NonInherited + deriving (Eq, Show) --- This holds the information of which shorthand overwrites which longhand, and --- vice versa (which longhand is overwritten by which shorthand). -properties :: [(Text,PropertyInfo)] -properties = - [("animation", PropertyInfo mempty ["animation-name","animation-duration","animation-timing-function","animation-delay","animation-iteration-count","animation-direction","animation-fill-mode","animation-play-state"]) - ,("animation-delay", PropertyInfo ["animation"] mempty) - ,("animation-direction", PropertyInfo ["animation"] mempty) - ,("animation-duration", PropertyInfo ["animation"] mempty) - ,("animation-fill-mode", PropertyInfo ["animation"] mempty) - ,("animation-iteration-count", PropertyInfo ["animation"] mempty) - ,("animation-name", PropertyInfo ["animation"] mempty) - ,("animation-play-state", PropertyInfo ["animation"] mempty) - ,("animation-timing-function", PropertyInfo ["animation"] mempty) - ,("background", PropertyInfo mempty ["background-image", "background-position", "background-size", "background-repeat", "background-origin", "background-clip", "background-attachment", "background-color"]) - ,("background-attachment", PropertyInfo ["background"] mempty) - ,("background-clip", PropertyInfo ["background"] mempty) - ,("background-color", PropertyInfo ["background"] mempty) - ,("background-image", PropertyInfo ["background"] mempty) - ,("background-origin", PropertyInfo ["background"] mempty) - ,("background-position", PropertyInfo ["background"] ["background-position-x", "background-position-y"]) - ,("background-position-x", PropertyInfo ["background", "background-position"] mempty) - ,("background-position-y", PropertyInfo ["background", "background-position"] mempty) - ,("background-repeat", PropertyInfo ["background"] mempty) - ,("background-size", PropertyInfo ["background"] mempty) - ,("border", PropertyInfo mempty ["border-width", "border-style", "border-color"]) - ,("border-bottom", PropertyInfo ["border"] ["border-bottom-color", "border-bottom-style", "border-bottom-width"]) - ,("border-bottom-color", PropertyInfo ["border", "border-color", "border-bottom"] mempty) - ,("border-bottom-left-radius", PropertyInfo ["border-radius"] mempty) - ,("border-bottom-right-radius", PropertyInfo ["border-radius"] mempty) - ,("border-bottom-style", PropertyInfo ["border", "border-style", "border-bottom"] mempty) - ,("border-bottom-width", PropertyInfo ["border", "border-width", "border-bottom"] mempty) - ,("border-color", PropertyInfo ["border"] ["border-top-color", "border-right-color", "border-bottom-color", "border-left-color"]) - ,("border-image", PropertyInfo ["border"] ["border-image-source", "border-image-slice", "border-image-width", "border-image-outset", "border-image-repeat"]) - ,("border-image-outset", PropertyInfo ["border", "border-image"] mempty) - ,("border-image-repeat", PropertyInfo ["border", "border-image"] mempty) - ,("border-image-slice", PropertyInfo ["border", "border-image"] mempty) - ,("border-image-source", PropertyInfo ["border", "border-image"] mempty) - ,("border-image-width", PropertyInfo ["border", "border-image"] mempty) - ,("border-left", PropertyInfo ["border"] ["border-left-color", "border-left-style", "border-left-width"]) - ,("border-left-color", PropertyInfo ["border", "border-color", "border-left"] mempty) - ,("border-left-style", PropertyInfo ["border", "border-style", "border-left"] mempty) - ,("border-left-width", PropertyInfo ["border", "border-width", "border-left"] mempty) - ,("border-radius", PropertyInfo mempty ["border-top-left-radius","border-top-right-radius","border-bottom-right-radius","border-bottom-left-radius"]) - ,("border-right", PropertyInfo ["border"] ["border-right-color", "border-right-style", "border-right-width"]) - ,("border-right-color", PropertyInfo ["border", "border-color", "border-right"] mempty) - ,("border-right-style", PropertyInfo ["border", "border-style", "border-right"] mempty) - ,("border-right-width", PropertyInfo ["border", "border-width", "border-right"] mempty) - ,("border-style", PropertyInfo ["border"] ["border-top-style", "border-right-style", "border-bottom-style", "border-left-style"]) - ,("border-top", PropertyInfo ["border"] ["border-top-color", "border-top-style", "border-top-width"]) - ,("border-top-color", PropertyInfo ["border", "border-color", "border-top"] mempty) - ,("border-top-left-radius", PropertyInfo ["border-radius"] mempty) - ,("border-top-right-radius", PropertyInfo ["border-radius"] mempty) - ,("border-top-style", PropertyInfo ["border", "border-style", "border-top"] mempty) - ,("border-top-width", PropertyInfo ["border", "border-width", "border-top"] mempty) - ,("border-width", PropertyInfo ["border"] ["border-top-width", "border-right-width", "border-bottom-width", "border-left-width"]) - ,("column-count", PropertyInfo ["columns"] mempty) - ,("column-rule", PropertyInfo mempty ["column-rule-color", "column-rule-style", "column-rule-width"]) - ,("column-rule-color", PropertyInfo ["column-rule"] mempty) - ,("column-rule-style", PropertyInfo ["column-rule"] mempty) - ,("column-rule-width", PropertyInfo ["column-rule"] mempty) - ,("columns", PropertyInfo mempty ["column-width", "column-count"]) - ,("column-width", PropertyInfo ["columns"] mempty) - ,("flex", PropertyInfo mempty ["flex-grow", "flex-shrink", "flex-basis"]) - ,("flex-basis", PropertyInfo ["flex"] mempty) - ,("flex-direction", PropertyInfo ["flex-flow"] mempty) - ,("flex-flow", PropertyInfo mempty ["flex-direction", "flex-wrap"]) - ,("flex-grow", PropertyInfo ["flex"] mempty) - ,("flex-shrink", PropertyInfo ["flex"] mempty) - ,("flex-wrap", PropertyInfo ["flex-flow"] mempty) - ,("font", PropertyInfo mempty ["font-style", "font-variant", "font-weight", "font-stretch", "font-size", "line-height", "font-family"]) - ,("font-family", PropertyInfo ["font"] mempty) - ,("font-kerning", PropertyInfo ["font"] mempty) - ,("font-language-override", PropertyInfo ["font"] mempty) - ,("font-size", PropertyInfo ["font"] mempty) - ,("font-size-adjust", PropertyInfo ["font"] mempty) - ,("font-stretch", PropertyInfo ["font"] mempty) - ,("font-style", PropertyInfo ["font"] mempty) - ,("font-variant", PropertyInfo ["font"] mempty) - ,("font-weight", PropertyInfo ["font"] mempty) - ,("grid", PropertyInfo mempty ["grid-template-rows", "grid-template-columns", "grid-template-areas", "grid-auto-rows", "grid-auto-columns", "grid-auto-flow", "grid-column-gap", "grid-row-gap"]) - ,("grid-area", PropertyInfo mempty ["grid-row-start", "grid-row-end", "grid-column-start", "grid-column-end"]) - ,("grid-column", PropertyInfo mempty ["grid-column-start", "grid-column-end"]) - ,("grid-column-end", PropertyInfo ["grid-column", "grid-area"] mempty) - ,("grid-column-end", PropertyInfo ["grid-column", "grid-area"] mempty) - ,("grid-column-gap", PropertyInfo ["grid-gap"] mempty) - ,("grid-gap", PropertyInfo mempty ["grid-row-gap", "grid-column-gap"]) - ,("grid-row", PropertyInfo mempty ["grid-row-start", "grid-row-end"]) - ,("grid-row-end", PropertyInfo ["grid-row", "grid-area"] mempty) - ,("grid-row-gap", PropertyInfo ["grid-gap"] mempty) - ,("grid-row-start", PropertyInfo ["grid-row", "grid-area"] mempty) - ,("grid-template", PropertyInfo mempty ["grid-template-columns", "grid-template-rows", "grid-template-areas"]) - ,("grid-template-areas", PropertyInfo ["grid-template"] mempty) - ,("grid-template-columns", PropertyInfo ["grid-template"] mempty) - ,("grid-template-rows", PropertyInfo ["grid-template"] mempty) - ,("line-height", PropertyInfo ["font"] mempty) - ,("list-style", PropertyInfo mempty ["list-style-type", "list-style-position", "list-style-image"]) - ,("list-style-image", PropertyInfo ["list-style"] mempty) - ,("list-style-position", PropertyInfo ["list-style"] mempty) - ,("list-style-type", PropertyInfo ["list-style"] mempty) - ,("margin", PropertyInfo mempty ["margin-top", "margin-right", "margin-bottom", "margin-left"]) - ,("margin-bottom", PropertyInfo ["margin"] mempty) - ,("margin-left", PropertyInfo ["margin"] mempty) - ,("margin-right", PropertyInfo ["margin"] mempty) - ,("margin-top", PropertyInfo ["margin"] mempty) - ,("mask", PropertyInfo mempty ["mask-clip", "mask-origin", "mask-border"]) - ,("mask-border", PropertyInfo ["mask"] ["mask-border-source", "mask-border-slice", "mask-border-width", "mask-border-outset", "mask-border-repeat"]) - ,("mask-border-outset", PropertyInfo ["mask", "mask-border"] mempty) - ,("mask-border-repeat", PropertyInfo ["mask", "mask-border"] mempty) - ,("mask-border-slice", PropertyInfo ["mask", "mask-border"] mempty) - ,("mask-border-source", PropertyInfo ["mask", "mask-border"] mempty) - ,("mask-border-width", PropertyInfo ["mask", "mask-border"] mempty) - ,("mask-clip", PropertyInfo ["mask"] mempty) - ,("mask-composite", PropertyInfo ["mask"] mempty) - ,("mask-image", PropertyInfo ["mask"] mempty) - ,("mask-mode", PropertyInfo ["mask"] mempty) - ,("mask-origin", PropertyInfo ["mask"] mempty) - ,("mask-position", PropertyInfo ["mask"] mempty) - ,("mask-repeat", PropertyInfo ["mask"] mempty) - ,("mask-size", PropertyInfo ["mask"] mempty) - ,("outline", PropertyInfo mempty ["outline-width", "outline-style", "outline-color"]) - ,("outline-color", PropertyInfo ["outline"] mempty) - ,("outline-style", PropertyInfo ["outline"] mempty) - ,("outline-width", PropertyInfo ["outline"] mempty) - ,("padding", PropertyInfo mempty ["padding-top", "padding-right", "padding-bottom", "padding-left"]) - ,("padding-bottom", PropertyInfo ["padding"] mempty) - ,("padding-left", PropertyInfo ["padding"] mempty) - ,("padding-right", PropertyInfo ["padding"] mempty) - ,("padding-top", PropertyInfo ["padding"] mempty) - ,("text-decoration", PropertyInfo mempty ["text-decoration-color", "text-decoration-style", "text-decoration-line"]) - ,("text-decoration-color", PropertyInfo ["text-decoration"] mempty) - ,("text-decoration-line", PropertyInfo ["text-decoration"] mempty) - ,("text-decoration-style", PropertyInfo ["text-decoration"] mempty) - ,("text-emphasis", PropertyInfo mempty ["text-emphasis-color", "text-emphasis-style"]) - ,("text-emphasis-color", PropertyInfo ["text-emphasis"] mempty) - ,("text-emphasis-style", PropertyInfo ["text-emphasis"] mempty) - ,("transition", PropertyInfo mempty ["transition-property", "transition-duration", "transition-timing-function", "transition-delay"]) - ,("transition-delay", PropertyInfo ["transition"] mempty) - ,("transition-duration", PropertyInfo ["transition"] mempty) - ,("transition-property", PropertyInfo ["transition"] mempty) - ,("transition-timing-function", PropertyInfo ["transition"] mempty) - ] +data PropertyInfo = + PropertyInfo { initialValues :: Maybe Values + , inheritance :: Inheritance + , overwrittenBy :: [Text] -- shorthands that overwrite it + , subproperties :: [Text] -- longhands that can be merged into it + } deriving (Show) --- mempty is used when there is no initial value, or for properties that need --- special treatment, such as many of the shorthands -propertiesTraits :: Map Text (Maybe Values, Bool) -propertiesTraits = Map.fromList $ replaceTextWithValues - [("align-content", ("stretch", False)) - ,("align-items", ("stretch", False)) - ,("align-self", ("auto", False)) - ,("all", (mempty, False)) -- No practical initial value - ,("animation", (mempty, False)) -- shorthand - ,("animation-delay", ("0s", False)) -- experimental - ,("animation-direction", ("normal", False)) -- experimental - ,("animation-duration", ("0s", False)) -- experimental - ,("animation-fill-mode", ("none", False)) -- experimental - ,("animation-iteration-count", ("1", False)) -- experimental - ,("animation-name", ("none", False)) -- experimental - ,("animation-play-state", ("running", False)) -- experimental - ,("animation-timing-function", ("ease", False)) -- experimental - ,("backface-visibility", ("visible", False)) - ,("-webkit-backface-visibility", ("visible", False)) - ,("backdrop-filter", ("none", False)) -- experimental - ,("-webkit-backdrop-filter", ("none", False)) -- experimental - ,("background", (mempty {-shorthand-}, False)) - ,("background-attachment", ("scroll", False)) - ,("background-blend-mode", ("normal", False)) - ,("background-clip", ("border-box", False)) - ,("-webkit-background-clip", ("border-box", False)) - ,("background-color", ("transparent", False)) - ,("background-image", ("none", False)) - ,("background-origin", ("padding-box", False)) - ,("background-position", (mempty, False)) --shorthand - ,("background-position-x", ("left", False)) - ,("background-position-inline", (mempty {-not applicable-}, False)) - ,("background-position-block", (mempty {-not applicable-}, False)) - ,("background-position-y", ("top", False)) - ,("background-repeat", ("repeat", False)) - ,("background-size", ("auto", False)) - ,("block-size", ("auto", False)) -- experimental - ,("border", ("medium none currentcolor", False)) -- shorthand! - -- border-block-* would go here - ,("border-bottom", ("medium none currentcolor", False)) -- shorthand! - ,("border-bottom-color", ("currentcolor", False)) - ,("border-bottom-left-radius", ("0", False)) - ,("border-bottom-right-radius", ("0", False)) - ,("border-bottom-style", ("none", False)) - ,("border-bottom-width", ("medium", False)) - ,("border-collapse", ("separate", True)) - ,("border-color", (mempty, False)) -- shorthand! - ,("border-image", (mempty, False)) -- shorthand - ,("border-image-outset", ("0", False)) - ,("border-image-repeat", ("stretch", False)) - ,("border-image-slice", ("100%", False)) - ,("border-image-source", ("none", False)) - ,("border-image-width", ("1", False)) - -- border-inline-* would go here - ,("border-left", ("medium none currentcolor", False)) -- shorthand! - ,("border-left-color", ("currentcolor", False)) - ,("border-left-style", ("none", False)) - ,("border-left-width", ("medium", False)) - -- ,("border-radius" -- shorthand - ,("border-right", ("medium none currentcolor", False)) -- shorthand! - ,("border-right-color", ("currentcolor", False)) - ,("border-right-style", ("none", False)) - ,("border-right-width", ("medium", False)) - ,("border-spacing", ("0", True)) - -- ,("border-style" -- shorthand - ,("border-top", ("medium none currentcolor", False)) -- shorthand - ,("border-top-color", ("currentcolor", False)) - ,("border-top-style", ("none", False)) - ,("border-top-width", ("medium", False)) - ,("border-top-left-radius", ("0", False)) - ,("border-top-right-radius", ("0", False)) - -- ,("border-width" -- shorthand - ,("bottom", ("auto", False)) - ,("box-decoration-break", ("slice", False)) -- experimental - ,("-webkit-box-decoration-break", ("slice", False)) -- experimental - ,("-o-box-decoration-break", ("slice", False)) -- experimental - ,("box-shadow", ("none", False)) - ,("-webkit-box-shadow", ("none", False)) - ,("box-sizing", ("content-box", False)) -- experimental - ,("-webkit-box-sizing", ("content-box", False)) -- experimental - ,("-moz-box-sizing", ("content-box", False)) -- experimental - ,("break-after", ("auto", False)) - ,("break-before", ("auto", False)) - ,("break-inside", ("auto", False)) - ,("caption-side", ("top", True)) - ,("clear", ("none", False)) - ,("clip", ("auto", False)) -- deprecated! - ,("color", (mempty {-UA dependent-}, True)) - ,("column-count", ("auto", False)) - ,("column-fill", ("balance", False)) - ,("column-gap", ("normal", False)) - ,("column-rule", ("medium none currentcolor", False)) -- shorthand - ,("column-rule-color", ("currentcolor", False)) - ,("column-rule-style", ("none", False)) - ,("column-rule-width", ("medium", False)) - ,("column-span", ("none", False)) - ,("column-width", ("auto", False)) - -- ,("columns", -- shorthand - ,("content", ("normal", False)) - ,("counter-increment", ("none", False)) - ,("counter-reset", ("none", False)) - ,("cursor", ("auto", True)) - ,("direction", ("ltr", True)) - ,("display", ("inline", False)) - ,("empty-cells", ("show", True)) - ,("filter", ("none", False)) -- experimental - ,("-webkit-filter", ("none", False)) -- experimental - -- ,("flex", ("0", False)) -- shorthand - ,("flex-basis", ("auto", False)) - ,("flex-direction", ("row", False)) - ,("flex-flow", ("row nowrap", False)) -- shorthand - ,("flex-grow", ("0", False)) - ,("flex-shrink", ("1", False)) - ,("flex-wrap", ("nowrap", False)) - ,("float", ("none", False)) - ,("float", ("none", False)) - ,("font", (mempty {-shorthand-}, True)) - ,("font-family", (mempty {-UA dependent-}, True)) - ,("font-feature-settings", ("normal", True)) - ,("font-kerning", ("auto", True)) - ,("font-language-override", ("normal", True)) - ,("font-size", ("medium", True)) - ,("font-size-adjust", ("none", True)) - ,("font-stretch", ("normal", True)) - ,("font-style", ("normal", True)) - ,("font-synthesis", ("weight style", True)) - ,("font-variant", ("normal", True)) - ,("font-variant-alternates", ("normal", True)) - ,("font-variant-caps", ("normal", True)) - ,("font-variant-east-asian", ("normal", True)) - ,("font-variant-ligatures", ("normal", True)) - ,("font-variant-numeric", ("normal", True)) - ,("font-variant-position", ("normal", True)) - ,("font-weight", ("normal", True)) - -- grid -- shorthand, experimental - -- grid-area -- shorthand, experimental - ,("grid-auto-columns", ("auto", False)) -- experimental - ,("-ms-grid-auto-columns", ("auto", False)) -- experimental - ,("-webkit-grid-auto-columns", ("auto", False)) -- experimental - ,("grid-auto-flow", ("row", False)) -- experimental - ,("-webkit-grid-auto-flow", ("row", False)) -- experimental - ,("grid-auto-rows", ("auto", False)) -- experimental - ,("-ms-grid-auto-rows", ("auto", False)) -- experimental - ,("-webkit-grid-auto-rows", ("auto", False)) -- experimental - -- grid-column -- shorthand, experimental - ,("grid-column-end", ("auto", False)) -- experimental - ,("-ms-grid-column-end", ("auto", False)) -- experimental - ,("-webkit-grid-column-end", ("auto", False)) -- experimental - ,("grid-column-gap", ("0", False)) -- experimental - ,("-ms-grid-column-gap", ("0", False)) -- experimental - ,("grid-column-start", ("auto", False)) -- experimental - ,("-ms-grid-column-start", ("auto", False)) -- experimental - ,("-webkit-grid-column-start", ("auto", False)) -- experimental - -- ,("grid-gap", -- shorthand, experimental - -- ,("grid-row", -- shorthand, experimental - ,("grid-row-end", ("auto", False)) -- experimental - ,("-ms-grid-row-end", ("auto", False)) -- experimental - ,("-webkit-grid-row-end", ("auto", False)) -- experimental - ,("grid-row-gap", ("0", False)) -- experimental - ,("-webkit-grid-row-gap", ("0", False)) -- experimental - ,("grid-row-start", ("auto", False)) -- experimental - ,("-ms-grid-row-start", ("auto", False)) -- experimental - ,("-webkit-grid-row-start", ("auto", False)) -- experimental - -- ,("grid-template", -- shorthand, experimental - ,("grid-template-areas", ("none", False)) -- experimental - ,("-webkit-grid-template-areas", ("none", False)) -- experimental - ,("grid-template-columns", ("none", False)) -- experimental - ,("-ms-grid-template-columns", ("none", False)) -- experimental - ,("-webkit-grid-template-columns", ("none", False)) -- experimental - ,("grid-template-rows", ("none", False)) -- experimental - ,("-ms-grid-template-rows", ("none", False)) -- experimental - ,("-webkit-grid-template-rows", ("none", False)) -- experimental - ,("height", ("auto", False)) - ,("hyphens", ("manual", False)) - -- ,("image-orientation" --experimental - -- ,("image-rendering" --experimental - -- ,("inline-size", -- experimental - ,("isolation", ("auto", False)) - ,("justify-content", ("flex-start", False)) - ,("left", ("auto", False)) - ,("letter-spacing", ("normal", True)) - ,("line-break", ("auto", False)) - ,("line-height", ("normal", True)) - ,("list-style", ("none disc outside", True)) -- none must go first, for entropy reasons. - ,("list-style-image", ("none", True)) - ,("list-style-position", ("outside", True)) - ,("list-style-type", ("disc", True)) - ,("margin", (mempty {-shorthand-}, False)) -- shorthand - -- ,("margin-block-* -- experimental - ,("margin-bottom", ("0", False)) - -- ,("margin-inline-*" --experimental - ,("margin-left", ("0", False)) - ,("margin-right", ("0", False)) - ,("margin-top", ("0", False)) - -- ,("mask", -- shorthand - ,("mask-clip", ("border-box", False)) -- experimental - ,("-webkit-mask-clip", ("border-box", False)) -- experimental - ,("mask-composite", ("add", False)) -- experimental - ,("mask-image", ("none", False)) -- experimental - ,("-webkit-mask-image", ("none", False)) -- experimental - -- ,("mask-mode", ("match-source", False)) -- experimental, no support - ,("mask-origin", ("border-box", False)) -- experimental - ,("-webkit-mask-origin", ("border-box", False)) -- experimental - ,("mask-position", ("center", False)) -- experimental - ,("-webkit-mask-position", ("center", False)) -- experimental - ,("mask-repeat", ("no-repeat", False)) -- experimental - ,("-webkit-mask-repeat", ("no-repeat", False)) -- experimental - ,("mask-size", ("auto", False)) -- experimental - ,("mask-type", ("luminance", False)) -- experimental - -- ,("max-block-size", ("0", False)) -- experimental - ,("max-height", ("none", False)) - -- ,("max-inline-size", ("0", False)) -- experimental - ,("max-width", ("none", False)) - -- ,("min-block-size", ("0", False)) -- experimental - ,("min-height", ("0", False)) - -- ,("min-inline-size", ("0", False)) -- experimental - ,("min-width", ("0", False)) - ,("mix-blend-mode", ("normal", False)) - ,("object-fit", ("fill", True)) - ,("object-position", ("50% 50%", True)) - -- ,("offset-*", ("auto", False)) -- experimental - ,("opacity", ("1", False)) - ,("order", ("0", False)) - ,("orphans", ("2", True)) - ,("outline", ("medium none invert", False)) -- shorthand - ,("outline-color", ("invert" , False)) - ,("outline-offset", ("0", False)) - ,("outline-style", ("none", False)) - ,("outline-width", ("medium", False)) - ,("overflow", ("visible", False)) - ,("overflow-wrap", ("normal", True)) -- also called word-wrap - ,("overflow-x", ("visible", False)) -- experimental - ,("overflow-y", ("visible", False)) -- experimental - ,("padding", (mempty, False)) -- shorthand - -- ,("padding-block*", ("0", False)) -- experimental - ,("padding-bottom", ("0", False)) - -- ,("padding-inline-*", ("0", False)) -- experimental - ,("padding-left", ("0", False)) - ,("padding-right", ("0", False)) - ,("padding-top", ("0", False)) - ,("page-break-after", ("auto", False)) - ,("page-break-before", ("auto", False)) - ,("page-break-inside", ("auto", False)) - ,("perspective", ("none", False)) -- experimental - ,("perspective-origin", ("50% 50%", False)) -- experimental - ,("pointer-events", ("auto", True)) - ,("position", ("static", False)) - ,("quotes", (mempty {-UA dependent-}, True)) - ,("resize", ("none", False)) - ,("right", ("auto", False)) - ,("right", ("auto", False)) - -- ,("ruby-*", -- experimental - ,("scroll-behavior", ("auto", False)) - -- ,("scroll-snap-coordinate", ("none", False)) -- experimental - -- ,("scroll-snap-destination",("0 0", False)) -- experimental, actually 0px 0px - -- ,("scroll-snap-type", -- experimental - ,("shape-image-threshold", ("0", False)) - ,("shape-margin", ("0", False)) - ,("shape-outside", ("none", False)) - ,("tab-size", ("8", True)) -- experimental - ,("-moz-tab-size", ("8", True)) -- experimental - ,("-o-tab-size", ("8", True)) -- experimental - ,("table-layout", ("auto", False)) - ,("text-align", ("start", False)) - ,("text-align-last", ("auto", True)) -- experimental - ,("text-combine-upright", ("none", True)) -- experimental - ,("-webkit-text-combine-upright", ("none", True)) -- experimental - ,("text-decoration", ("currentcolor solid none", False)) -- shorthand - ,("text-decoration-color", ("currentcolor", False)) - ,("text-decoration-line", ("none", False)) - ,("text-decoration-style", ("solid", False)) - ,("text-emphasis", ("none currentcolor", False)) -- shorthand - ,("text-emphasis-color", ("currentcolor", False)) - ,("text-emphasis-position", (mempty {-"over right"-}, False)) - ,("text-emphasis-style", ("none", False)) - ,("text-indent", ("0", True)) - ,("text-orientation", ("mixed", True)) -- experimental - ,("-webkit-text-orientation", ("mixed", True)) -- experimental - ,("text-overflow", ("clip", False)) - ,("text-rendering", ("auto", True)) - ,("text-shadow", ("none", True)) - ,("text-transform", ("none", True)) - ,("text-underline-position", ("auto", True)) - ,("top", ("auto", False)) - ,("touch-action", ("auto", False)) - ,("transform", ("none", False)) -- experimental! - ,("-webkit-transform", ("none", False)) -- experimental! - ,("transform-box", ("border-box", False)) -- experimental! - ,("transform-origin", (mempty {-"50% 50% 0"-}, False)) -- experimental! - ,("-webkit-transform-origin", (mempty {-"50% 50% 0"-}, False)) -- experimental! - ,("transform-style", ("flat", False)) -- experimental! - ,("-webkit-transform-style", ("flat", False)) -- experimental! - ,("transition", (mempty, False))-- shorthand and experimental - ,("transition-delay", ("0s", False)) -- experimental - ,("transition-duration", ("0s", False)) -- experimental - ,("-webkit-transition-duration", ("0s", False)) -- experimental - ,("-o-transition-duration", ("0s", False)) -- experimental - ,("-webkit-transition-delay", ("0s", False)) -- experimental - ,("transition-property", ("all", False)) -- experimental - ,("-webkit-transition-property", ("all", False)) -- experimental - ,("-o-transition-property", ("all", False)) -- experimental - ,("transition-timing-function", ("ease", False)) -- experimental - ,("-webkit-transition-timing-function", ("ease", False)) -- experimental - ,("unicode-bidi", ("normal", False)) - ,("user-select", ("none", False)) -- experimental - ,("-moz-user-select", ("none", False)) -- experimental - ,("-webkit-user-select", ("none", False)) -- experimental - ,("-ms-user-select", ("none", False)) -- experimental - ,("vertical-align", ("baseline", False)) - ,("white-space", ("normal", True)) - ,("widows", ("2", True)) - ,("width", ("auto", False)) - ,("will-change", ("auto", False)) - ,("word-break", ("normal", True)) - ,("word-spacing", ("normal", True)) - ,("writing-mode", ("horizontal-tb", True)) -- experimental - ,("-ms-writing-mode", ("horizontal-tb", True)) -- experimental - ,("-webkit-writing-mode", ("horizontal-tb", True)) -- experimental - ,("z-index", ("auto", False)) - ] +-- | Map relating property names to information regarding the property. +propertiesTraits :: Map Text PropertyInfo +propertiesTraits = Map.fromList $ processTuples + [("align-content", "stretch", NonInherited, mempty, mempty) + ,("align-items", "stretch", NonInherited, mempty, mempty) + ,("align-self", "auto", NonInherited, mempty, mempty) + ,("all", mempty, NonInherited, mempty, mempty) -- No practical initial value + ,("animation", mempty, NonInherited, mempty, + ["animation-name", "animation-duration", "animation-timing-function", + "animation-delay", "animation-iteration-count", "animation-direction", + "animation-fill-mode", "animation-play-state"]) + ,("animation-delay", "0s", NonInherited, ["animation"], mempty) -- experimental + ,("animation-direction", "normal", NonInherited, ["animation"], mempty) -- experimental + ,("animation-duration", "0s", NonInherited, mempty, mempty) -- experimental + ,("animation-fill-mode", "none", NonInherited, ["animation"], mempty) -- experimental + ,("animation-iteration-count", "1", NonInherited, ["animation"], mempty) -- experimental + ,("animation-name", "none", NonInherited, ["animation"], mempty) -- experimental + ,("animation-play-state", "running", NonInherited, ["animation"], mempty) -- experimental + ,("animation-timing-function", "ease", NonInherited, ["animation"], mempty) -- experimental + ,("backface-visibility", "visible", NonInherited, mempty, mempty) + ,("-webkit-backface-visibility", "visible", NonInherited, mempty, mempty) + ,("backdrop-filter", "none", NonInherited, mempty, mempty) -- experimental + ,("-webkit-backdrop-filter", "none", NonInherited, mempty, mempty) -- experimental + ,("background", mempty {-shorthand-}, NonInherited, mempty, + ["background-image", "background-position", "background-size", + "background-repeat", "background-origin", "background-clip", + "background-attachment", "background-color"]) + ,("background-attachment", "scroll", NonInherited, ["background"], mempty) + ,("background-blend-mode", "normal", NonInherited, mempty, mempty) -- TODO find out if these mempty are alright! + ,("background-clip", "border-box", NonInherited, ["background"], mempty) + ,("-webkit-background-clip", "border-box", NonInherited, ["background"], mempty) + ,("background-color", "transparent", NonInherited, ["background"], mempty) + ,("background-image", "none", NonInherited, ["background"], mempty) + ,("background-origin", "padding-box", NonInherited, ["background"], mempty) + ,("background-position", mempty, NonInherited, ["background"], ["background-position-x", "background-position-y"]) --shorthand + ,("background-position-x", "left", NonInherited, ["background", "background-position"], mempty) + ,("background-position-inline", mempty {-not applicable-}, NonInherited, mempty, mempty) + ,("background-position-block", mempty {-not applicable-}, NonInherited, mempty, mempty) + ,("background-position-y", "top", NonInherited, ["background", "background-position"], mempty) + ,("background-repeat", "repeat", NonInherited, ["background"], mempty) + ,("background-size", "auto", NonInherited, ["background"], mempty) + ,("block-size", "auto", NonInherited, mempty, mempty) -- experimental + ,("border", "medium none currentcolor", NonInherited, mempty, ["border-width", "border-style", "border-color"]) -- shorthand! + -- border-block-* would go here + ,("border-bottom", "medium none currentcolor", NonInherited, ["border"], + ["border-bottom-color", "border-bottom-style", "border-bottom-width"]) -- shorthand! + ,("border-bottom-color", "currentcolor", NonInherited, ["border", "border-color", "border-bottom"], mempty) + ,("border-bottom-left-radius", "0", NonInherited, ["border-radius"], mempty) + ,("border-bottom-right-radius", "0", NonInherited, ["border-radius"], mempty) + ,("border-bottom-style", "none", NonInherited, ["border", "border-style", "border-bottom"], mempty) + ,("border-bottom-width", "medium", NonInherited, ["border", "border-width", "border-bottom"], mempty) + ,("border-collapse", "separate", Inherited, mempty, mempty) + ,("border-color", mempty, NonInherited, ["border"], + ["border-top-color", "border-right-color", "border-bottom-color", + "border-left-color"]) -- shorthand! + ,("border-image", mempty, NonInherited, ["border"], + ["border-image-source", "border-image-slice", "border-image-width", + "border-image-outset", "border-image-repeat"]) -- shorthand + ,("border-image-outset", "0", NonInherited, ["border", "border-image"], mempty) + ,("border-image-repeat", "stretch", NonInherited, ["border", "border-image"], mempty) + ,("border-image-slice", "100%", NonInherited, ["border", "border-image"], mempty) + ,("border-image-source", "none", NonInherited, ["border", "border-image"], mempty) + ,("border-image-width", "1", NonInherited, ["border", "border-image"], mempty) + -- border-inline-* would go here + ,("border-left", "medium none currentcolor", NonInherited, ["border"], ["border-left-color", "border-left-style", "border-left-width"]) -- shorthand! + ,("border-left-color", "currentcolor", NonInherited, ["border", "border-color", "border-left"], mempty) + ,("border-left-style", "none", NonInherited, ["border", "border-style", "border-left"], mempty) + ,("border-left-width", "medium", NonInherited, ["border", "border-width", "border-left"], mempty) + ,("border-radius", mempty {-shorthand-}, NonInherited, mempty, + ["border-top-left-radius","border-top-right-radius","border-bottom-right-radius","border-bottom-left-radius"]) + ,("border-right", "medium none currentcolor", NonInherited, ["border"], + ["border-right-color", "border-right-style", "border-right-width"]) -- shorthand! + ,("border-right-color", "currentcolor", NonInherited, ["border", "border-color", "border-right"], mempty) + ,("border-right-style", "none", NonInherited, ["border", "border-style", "border-right"], mempty) + ,("border-right-width", "medium", NonInherited, ["border", "border-width", "border-right"], mempty) + ,("border-spacing", "0", Inherited, mempty, mempty) + ,("border-style", mempty {-shorthand-}, NonInherited, ["border"], ["border-top-style", "border-right-style", "border-bottom-style", "border-left-style"]) + ,("border-top", "medium none currentcolor", NonInherited, ["border"], ["border-top-color", "border-top-style", "border-top-width"]) -- shorthand + ,("border-top-color", "currentcolor", NonInherited, ["border", "border-color", "border-top"], mempty) + ,("border-top-style", "none", NonInherited, ["border", "border-style", "border-top"], mempty) + ,("border-top-width", "medium", NonInherited, ["border", "border-style", "border-top"], mempty) + ,("border-top-left-radius", "0", NonInherited, ["border-radius"], mempty) + ,("border-top-right-radius", "0", NonInherited, ["border-radius"], mempty) + ,("border-width", mempty {-shorthand-}, NonInherited, ["border"], ["border-top-width", "border-right-width", "border-bottom-width", "border-left-width"]) + ,("bottom", "auto", NonInherited, mempty, mempty) + ,("box-decoration-break", "slice", NonInherited, mempty, mempty) -- experimental + ,("-webkit-box-decoration-break", "slice", NonInherited, mempty, mempty) -- experimental + ,("-o-box-decoration-break", "slice", NonInherited, mempty, mempty) -- experimental + ,("box-shadow", "none", NonInherited, mempty, mempty) + ,("-webkit-box-shadow", "none", NonInherited, mempty, mempty) + ,("box-sizing", "content-box", NonInherited, mempty, mempty) -- experimental + ,("-webkit-box-sizing", "content-box", NonInherited, mempty, mempty) -- experimental + ,("-moz-box-sizing", "content-box", NonInherited, mempty, mempty) -- experimental + ,("break-after", "auto", NonInherited, mempty, mempty) + ,("break-before", "auto", NonInherited, mempty, mempty) + ,("break-inside", "auto", NonInherited, mempty, mempty) + ,("caption-side", "top", Inherited, mempty, mempty) + ,("clear", "none", NonInherited, mempty, mempty) + ,("clip", "auto", NonInherited, mempty, mempty) -- deprecated! + ,("color", mempty {-UA dependent-}, Inherited, mempty, mempty) + ,("column-count", "auto", NonInherited, ["columns"], mempty) + ,("column-fill", "balance", NonInherited, mempty, mempty) + ,("column-gap", "normal", NonInherited, mempty, mempty) + ,("column-rule", "medium none currentcolor", NonInherited, mempty, + ["column-rule-color", "column-rule-style", "column-rule-width"]) -- shorthand + ,("column-rule-color", "currentcolor", NonInherited, ["column-rule"], mempty) + ,("column-rule-style", "none", NonInherited, ["column-rule"], mempty) + ,("column-rule-width", "medium", NonInherited, ["column-rule"], mempty) + ,("column-span", "none", NonInherited, mempty, mempty) + ,("column-width", "auto", NonInherited, ["columns"], mempty) + ,("columns", mempty {-shorthand-}, NonInherited, mempty, ["column-width", "column-count"]) + ,("content", "normal", NonInherited, mempty, mempty) + ,("counter-increment", "none", NonInherited, mempty, mempty) + ,("counter-reset", "none", NonInherited, mempty, mempty) + ,("cursor", "auto", Inherited, mempty, mempty) + ,("direction", "ltr", Inherited, mempty, mempty) + ,("display", "inline", NonInherited, mempty, mempty) + ,("empty-cells", "show", Inherited, mempty, mempty) + ,("filter", "none", NonInherited, mempty, mempty) -- experimental + ,("-webkit-filter", "none", NonInherited, mempty, mempty) -- experimental + ,("flex", mempty {-shorthand-}, NonInherited, mempty, ["flex-grow", "flex-shrink", "flex-basis"]) + ,("flex-basis", "auto", NonInherited, ["flex"], mempty) + ,("flex-direction", "row", NonInherited, ["flex-flow"], mempty) + ,("flex-flow", "row nowrap", NonInherited, mempty, ["flex-direction", "flex-wrap"]) -- shorthand + ,("flex-grow", "0", NonInherited, ["flex"], mempty) + ,("flex-shrink", "1", NonInherited, ["flex"], mempty) + ,("flex-wrap", "nowrap", NonInherited, ["flex-flow"], mempty) + ,("float", "none", NonInherited, mempty, mempty) + ,("font", mempty {-shorthand-}, Inherited, mempty, ["font-style", "font-variant", "font-weight", "font-stretch", "font-size", "line-height", "font-family"]) + ,("font-family", mempty {-UA dependent-}, Inherited, ["font"], mempty) + ,("font-feature-settings", "normal", Inherited, mempty, mempty) + ,("font-kerning", "auto", Inherited, ["font"], mempty) + ,("font-language-override", "normal", Inherited, ["font"], mempty) + ,("font-size", "medium", Inherited, ["font"], mempty) + ,("font-size-adjust", "none", Inherited, ["font"], mempty) + ,("font-stretch", "normal", Inherited, ["font"], mempty) + ,("font-style", "normal", Inherited, ["font"], mempty) + ,("font-synthesis", "weight style", Inherited, mempty, mempty) + ,("font-variant", "normal", Inherited, ["font"], mempty) + ,("font-variant-alternates", "normal", Inherited, mempty, mempty) + ,("font-variant-caps", "normal", Inherited, mempty, mempty) + ,("font-variant-east-asian", "normal", Inherited, mempty, mempty) + ,("font-variant-ligatures", "normal", Inherited, mempty, mempty) + ,("font-variant-numeric", "normal", Inherited, mempty, mempty) + ,("font-variant-position", "normal", Inherited, mempty, mempty) + ,("font-weight", "normal", Inherited, ["font"], mempty) + ,("grid", mempty {-shorthand-}, NonInherited, mempty, ["grid-template-rows", "grid-template-columns", "grid-template-areas", "grid-auto-rows", "grid-auto-columns", "grid-auto-flow", "grid-column-gap", "grid-row-gap"])-- shorthand, experimental + ,("grid-area", mempty {-shorthand-}, NonInherited, mempty, ["grid-row-start", "grid-row-end", "grid-column-start", "grid-column-end"]) -- shorthand, experimental + ,("grid-auto-columns", "auto", NonInherited, mempty, mempty) -- experimental + ,("-ms-grid-auto-columns", "auto", NonInherited, mempty, mempty) -- experimental + ,("-webkit-grid-auto-columns", "auto", NonInherited, mempty, mempty) -- experimental + ,("grid-auto-flow", "row", NonInherited, mempty, mempty) -- experimental + ,("-webkit-grid-auto-flow", "row", NonInherited, mempty, mempty) -- experimental + ,("grid-auto-rows", "auto", NonInherited, mempty, mempty) -- experimental + ,("-ms-grid-auto-rows", "auto", NonInherited, mempty, mempty) -- experimental + ,("-webkit-grid-auto-rows", "auto", NonInherited, mempty, mempty) -- experimental + ,("grid-column", mempty {-shorthand-}, NonInherited, mempty, ["grid-column-start", "grid-column-end"]) + ,("grid-column-end", "auto", NonInherited, ["grid-column", "grid-area"], mempty) -- experimental + ,("-ms-grid-column-end", "auto", NonInherited, ["grid-column", "grid-area"], mempty) -- experimental + ,("-webkit-grid-column-end", "auto", NonInherited, ["grid-column", "grid-area"], mempty) -- experimental + ,("grid-column-gap", "0", NonInherited, ["grid-gap"], mempty) + ,("-ms-grid-column-gap", "0", NonInherited, ["grid-gap"], mempty) + ,("grid-column-start", "auto", NonInherited, mempty, mempty) -- experimental + ,("-ms-grid-column-start", "auto", NonInherited, mempty, mempty) -- experimental + ,("-webkit-grid-column-start", "auto", NonInherited, mempty, mempty) -- experimental + ,("grid-gap", mempty {-shorthand-}, NonInherited, mempty, ["grid-row-gap", "grid-column-gap"]) + ,("grid-row", mempty {-shorthand-}, NonInherited, mempty, ["grid-row-start", "grid-row-end"]) + ,("grid-row-end", "auto", NonInherited, ["grid-row", "grid-area"], mempty) + ,("-ms-grid-row-end", "auto", NonInherited, ["grid-row", "grid-area"], mempty) + ,("-webkit-grid-row-end", "auto", NonInherited, ["grid-row", "grid-area"], mempty) + ,("grid-row-gap", "0", NonInherited, ["grid-gap"], mempty) + ,("-webkit-grid-row-gap", "0", NonInherited, ["grid-gap"], mempty) + ,("grid-row-start", "auto", NonInherited, ["grid-row", "grid-area"], mempty) + ,("-ms-grid-row-start", "auto", NonInherited, ["grid-row", "grid-area"], mempty) + ,("-webkit-grid-row-start", "auto", NonInherited, ["grid-row", "grid-area"], mempty) + ,("grid-template", mempty {-shorthand-}, NonInherited, mempty, ["grid-template-columns", "grid-template-rows", "grid-template-areas"]) + ,("grid-template-areas", "none", NonInherited, ["grid-template"], mempty) + ,("-webkit-grid-template-areas", "none", NonInherited, ["grid-template"], mempty) + ,("grid-template-columns", "none", NonInherited, ["grid-template"], mempty) + ,("-ms-grid-template-columns", "none", NonInherited, ["grid-template"], mempty) + ,("-webkit-grid-template-columns", "none", NonInherited, ["grid-template"], mempty) + ,("grid-template-rows", "none", NonInherited, ["grid-template"], mempty) + ,("-ms-grid-template-rows", "none", NonInherited, ["grid-template"], mempty) + ,("-webkit-grid-template-rows", "none", NonInherited, ["grid-template"], mempty) + ,("height", "auto", NonInherited, mempty, mempty) + ,("hyphens", "manual", NonInherited, mempty, mempty) + -- ,("image-orientation" --experimental + -- ,("image-rendering" --experimental + -- ,("inline-size", -- experimental + ,("isolation", "auto", NonInherited, mempty, mempty) + ,("justify-content", "flex-start", NonInherited, mempty, mempty) + ,("left", "auto", NonInherited, mempty, mempty) + ,("letter-spacing", "normal", Inherited, mempty, mempty) + ,("line-break", "auto", NonInherited, mempty, mempty) + ,("line-height", "normal", Inherited, ["font"], mempty) + ,("list-style", "none disc outside", Inherited, mempty, ["list-style-type", "list-style-position", "list-style-image"]) -- none must go first, for entropy reasons. + ,("list-style-image", "none", Inherited, ["list-style"], mempty) + ,("list-style-position", "outside", Inherited, ["list-style"], mempty) + ,("list-style-type", "disc", Inherited, ["list-style"], mempty) + ,("margin", mempty {-shorthand-}, NonInherited, mempty, ["margin-top", "margin-right", "margin-bottom", "margin-left"]) -- shorthand + -- ,("margin-block-* -- experimental + ,("margin-bottom", "0", NonInherited, ["margin"], mempty) + -- ,("margin-inline-*" --experimental + ,("margin-left", "0", NonInherited, ["margin"], mempty) + ,("margin-right", "0", NonInherited, ["margin"], mempty) + ,("margin-top", "0", NonInherited, ["margin"], mempty) + ,("mask", mempty {-shorthand-}, NonInherited, mempty, ["mask-clip", "mask-origin", "mask-border"]) + ,("mask-border", mempty {-shorthand-}, NonInherited, ["mask"], ["mask-border-source", "mask-border-slice", "mask-border-width", "mask-border-outset", "mask-border-repeat"]) + ,("mask-border-outset", "0", NonInherited, ["mask", "mask-border"], mempty) + ,("mask-border-repeat", "stretch", NonInherited, ["mask", "mask-border"], mempty) + ,("mask-border-slice", "0", NonInherited, ["mask", "mask-border"], mempty) + ,("mask-border-source", "none", NonInherited, ["mask", "mask-border"], mempty) + ,("mask-border-width", "auto", NonInherited, ["mask", "mask-border"], mempty) + ,("mask-clip", "border-box", NonInherited, ["mask"], mempty) -- experimental + ,("-webkit-mask-clip", "border-box", NonInherited, ["mask"], mempty) -- experimental + ,("mask-composite", "add", NonInherited, ["mask"], mempty) -- experimental + ,("mask-image", "none", NonInherited, ["mask"], mempty) -- experimental + ,("-webkit-mask-image", "none", NonInherited, ["mask"], mempty) -- experimental + -- ,("mask-mode", "match-source", NonInherited) -- experimental, no support + ,("mask-origin", "border-box", NonInherited, ["mask"], mempty) -- experimental + ,("-webkit-mask-origin", "border-box", NonInherited, ["mask"], mempty) -- experimental + ,("mask-position", "center", NonInherited, ["mask"], mempty) -- experimental + ,("-webkit-mask-position", "center", NonInherited, ["mask"], mempty) -- experimental + ,("mask-repeat", "no-repeat", NonInherited, ["mask"], mempty) -- experimental + ,("-webkit-mask-repeat", "no-repeat", NonInherited, ["mask"], mempty) -- experimental + ,("mask-size", "auto", NonInherited, ["mask"], mempty) -- experimental + ,("mask-type", "luminance", NonInherited, mempty, mempty) -- experimental + -- ,("max-block-size", ("0", NonInherited)) -- experimental + ,("max-height", "none", NonInherited, mempty, mempty) + -- ,("max-inline-size", ("0", NonInherited)) -- experimental + ,("max-width", "none", NonInherited, mempty, mempty) + -- ,("min-block-size", ("0", NonInherited)) -- experimental + ,("min-height", "0", NonInherited, mempty, mempty) + -- ,("min-inline-size", ("0", NonInherited)) -- experimental + ,("min-width", "0", NonInherited, mempty, mempty) + ,("mix-blend-mode", "normal", NonInherited, mempty, mempty) + ,("object-fit", "fill", Inherited, mempty, mempty) + ,("object-position", "50% 50%", Inherited, mempty, mempty) + -- ,("offset-*", ("auto", NonInherited)) -- experimental + ,("opacity", "1", NonInherited, mempty, mempty) + ,("order", "0", NonInherited, mempty, mempty) + ,("orphans", "2", Inherited, mempty, mempty) + ,("outline", "medium none invert", NonInherited, mempty, ["outline-width", "outline-style", "outline-color"]) -- shorthand + ,("outline-color", "invert" , NonInherited, ["outline"], mempty) + ,("outline-offset", "0", NonInherited, mempty, mempty) + ,("outline-style", "none", NonInherited, ["outline"], mempty) + ,("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 + ,("padding", mempty {-shorthand-}, NonInherited, mempty, ["padding-top", "padding-right", "padding-bottom", "padding-left"]) + -- ,("padding-block*", ("0", NonInherited)) -- experimental + ,("padding-bottom", "0", NonInherited, ["padding"], mempty) + -- ,("padding-inline-*", ("0", NonInherited)) -- experimental + ,("padding-left", "0", NonInherited, ["padding"], mempty) + ,("padding-right", "0", NonInherited, ["padding"], mempty) + ,("padding-top", "0", NonInherited, ["padding"], mempty) + ,("page-break-after", "auto", NonInherited, mempty, mempty) + ,("page-break-before", "auto", NonInherited, mempty, mempty) + ,("page-break-inside", "auto", NonInherited, mempty, mempty) + ,("perspective", "none", NonInherited, mempty, mempty) -- experimental + ,("perspective-origin", "50% 50%", NonInherited, mempty, mempty) -- experimental + ,("pointer-events", "auto", Inherited, mempty, mempty) + ,("position", "static", NonInherited, mempty, mempty) + ,("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 + -- ,("scroll-snap-destination",("0 0", NonInherited)) -- experimental, actually 0px 0px + -- ,("scroll-snap-type", -- experimental + ,("shape-image-threshold", "0", NonInherited, mempty, mempty) + ,("shape-margin", "0", NonInherited, mempty, mempty) + ,("shape-outside", "none", NonInherited, mempty, mempty) + ,("tab-size", "8", Inherited, mempty, mempty) -- experimental + ,("-moz-tab-size", "8", Inherited, mempty, mempty) -- experimental + ,("-o-tab-size", "8", Inherited, mempty, mempty) -- experimental + ,("table-layout", "auto", NonInherited, mempty, mempty) + ,("text-align", "start", NonInherited, mempty, mempty) + ,("text-align-last", "auto", Inherited, mempty, mempty) -- experimental + ,("text-combine-upright", "none", Inherited, mempty, mempty) -- experimental + ,("-webkit-text-combine-upright", "none", Inherited, mempty, mempty) -- experimental + ,("text-decoration", "currentcolor solid none", NonInherited, mempty, ["text-decoration-color", "text-decoration-style", "text-decoration-line"]) -- shorthand + ,("text-decoration-color", "currentcolor", NonInherited, ["text-decoration"], mempty) + ,("text-decoration-line", "none", NonInherited, ["text-decoration"], mempty) + ,("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-style", "none", NonInherited, ["text-emphasis"], mempty) + ,("text-indent", "0", Inherited, mempty, mempty) + ,("text-orientation", "mixed", Inherited, mempty, mempty) -- experimental + ,("-webkit-text-orientation", "mixed", Inherited, mempty, mempty) -- experimental + ,("text-overflow", "clip", NonInherited, mempty, mempty) + ,("text-rendering", "auto", Inherited, mempty, mempty) + ,("text-shadow", "none", Inherited, mempty, mempty) + ,("text-transform", "none", Inherited, mempty, mempty) + ,("text-underline-position", "auto", Inherited, mempty, mempty) + ,("top", "auto", NonInherited, mempty, mempty) + ,("touch-action", "auto", NonInherited, mempty, mempty) + ,("transform", "none", NonInherited, mempty, mempty) -- experimental! + ,("-webkit-transform", "none", NonInherited, mempty, mempty) -- experimental! + ,("transform-box", "border-box", NonInherited, mempty, mempty) -- experimental! + ,("transform-origin", mempty {-"50% 50% 0"-}, NonInherited, mempty, mempty) -- experimental! + ,("-webkit-transform-origin", mempty {-"50% 50% 0"-}, NonInherited, mempty, mempty) -- experimental! + ,("transform-style", "flat", NonInherited, mempty, mempty) -- experimental! + ,("-webkit-transform-style", "flat", NonInherited, mempty, mempty) -- experimental! + ,("transition", mempty {-shorthand-}, NonInherited, mempty, + ["transition-property", "transition-duration", + "transition-timing-function", "transition-delay"]) + ,("transition-delay", "0s", NonInherited, ["transition"], mempty) -- experimental + ,("transition-duration", "0s", NonInherited, ["transition"], mempty) -- experimental + ,("-webkit-transition-duration", "0s", NonInherited, ["transition"], mempty) -- experimental + ,("-o-transition-duration", "0s", NonInherited, ["transition"], mempty) -- experimental + ,("-webkit-transition-delay", "0s", NonInherited, ["transition"], mempty) -- experimental + ,("transition-property", "all", NonInherited, ["transition"], mempty) -- experimental + ,("-webkit-transition-property", "all", NonInherited, ["transition"], mempty) -- experimental + ,("-o-transition-property", "all", NonInherited, ["transition"], mempty) -- experimental + ,("transition-timing-function", "ease", NonInherited, ["transition"], mempty) -- experimental + ,("-webkit-transition-timing-function", "ease", NonInherited, ["transition"], mempty) -- experimental + ,("unicode-bidi", "normal", NonInherited, mempty, mempty) + ,("user-select", "none", NonInherited, mempty, mempty) -- experimental + ,("-moz-user-select", "none", NonInherited, mempty, mempty) -- experimental + ,("-webkit-user-select", "none", NonInherited, mempty, mempty) -- experimental + ,("-ms-user-select", "none", NonInherited, mempty, mempty) -- experimental + ,("vertical-align", "baseline", NonInherited, mempty, mempty) + ,("white-space", "normal", Inherited, mempty, mempty) + ,("widows", "2", Inherited, mempty, mempty) + ,("width", "auto", NonInherited, mempty, mempty) + ,("will-change", "auto", NonInherited, mempty, mempty) + ,("word-break", "normal", Inherited, mempty, mempty) + ,("word-spacing", "normal", Inherited, mempty, mempty) + ,("writing-mode", "horizontal-tb", Inherited, mempty, mempty) -- experimental + ,("-ms-writing-mode", "horizontal-tb", Inherited, mempty, mempty) -- experimental + ,("-webkit-writing-mode", "horizontal-tb", Inherited, mempty, mempty) -- experimental + ,("z-index", "auto", NonInherited, mempty, mempty) + ] + where + -- Converts the tuples with CSS properties data into a tuple containing a + -- property's name, and its traits. Allows keeping the table in a more readable + -- and maintainable format. + processTuples :: [(Text, Text, Inheritance, [Text], [Text])] -> [(Text, PropertyInfo)] + processTuples = foldr (\(p,t,i,a,b) xs -> (p, PropertyInfo (getValues p t) i a b) : xs) [] + getValues p s = case parseOnly (valuesFor p <|> valuesFallback) s of + Right initValues -> Just initValues + Left _ -> Nothing --- Parses text and replaces it with an array of values, to makes the --- propertiesTraits table more readable and maintainable in general. -replaceTextWithValues :: [(Text, (Text, Bool))] -> [(Text, (Maybe Values, Bool))] -replaceTextWithValues = foldr (\(p,(t,i)) xs -> (p, (getValues p t,i)) : xs) [] - where getValues p s = case parseOnly (values p <|> valuesFallback) s of - Right initialValues -> Just initialValues - Left _ -> Nothing diff --git a/src/Hasmin/Types/BgSize.hs b/src/Hasmin/Types/BgSize.hs --- a/src/Hasmin/Types/BgSize.hs +++ b/src/Hasmin/Types/BgSize.hs @@ -8,59 +8,70 @@ -- Portability : non-portable -- ----------------------------------------------------------------------------- -module Hasmin.Types.BgSize ( - BgSize(..) +module Hasmin.Types.BgSize + ( BgSize(..) , Auto(..) ) where -import Control.Monad.Reader (ask) +import Control.Monad.Reader (Reader) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton) -import Hasmin.Types.Class +import Hasmin.Class +import Hasmin.Config import Hasmin.Types.PercentageLength +-- | The CSS @auto@ keyword. data Auto = Auto deriving (Eq, Show) instance ToText Auto where toBuilder Auto = "auto" +-- | CSS > +-- data type, used by the @background-size@ and @background@ properties. data BgSize = Cover | Contain - | BgSize (Either PercentageLength Auto) (Maybe (Either PercentageLength Auto)) + | BgSize1 (Either PercentageLength Auto) + | BgSize2 (Either PercentageLength Auto) (Either PercentageLength Auto) deriving Show instance Eq BgSize where - Cover == Cover = True - Contain == Contain = True - BgSize a b == BgSize c d = ftsArgEq a c && b `equals` d - where equals (Just (Right Auto)) Nothing = True - equals Nothing (Just (Right Auto)) = True - equals (Just (Left x)) (Just (Left y)) = isZero x && isZero y || x == y - equals x y = x == y - ftsArgEq (Left x) (Left y) = isZero x && isZero y || x == y - ftsArgEq x y = x == y + BgSize1 x1 == BgSize1 x2 = x1 `bgsizeArgEq` x2 + BgSize2 x1 y == BgSize1 x2 = x1 `bgsizeArgEq` x2 && y == Right Auto + x@BgSize1{} == y@BgSize2{} = y == x + BgSize2 x1 y1 == BgSize2 x2 y2 = x1 `bgsizeArgEq` x2 && y1 `bgsizeArgEq` y2 + Cover == Cover = True + Contain == Contain = True _ == _ = False +bgsizeArgEq :: Either PercentageLength Auto -> Either PercentageLength Auto -> Bool +bgsizeArgEq (Left x) (Left y) = isZero x && isZero y || x == y +bgsizeArgEq x y = x == y + instance ToText BgSize where - toBuilder Cover = "cover" - toBuilder Contain = "contain" - toBuilder (BgSize x y) = toBuilder x <> maybe mempty (\a -> singleton ' ' <> toBuilder a) y + toBuilder Cover = "cover" + toBuilder Contain = "contain" + toBuilder (BgSize1 x) = toBuilder x + toBuilder (BgSize2 x y) = toBuilder x <> singleton ' ' <> toBuilder y +-- | Minifying a @\@ value entails, apart from minifying the +-- individual values, removing any @auto@ value in the second position (if +-- present). instance Minifiable BgSize where - minifyWith (BgSize x y) = do - conf <- ask - nx <- minFirst x - ny <- mapM minFirst y - let b = BgSize nx ny + minify (BgSize1 x) = BgSize1 <$> minifyBgSizeArg x + minify (BgSize2 x y) = do + nx <- minifyBgSizeArg x + ny <- minifyBgSizeArg y + let b = BgSize2 nx ny pure $ if True {- shouldMinifyBgSize conf -} then minifyBgSize b else b - where minFirst (Left a) = Left <$> minifyWith a - minFirst (Right Auto) = pure (Right Auto) - minifyWith x = pure x + where minifyBgSize (BgSize2 l (Right Auto)) = BgSize1 l + minifyBgSize z = z + minify x = pure x -minifyBgSize :: BgSize -> BgSize -minifyBgSize (BgSize l (Just (Right Auto))) = BgSize l Nothing -minifyBgSize x = x +minifyBgSizeArg :: Either PercentageLength Auto + -> Reader Config (Either PercentageLength Auto) +minifyBgSizeArg (Left a) = Left <$> minify a +minifyBgSizeArg (Right Auto) = pure $ Right Auto diff --git a/src/Hasmin/Types/Class.hs b/src/Hasmin/Types/Class.hs deleted file mode 100644 --- a/src/Hasmin/Types/Class.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# LANGUAGE Safe #-} ------------------------------------------------------------------------------ --- | --- Module : Hasmin.Types.Class --- Copyright : (c) 2017 Cristian Adrián Ontivero --- License : BSD3 --- Stability : experimental --- Portability : non-portable --- ------------------------------------------------------------------------------ -module Hasmin.Types.Class - ( ToText(..) - , Minifiable(..) - ) where - -import Control.Monad.Reader (Reader, runReader) -import Data.Word (Word8) -import Data.Text (pack, Text) -import Data.Text.Lazy (toStrict) -import Data.Text.Lazy.Builder (Builder, fromText, toLazyText) -import Hasmin.Config - --- | Class for types that can be minified -class Minifiable a where - {-# MINIMAL minifyWith #-} - minifyWith :: a -> Reader Config a - - -- Returns smallest equivalent representation for an element, using a default - -- configuration. Mostly used for testing. - minify :: a -> a - minify x = runReader (minifyWith x) defaultConfig - --- | Class for types that can be converted to Text. Used for priting the --- minified results. -class ToText a where - {-# MINIMAL toText | toBuilder #-} - toText :: a -> Text - toBuilder :: a -> Builder - toText = toStrict . toLazyText . toBuilder - toBuilder = fromText . toText -instance ToText Word8 where - toText = pack . show -instance ToText Int where - toText = pack . show -instance ToText Text where - toText = id -instance (ToText a, ToText b) => ToText (Either a b) where - toText = either toText toText - toBuilder = either toBuilder toBuilder diff --git a/src/Hasmin/Types/Color.hs b/src/Hasmin/Types/Color.hs --- a/src/Hasmin/Types/Color.hs +++ b/src/Hasmin/Types/Color.hs @@ -7,11 +7,9 @@ -- Stability : experimental -- Portability : unknown -- --- \ data type. --- ----------------------------------------------------------------------------- -module Hasmin.Types.Color ( - Color(Named) +module Hasmin.Types.Color + ( Color(Named) , mkHex3 , mkHex4 , mkHex6 @@ -28,7 +26,7 @@ ) where import Control.Arrow (first) -import Control.Monad.Reader (ask) +import Control.Monad.Reader (asks) import Data.Monoid ((<>)) import Data.Char (isHexDigit, digitToInt, intToDigit, toLower) import Data.Maybe (fromMaybe) @@ -40,16 +38,12 @@ import qualified Data.Text as T import Hasmin.Config -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.Numeric import Hasmin.Utils --- | The \ CSS data type. Specifications: --- --- 4. --- 3. --- 2. --- 1. +-- | CSS > +-- data type. data Color = Hex3 Char Char Char | Hex4 Char Char Char Char | Hex6 String String String @@ -97,9 +91,9 @@ | otherwise = False c1 <= c2 = toLongHex c1 <= toLongHex c2 instance Minifiable Color where - minifyWith c = do - conf <- ask - pure $ case colorSettings conf of + minify c = do + colSettings <- asks colorSettings + pure $ case colSettings of ColorMinOn -> minifyColor c ColorMinOff -> c @@ -296,49 +290,49 @@ -- | A map with hex values as keys, and their minimal colorname as value minimalColorMap :: Map.Map Color Color minimalColorMap = Map.fromList minimalColors - -minimalColors :: [(Color, Color)] -minimalColors = [(Hex6 "ff" "00" "00", Named "red") - ,(Hex6 "d2" "b4" "8c", Named "tan") - ,(Hex6 "00" "ff" "ff", Named "aqua") - ,(Hex6 "00" "00" "ff", Named "blue") - ,(Hex6 "00" "ff" "ff", Named "cyan") - ,(Hex6 "ff" "d7" "00", Named "gold") - ,(Hex6 "80" "80" "80", Named "gray") - ,(Hex6 "80" "80" "80", Named "grey") - ,(Hex6 "00" "ff" "00", Named "lime") - ,(Hex6 "00" "00" "80", Named "navy") - ,(Hex6 "cd" "85" "3f", Named "peru") - ,(Hex6 "ff" "c0" "cb", Named "pink") - ,(Hex6 "dd" "a0" "dd", Named "plum") - ,(Hex6 "ff" "fa" "fa", Named "snow") - ,(Hex6 "00" "80" "80", Named "teal") - ,(Hex6 "f0" "ff" "ff", Named "azure") - ,(Hex6 "f5" "f5" "dc", Named "beige") - ,(Hex6 "a5" "2a" "2a", Named "brown") - ,(Hex6 "ff" "7f" "50", Named "coral") - ,(Hex6 "00" "80" "00", Named "green") - ,(Hex6 "ff" "ff" "f0", Named "ivory") - ,(Hex6 "f0" "e6" "8c", Named "khaki") - ,(Hex6 "fa" "f0" "e6", Named "linen") - ,(Hex6 "80" "80" "00", Named "olive") - ,(Hex6 "f5" "de" "b3", Named "wheat") - ,(Hex6 "ff" "e4" "c4", Named "bisque") - ,(Hex6 "4b" "00" "82", Named "indigo") - ,(Hex6 "80" "00" "00", Named "maroon") - ,(Hex6 "ff" "a5" "00", Named "orange") - ,(Hex6 "da" "70" "d6", Named "orchid") - ,(Hex6 "80" "00" "80", Named "purple") - ,(Hex6 "fa" "80" "72", Named "salmon") - ,(Hex6 "a0" "52" "2d", Named "sienna") - ,(Hex6 "c0" "c0" "c0", Named "silver") - ,(Hex6 "ff" "63" "47", Named "tomato") - ,(Hex6 "ee" "82" "ee", Named "violet")] + where minimalColors = + [(Hex6 "ff" "00" "00", Named "red") + ,(Hex6 "d2" "b4" "8c", Named "tan") + ,(Hex6 "00" "ff" "ff", Named "aqua") + ,(Hex6 "00" "00" "ff", Named "blue") + ,(Hex6 "00" "ff" "ff", Named "cyan") + ,(Hex6 "ff" "d7" "00", Named "gold") + ,(Hex6 "80" "80" "80", Named "gray") + ,(Hex6 "80" "80" "80", Named "grey") + ,(Hex6 "00" "ff" "00", Named "lime") + ,(Hex6 "00" "00" "80", Named "navy") + ,(Hex6 "cd" "85" "3f", Named "peru") + ,(Hex6 "ff" "c0" "cb", Named "pink") + ,(Hex6 "dd" "a0" "dd", Named "plum") + ,(Hex6 "ff" "fa" "fa", Named "snow") + ,(Hex6 "00" "80" "80", Named "teal") + ,(Hex6 "f0" "ff" "ff", Named "azure") + ,(Hex6 "f5" "f5" "dc", Named "beige") + ,(Hex6 "a5" "2a" "2a", Named "brown") + ,(Hex6 "ff" "7f" "50", Named "coral") + ,(Hex6 "00" "80" "00", Named "green") + ,(Hex6 "ff" "ff" "f0", Named "ivory") + ,(Hex6 "f0" "e6" "8c", Named "khaki") + ,(Hex6 "fa" "f0" "e6", Named "linen") + ,(Hex6 "80" "80" "00", Named "olive") + ,(Hex6 "f5" "de" "b3", Named "wheat") + ,(Hex6 "ff" "e4" "c4", Named "bisque") + ,(Hex6 "4b" "00" "82", Named "indigo") + ,(Hex6 "80" "00" "00", Named "maroon") + ,(Hex6 "ff" "a5" "00", Named "orange") + ,(Hex6 "da" "70" "d6", Named "orchid") + ,(Hex6 "80" "00" "80", Named "purple") + ,(Hex6 "fa" "80" "72", Named "salmon") + ,(Hex6 "a0" "52" "2d", Named "sienna") + ,(Hex6 "c0" "c0" "c0", Named "silver") + ,(Hex6 "ff" "63" "47", Named "tomato") + ,(Hex6 "ee" "82" "ee", Named "violet")] -- | Mapping between color names and hex values colorMap :: Map.Map Text Color colorMap = Map.fromList keywordColors +-- | Pairs of color keywords, and their equivalent hexadecimal value. keywordColors :: [(Text, Color)] keywordColors = map (first T.toLower) [("aliceblue", Hex6 "f0" "f8" "ff") diff --git a/src/Hasmin/Types/Declaration.hs b/src/Hasmin/Types/Declaration.hs --- a/src/Hasmin/Types/Declaration.hs +++ b/src/Hasmin/Types/Declaration.hs @@ -8,8 +8,8 @@ -- Portability : unknown -- ----------------------------------------------------------------------------- -module Hasmin.Types.Declaration ( - Declaration(..) +module Hasmin.Types.Declaration + ( Declaration(..) , clean ) where @@ -30,7 +30,7 @@ import Hasmin.Config import Hasmin.Properties import Hasmin.Types.BgSize -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.Dimension import Hasmin.Types.Numeric import Hasmin.Types.PercentageLength @@ -39,10 +39,11 @@ import Hasmin.Types.Value import Hasmin.Utils -data Declaration = Declaration { propertyName :: Text - , valueList :: Values - , isImportant :: Bool -- ends with !important - , hasIEhack :: Bool -- ends with \9 +-- | A CSS >. +data Declaration = Declaration { propertyName :: Text -- ^ Property name of the declaration. + , valueList :: Values -- ^ Values used in the declaration. + , isImportant :: Bool -- ^ Whether the declaration is \"!important\" (i.e. ends with it). + , hasIEhack :: Bool -- ^ Whether the declaration ends with the \"\\9\" IE hack. } deriving (Eq, Show) instance ToText Declaration where toBuilder (Declaration p vs i h) = fromText p <> singleton ':' @@ -50,9 +51,13 @@ where imp | i = "!important" | otherwise = mempty +instance Ord Declaration where + -- Just use a lexicographical ordering, since the instance is required by Set + d1 <= d2 = toText d1 <= toText d2 + instance Minifiable Declaration where - minifyWith d@(Declaration p vs _ _) = do - minifiedValues <- minifyWith vs + minify d@(Declaration p vs _ _) = do + minifiedValues <- minify vs conf <- ask let name = case letterCase conf of Lowercase -> T.toLower p @@ -67,7 +72,7 @@ conf <- ask pure $ if shouldUsePropertyTraits conf then case Map.lookup (T.toCaseFold p) propertiesTraits of - Just (vals, inhs) -> minifyDec d vals inhs + (Just (PropertyInfo vals inhs _ _)) -> minifyDec d vals inhs Nothing -> d else d @@ -150,10 +155,14 @@ in p { offset1 = stripPercentage a, offset2 = stripPercentage b } f (PercentageV p) = pure $ zeroPercentageToLength p where zeroPercentageToLength :: Percentage -> Value - zeroPercentageToLength 0 = DistanceV (Distance 0 Q) + zeroPercentageToLength 0 = LengthV NullLength zeroPercentageToLength x = PercentageV x - f (BgSizeV (BgSize x y)) = pure . BgSizeV $ BgSize (zeroPerToLength x) (fmap zeroPerToLength y) - where zeroPerToLength (Left (Left 0)) = Left $ Right (Distance 0 Q) + f (BgSizeV bgsz) = pure . BgSizeV $ + case bgsz of + BgSize1 x -> BgSize1 (zeroPerToLength x) + BgSize2 x y -> BgSize2 (zeroPerToLength x) (zeroPerToLength y) + x -> x + where zeroPerToLength (Left (Left 0)) = Left $ Right NullLength zeroPerToLength z = z f x = pure x @@ -167,12 +176,13 @@ | not (null vs) = pure d -- Some error occured, since there should be only one value | otherwise = case Map.lookup (T.toCaseFold p) propertiesTraits of - Just (iv, inhs) -> if f iv inhs == mkOther s - then pure $ d { valueList = Values (DistanceV (Distance 0 Q)) [] } - else pure d - Nothing -> pure d + Just (PropertyInfo iv inhs _ _) -> + if f iv inhs == mkOther s + then pure $ d { valueList = Values (LengthV NullLength) [] } + else pure d + Nothing -> pure d where f (Just (Values x _)) inh - | v == Initial || v == Unset && not inh = x + | v == Initial || v == Unset && inh == NonInherited = x | otherwise = v f _ _ = v @@ -194,37 +204,37 @@ | otherwise = Other t optimizeTransformOrigin :: Declaration -> Reader Config Declaration -optimizeTransformOrigin d@(Declaration _ v _ _) = do +optimizeTransformOrigin d@(Declaration _ vals _ _) = do conf <- ask pure $ if shouldMinifyTransformOrigin conf - then d { valueList = optimizeTransformOrigin' v} + then d { valueList = optimizeTransformOrigin' vals} else d - -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 + 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 (DistanceV (Distance 0 Q)) = True -isZeroVal (NumberV (Number 0)) = True -isZeroVal (PercentageV 0) = True -isZeroVal _ = False +isZeroVal (LengthV (Length 0 _)) = True +isZeroVal (LengthV NullLength) = True +isZeroVal (NumberV (Number 0)) = True +isZeroVal (PercentageV 0) = True +isZeroVal _ = False transformOrigin1 :: Value -> [Value] transformOrigin1 (Other "top") = [Other "top"] transformOrigin1 (Other "bottom") = [Other "bottom"] transformOrigin1 (Other "right") = [PercentageV (Percentage 100)] -transformOrigin1 (Other "left") = [DistanceV (Distance 0 Q)] +transformOrigin1 (Other "left") = [LengthV NullLength] transformOrigin1 (Other "center") = [PercentageV (Percentage 50)] -transformOrigin1 (PercentageV 0) = [DistanceV (Distance 0 Q)] +transformOrigin1 (PercentageV 0) = [LengthV NullLength] transformOrigin1 x = [x] transformOrigin2 :: Value -> Value -> [Value] @@ -239,24 +249,24 @@ | isYoffsetKeyword y = [y] | y == per100 = [Other "bottom"] | isZeroVal y = [Other "top"] - | isPercentageOrDistance y = [per50, y] + | isPercentageOrLength y = [per50, y] | otherwise = transformOrigin1 y secondIsCenter | equalsCenter x = [per50] - | isYoffsetKeyword x || isPercentageOrDistance x = [x] + | isYoffsetKeyword x || isPercentageOrLength x = [x] | otherwise = transformOrigin1 x - isPercentageOrDistance (PercentageV _) = True - isPercentageOrDistance (DistanceV _) = True - isPercentageOrDistance _ = False + isPercentageOrLength (PercentageV _) = True + isPercentageOrLength (LengthV _) = True + isPercentageOrLength _ = False equalsCenter a = a == Other "center" || a == per50 isXoffsetKeyword a = a == Other "left" || a == Other "right" isYoffsetKeyword a = a == Other "top" || a == Other "bottom" per50 = PercentageV $ Percentage 50 per100 = PercentageV $ Percentage 100 convertValue (Other t) = fromMaybe (Other t) (Map.lookup (getText t) transformOriginKeywords) - convertValue n@(PercentageV p) = if p == 0 - then DistanceV (Distance 0 Q) - else n + convertValue n@(PercentageV p) + | p == 0 = LengthV NullLength + | otherwise = n convertValue i = i transformOrigin3 :: Value -> Value -> Value -> [Value] @@ -266,34 +276,34 @@ | otherwise = fmap replaceKeywords [x, y, z] where replaceKeywords :: Value -> Value replaceKeywords (Other t) = fromMaybe x (Map.lookup (getText t) transformOriginKeywords) - replaceKeywords e = e + replaceKeywords e = e -- transform-origin keyword meanings. transformOriginKeywords :: Map Text Value transformOriginKeywords = Map.fromList - [("top", DistanceV (Distance 0 Q)) - ,("right", PercentageV (Percentage 100)) + [("top", LengthV NullLength) + ,("right", PercentageV (Percentage 100)) ,("bottom", PercentageV (Percentage 100)) - ,("left", DistanceV (Distance 0 Q)) + ,("left", LengthV NullLength) ,("center", PercentageV (Percentage 50))] -- | Minifies a declaration, based on the property's specific traits (i.e. if -- it inherits or not, and what its initial value is), and the chosen -- configurations. -minifyDec :: Declaration -> Maybe Values -> Bool -> Declaration -minifyDec d@(Declaration p vs _ _) mv inherits = +minifyDec :: Declaration -> Maybe Values -> Inheritance -> Declaration +minifyDec d@(Declaration p vs _ _) mv inhs = case mv of -- Use the found initial values to try to reduce the declaration Just vals -> 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 inherits - Nothing -> reduceDeclaration d vals inherits + Just f -> f d vals inhs + Nothing -> reduceDeclaration d vals inhs -- Property with no defined initial values. Try to reduce css-wide keywords Nothing -> - if not inherits && vs == initial || inherits && vs == inherit + if inhs == NonInherited && vs == initial || inhs == Inherited && vs == inherit then d { valueList = unset } else d @@ -308,7 +318,7 @@ -- Map of property specific reducers, for properties that don't fit in the -- normal declaration minification scheme and need special treatment. -declarationExceptions :: Map Text (Declaration -> Values -> Bool -> Declaration) +declarationExceptions :: Map Text (Declaration -> Values -> Inheritance -> Declaration) declarationExceptions = Map.fromList $ map (first T.toCaseFold) [("background-size", backgroundSizeReduce) ,("-webkit-background-size", backgroundSizeReduce) @@ -333,19 +343,19 @@ splitValues' (ts, os) (x:xs) = splitValues' (ts, os |> x) xs splitValues' (ts, os) [] = (ts, os) -backgroundSizeReduce :: Declaration -> Values -> Bool -> Declaration -backgroundSizeReduce d@(Declaration _ vs _ _) initVals inherits = +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 inherits } + _ -> d { valueList = shortestEquiv vs initVals inhs } -fontSynthesisReduce :: Declaration -> Values -> Bool -> Declaration -fontSynthesisReduce d@(Declaration _ vs _ _) initVals inherits = +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 inherits} + _ -> d {valueList = shortestEquiv vs initVals inhs} -- Function to reduce the great mayority of properties. Requires that: -- 1. The order between values doesn't matter, which is true for most @@ -354,11 +364,11 @@ -- 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 -> Bool -> Declaration -reduceDeclaration d@(Declaration _ vs _ _) initVals inherits = +reduceDeclaration :: Declaration -> Values -> Inheritance -> Declaration +reduceDeclaration d@(Declaration _ vs _ _) initVals inhs = case analyzeValueDifference vs initVals of - Just v -> d {valueList = shortestEquiv v shortestInitialValue inherits} - Nothing -> d {valueList = minVal inherits shortestInitialValue} + 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)] @@ -366,19 +376,19 @@ -- 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 -> Bool -> Values -shortestEquiv vs siv inherits - | inherits && vs == inherit = unset - | not inherits && vs == unset || vs == initial = minVal inherits siv +shortestEquiv :: Values -> Values -> Inheritance -> Values +shortestEquiv vs siv inhs + | inhs == Inherited && vs == inherit = unset + | inhs == NonInherited && vs == unset || vs == initial = minVal inhs siv | otherwise = vs -- Returns the minimum value (in character length) between the shortest initial -- value, and the shortest css-wide keyword (initial or unset) -minVal :: Bool -> Values -> Values -minVal inherits vs +minVal :: Inheritance -> Values -> Values +minVal inhs vs | textualLength globalKeyword <= textualLength vs = globalKeyword | otherwise = vs - where globalKeyword = mkValues [if not inherits then Unset else Initial] + 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 @@ -391,7 +401,7 @@ _ -> Just $ mkValues valuesDifference -- At least a value wasn't an initial one, or it was a css-wide keyword where valuesDifference = valuesToList vs \\ valuesToList initVals --- Removes longhand rules overwritten by their shorthand further down in the +-- | Removes longhand rules overwritten by their shorthand further down in the -- declaration list, and merges shorthand declarations with longhand properties -- later declared. clean :: [Declaration] -> [Declaration] @@ -401,8 +411,8 @@ in case newD of Just x -> x : clean newDs Nothing -> clean newDs -- drop and keep cleaning - where pinfo = fromMaybe (PropertyInfo mempty mempty) -- No info on the property, use an empty one. - (Map.lookup (propertyName d) shorthandAndLonghandsMap) + where pinfo = fromMaybe (PropertyInfo Nothing NonInherited mempty mempty) -- No info on the property, use an empty one. + (Map.lookup (propertyName d) propertiesTraits) -- Given a declaration, if it is a shorthand and it has a corresponding -- longhand later in the list, merges them. If it is a longhand overwritten by @@ -440,12 +450,11 @@ hasVendorPrefix :: Declaration -> Bool hasVendorPrefix (Declaration _ vs _ _) = any isVendorPrefixedValue $ valuesToList vs - -isVendorPrefixedValue :: Value -> Bool -isVendorPrefixedValue (Other t) = T.isPrefixOf "-" $ getText t -isVendorPrefixedValue (GradientV t _) = T.isPrefixOf "-" t -isVendorPrefixedValue (GenericFunc t _) = T.isPrefixOf "-" t -isVendorPrefixedValue _ = False + where isVendorPrefixedValue :: Value -> Bool + isVendorPrefixedValue (Other t) = T.isPrefixOf "-" $ getText t + isVendorPrefixedValue (GradientV t _) = T.isPrefixOf "-" t + isVendorPrefixedValue (GenericFunc t _) = T.isPrefixOf "-" t + isVendorPrefixedValue _ = False attemptMerge :: [Declaration] -> [Declaration] -> Declaration -> Declaration -> PropertyInfo @@ -553,6 +562,6 @@ mapValues :: (Value -> Reader Config Value) -> Values -> Reader Config Values mapValues f (Values v1 vs) = do - x <- f v1 + x <- f v1 xs <- (mapM . mapM) f vs pure $ Values x xs diff --git a/src/Hasmin/Types/Dimension.hs b/src/Hasmin/Types/Dimension.hs --- a/src/Hasmin/Types/Dimension.hs +++ b/src/Hasmin/Types/Dimension.hs @@ -12,9 +12,9 @@ -- dimensions into other equivalent dimensions. -- ----------------------------------------------------------------------------- -module Hasmin.Types.Dimension ( - Distance(..) - , DistanceUnit(..) +module Hasmin.Types.Dimension + ( Length(..) + , LengthUnit(..) , Angle(..) , AngleUnit(..) , Duration(..) @@ -27,59 +27,82 @@ , toPixels , toRadians , isRelative + , isRelativeLength + , isZeroLen + , isZeroAngle ) where import Control.Monad.Reader (asks) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton, fromText) -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.Numeric import Hasmin.Config import Hasmin.Utils -- | The \ CSS data type -data Distance = Distance Number DistanceUnit +data Length = Length Number LengthUnit + | NullLength deriving (Show) -instance Eq Distance where - (Distance r1 u1) == (Distance r2 u2) +instance Eq Length where + (Length r1 u1) == (Length r2 u2) | u1 == u2 = r1 == r2 | otherwise = toInches r1 u1 == toInches r2 u2 -instance Minifiable Distance where - minifyWith d@(Distance r u) = do + x == y = isZeroLen x && isZeroLen y +instance Minifiable Length where + minify NullLength = pure NullLength + minify d@(Length r u) = do shouldMinifyUnits <- asks ((DimMinOn ==) . dimensionSettings) - pure $ if (not . isRelative) u && shouldMinifyUnits - then minDim Distance r u [Q, CM, MM, IN, PC, PT, PX] - else d + pure $ if d == Length 0 Q + then NullLength + else if (not . isRelative) u && shouldMinifyUnits + then minDim Length r u [Q, CM, MM, IN, PC, PT, PX] + else d -isRelative :: DistanceUnit -> Bool +isRelative :: LengthUnit -> Bool isRelative x = x == EM || x == EX || x == CH || x == VH || x == VW || x == VMIN || x == VMAX || x == REM -instance ToText Distance where - toBuilder (Distance 0 _) = singleton '0' - toBuilder (Distance r u) = (fromText . toText) r <> (fromText . toText) u +isRelativeLength :: Length -> Bool +isRelativeLength (Length _ u) = isRelative u +isRelativeLength NullLength = False +isZeroLen :: Length -> Bool +isZeroLen (Length 0 _) = True +isZeroLen NullLength = True +isZeroLen _ = False + +instance ToText Length where + toBuilder (Length r u) = (fromText . toText) r <> (fromText . toText) u + toBuilder NullLength = singleton '0' + -- | The \ CSS data type data Angle = Angle Number AngleUnit + | NullAngle deriving (Show) instance Eq Angle where (Angle r1 u1) == (Angle r2 u2) | u1 == u2 = r1 == r2 | otherwise = toDegrees r1 u1 == toDegrees r2 u2 -instance Minifiable Angle where - minifyWith a = do - shouldMinifyUnits <- asks ((DimMinOn ==) . dimensionSettings) - pure $ if shouldMinifyUnits - then minifyAngle a - else a + x == y = isZeroAngle x && isZeroAngle y -minifyAngle :: Angle -> Angle -minifyAngle (Angle r u) = minDim Angle r u [Turn, Grad, Rad, Deg] +isZeroAngle :: Angle -> Bool +isZeroAngle NullAngle = True +isZeroAngle (Angle 0 _) = True +isZeroAngle _ = False +instance Minifiable Angle where + minify (Angle 0 _) = pure NullAngle + minify a@(Angle r u) = do + dimSettings <- asks dimensionSettings + pure $ case dimSettings of + DimMinOn -> minDim Angle r u [Turn, Grad, Rad, Deg] + DimMinOff -> a + minify NullAngle = pure NullAngle + instance ToText Angle where - toBuilder (Angle r u) - | abs r < toNumber eps = singleton '0' - | otherwise = toBuilder r <> toBuilder u + toBuilder NullAngle = singleton '0' + toBuilder (Angle r u) = toBuilder r <> toBuilder u -- | The \ CSS data type data Duration = Duration Number DurationUnit @@ -89,11 +112,11 @@ | u1 == u2 = r1 == r2 | otherwise = toSeconds r1 u1 == toSeconds r2 u2 instance Minifiable Duration where - minifyWith d@(Duration r u) = do - shouldMinifyUnits <- asks ((DimMinOn ==) . dimensionSettings) - pure $ if shouldMinifyUnits - then minDim Duration r u [S, Ms] - else d + minify d@(Duration r u) = do + dimSettings <- asks dimensionSettings + pure $ case dimSettings of + DimMinOn -> minDim Duration r u [S, Ms] + DimMinOff -> d instance ToText Duration where toBuilder (Duration r u) = toBuilder r <> toBuilder u @@ -105,7 +128,7 @@ | u1 == u2 = r1 == r2 | otherwise = toHertz r1 u1 == toHertz r2 u2 instance Minifiable Frequency where - minifyWith f@(Frequency r u) = do + minify f@(Frequency r u) = do dimSettings <- asks dimensionSettings pure $ case dimSettings of DimMinOn -> minDim Frequency r u [Khz, Hz] @@ -121,11 +144,11 @@ | u1 == u2 = r1 == r2 | otherwise = toDpi r1 u1 == toDpi r2 u2 instance Minifiable Resolution where - minifyWith x@(Resolution r u) = do - shouldMinifyUnits <- asks ((DimMinOn ==) . dimensionSettings) - pure $ if shouldMinifyUnits - then minDim Resolution r u [Dpcm, Dppx, Dpi] - else x + minify x@(Resolution r u) = do + dimSettings <- asks dimensionSettings + pure $ case dimSettings of + DimMinOn -> minDim Resolution r u [Dpcm, Dppx, Dpi] + DimMinOff -> x instance ToText Resolution where toBuilder (Resolution r u) = toBuilder r <> toBuilder u @@ -144,10 +167,10 @@ class Unit a where convertTo :: a -> Number -> a -> Number -data DistanceUnit = IN | CM | MM | Q | PC | PT | PX -- absolute +data LengthUnit = IN | CM | MM | Q | PC | PT | PX -- absolute | EM | EX | CH | VH | VW | VMIN | VMAX | REM -- relative deriving (Show, Eq) -instance ToText DistanceUnit where +instance ToText LengthUnit where toBuilder IN = "in" toBuilder CM = "cm" toBuilder MM = "mm" @@ -163,7 +186,7 @@ toBuilder VMIN = "vmin" toBuilder VMAX = "vmax" toBuilder REM = "rem" -instance Unit DistanceUnit where +instance Unit LengthUnit where convertTo IN = toInches convertTo CM = toCentimeters convertTo MM = toMilimeters @@ -216,7 +239,7 @@ convertTo Dpcm = toDpcm convertTo Dppx = toDppx -toInches :: Number -> DistanceUnit -> Number +toInches :: Number -> LengthUnit -> Number toInches d CM = d / 2.54 toInches d MM = d / 25.4 toInches d Q = d / 101.6 @@ -225,7 +248,7 @@ toInches d PX = d / 96 toInches d _ = d -- IN, or any relative value -toCentimeters :: Number -> DistanceUnit -> Number +toCentimeters :: Number -> LengthUnit -> Number toCentimeters d IN = d * 2.54 toCentimeters d MM = d / 10 toCentimeters d Q = d / 40 @@ -234,7 +257,7 @@ toCentimeters d PX = d * (2.54 / 96) toCentimeters d _ = d -- CM, or any relative value -toMilimeters :: Number -> DistanceUnit -> Number +toMilimeters :: Number -> LengthUnit -> Number toMilimeters d IN = d * 25.4 toMilimeters d CM = d * 10 toMilimeters d Q = d / 4 @@ -243,7 +266,7 @@ toMilimeters d PX = d * (25.4 / 96) toMilimeters d _ = d -toQuarterMilimeter :: Number -> DistanceUnit -> Number +toQuarterMilimeter :: Number -> LengthUnit -> Number toQuarterMilimeter d IN = d * 101.6 toQuarterMilimeter d CM = d * 40 toQuarterMilimeter d MM = d * 4 @@ -252,7 +275,7 @@ toQuarterMilimeter d PX = d * (101.6 / 96) toQuarterMilimeter d _ = d -toPoints :: Number -> DistanceUnit -> Number +toPoints :: Number -> LengthUnit -> Number toPoints d IN = d * 72 toPoints d CM = d * (72 / 2.54) toPoints d MM = d * (72 / 25.4) @@ -261,7 +284,7 @@ toPoints d PX = d * (3 / 4) toPoints d _ = d -toPica :: Number -> DistanceUnit -> Number +toPica :: Number -> LengthUnit -> Number toPica d IN = d * 6 toPica d CM = d * (6 / 2.54) toPica d MM = d * (6 / 25.4) @@ -270,7 +293,7 @@ toPica d PX = d / 16 toPica d _ = d -toPixels :: Number -> DistanceUnit -> Number +toPixels :: Number -> LengthUnit -> Number toPixels d IN = d * 96 toPixels d CM = d * (96 / 2.54) toPixels d MM = d * (96 / 25.4) diff --git a/src/Hasmin/Types/FilterFunction.hs b/src/Hasmin/Types/FilterFunction.hs --- a/src/Hasmin/Types/FilterFunction.hs +++ b/src/Hasmin/Types/FilterFunction.hs @@ -17,18 +17,14 @@ import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton, Builder) import Hasmin.Config -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.Dimension import Hasmin.Types.Color import Hasmin.Types.Numeric --- Note: In a previous specification, translate3d() took two --- >, --- however in the , it --- takes two \ (which makes sense since translateX() and --- translateY() also do). - -data FilterFunction = Blur Distance +-- | CSS > +-- data type. +data FilterFunction = Blur Length | Brightness (Either Number Percentage) | Contrast (Either Number Percentage) | Grayscale (Either Number Percentage) @@ -37,7 +33,7 @@ | Saturate (Either Number Percentage) | Sepia (Either Number Percentage) | HueRotate Angle - | DropShadow Distance Distance (Maybe Distance) (Maybe Color) + | DropShadow Length Length (Maybe Length) (Maybe Color) deriving (Show) instance Eq FilterFunction where Blur a == Blur b = a == b @@ -51,8 +47,8 @@ HueRotate a == HueRotate b = a == b DropShadow a b c d == DropShadow e f g h = a == e && b == f && d == h && c `thirdValueEq` g - where thirdValueEq Nothing (Just (Distance 0 _)) = True - thirdValueEq (Just (Distance 0 _)) Nothing = True + where thirdValueEq Nothing (Just n) | isZeroLen n = True + thirdValueEq (Just n) Nothing | isZeroLen n = True thirdValueEq x y = x == y _ == _ = False instance ToText FilterFunction where @@ -71,33 +67,33 @@ in "drop-shadow(" <> toBuilder l1 <> singleton ' ' <> toBuilder l2 <> maybeToBuilder ml <> maybeToBuilder mc <> singleton ')' instance Minifiable FilterFunction where - minifyWith (Blur a) = Blur <$> minifyWith a - minifyWith (HueRotate a) = HueRotate <$> minifyWith a - minifyWith (Contrast x) = Contrast <$> minifyNumberPercentage x - minifyWith (Brightness x) = Brightness <$> minifyNumberPercentage x - minifyWith (Grayscale x) = Grayscale <$> minifyNumberPercentage x - minifyWith (Invert x) = Invert <$> minifyNumberPercentage x - minifyWith (Opacity x) = Opacity <$> minifyNumberPercentage x - minifyWith (Saturate x) = Saturate <$> minifyNumberPercentage x - minifyWith (Sepia x) = Sepia <$> minifyNumberPercentage x - minifyWith s@(DropShadow a b c d) = do + minify (Blur a) = Blur <$> minify a + minify (HueRotate a) = HueRotate <$> minify a + minify (Contrast x) = Contrast <$> minifyNumberPercentage x + minify (Brightness x) = Brightness <$> minifyNumberPercentage x + minify (Grayscale x) = Grayscale <$> minifyNumberPercentage x + minify (Invert x) = Invert <$> minifyNumberPercentage x + minify (Opacity x) = Opacity <$> minifyNumberPercentage x + minify (Saturate x) = Saturate <$> minifyNumberPercentage x + minify (Sepia x) = Sepia <$> minifyNumberPercentage x + minify s@(DropShadow a b c d) = do conf <- ask if shouldMinifyFilterFunctions conf then minifyPseudoShadow DropShadow a b c d else pure s minifyPseudoShadow :: (Minifiable b, Minifiable t1, Minifiable t2, Traversable t) - => (t2 -> t1 -> Maybe Distance -> t b -> b1) - -> t2 -> t1 -> Maybe Distance -> t b -> Reader Config b1 + => (t2 -> t1 -> Maybe Length -> t b -> b1) + -> t2 -> t1 -> Maybe Length -> t b -> Reader Config b1 minifyPseudoShadow constr a b c d = do - x <- minifyWith a - y <- minifyWith b + x <- minify a + y <- minify b z <- case c of - Just r -> if r == Distance 0 Q + Just r -> if isZeroLen r then pure Nothing - else mapM minifyWith c + else mapM minify c Nothing -> pure Nothing - c2 <- mapM minifyWith d + c2 <- mapM minify d pure $ constr x y z c2 minifyNumberPercentage :: Either Number Percentage diff --git a/src/Hasmin/Types/Gradient.hs b/src/Hasmin/Types/Gradient.hs --- a/src/Hasmin/Types/Gradient.hs +++ b/src/Hasmin/Types/Gradient.hs @@ -22,7 +22,7 @@ import Data.Maybe (catMaybes, fromJust, isNothing, isJust) import Data.Either (isLeft) import Hasmin.Config -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.Color import Hasmin.Types.Dimension import Hasmin.Types.Numeric @@ -43,7 +43,7 @@ type SideOrCorner = (Side, Maybe Side) -- | CSS data type -data ColorStop = ColorStop { csColor :: Color +data ColorStop = ColorStop { csColor :: Color , colorHint :: Maybe PercentageLength } deriving (Show, Eq) instance ToText ColorStop where @@ -51,18 +51,11 @@ where f (Left p) = singleton ' ' <> toBuilder p f (Right l) = singleton ' ' <> toBuilder l instance Minifiable ColorStop where - minifyWith (ColorStop c mlp) = do - newC <- minifyWith c - newMlp <- (mapM . mapM) minifyWith mlp + minify (ColorStop c mlp) = do + newC <- minify c + newMlp <- (mapM . mapM) minify mlp pure $ ColorStop newC newMlp -{- -percentageLengthEq :: PercentageLength -> PercentageLength -> Bool -x `percentageLengthEq` y - | isZero x = isZero y - | otherwise = x == y --} - -- minifies color hints in a \ list minifyColorHints :: [ColorStop] -> [ColorStop] minifyColorHints [c1,c2] = [newC1, newC2] @@ -74,7 +67,7 @@ newC2 | ch2 == Just (Left (Percentage 100)) = c2 {colorHint = Nothing} | otherwise = if ch2 `notGreaterThan` ch1 - then c2 {colorHint = Just $ Right (Distance 0 PX)} + then c2 {colorHint = Just $ Right NullLength} else c2 minifyColorHints (c@(ColorStop a x):xs) = case x of Nothing -> c : analyzeList (Left $ Percentage 0) 1 (c:xs) xs @@ -90,9 +83,16 @@ | 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) (notGreaterThanDistance d)) y - where notPositive = maybe False (either (<= 0) (\(Distance d _) -> d <= 0)) - notGreaterThanDistance (Distance r1 u1) (Distance r2 u2) + 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 @@ -101,7 +101,7 @@ -- 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] + -> [ColorStop] -> [ColorStop] analyzeList start n list (ColorStop _ mpl:xs) | n < 2 = analyzeList start (n+1) list xs | otherwise = @@ -122,7 +122,7 @@ -- 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) + -> ([ColorStop], [ColorStop], PercentageLength) minifySegment start end n list | all isPercentage segment = handlePercentages (fromLeft' start) (fromLeft' end) n remainingList -- add here support for dimension interpolation @@ -144,11 +144,13 @@ if fromLeft' v == y then Nothing else if fromLeft' v <= start - then Just $ Right (Distance 0 PX) + then Just $ Right NullLength else Just v --- OldLinearGradient is for the old syntax. Eventually it can probably be deleted. +-- | CSS > +-- 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) @@ -175,8 +177,10 @@ and = [ | ]? -} +-- | CSS > data +-- type, used by @radial-gradient()@. data Size = ClosestCorner | ClosestSide | FarthestCorner | FarthestSide - | SL Distance + | SL Length | PL PercentageLength PercentageLength deriving (Eq, Show) @@ -188,6 +192,8 @@ toBuilder (SL d) = toBuilder d toBuilder (PL pl1 pl2) = toBuilder pl1 <> singleton ' ' <> toBuilder pl2 +-- TODO rename to EndingShape +-- | CSS > data type, used by @radial-gradient()@. data Shape = Circle | Ellipse deriving (Eq, Show) @@ -198,23 +204,23 @@ -- 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 - minifyWith g@(OldLinearGradient x cs) = do + minify g@(OldLinearGradient x cs) = do conf <- ask case gradientSettings conf of - GradientMinOn -> do css <- mapM minifyWith cs + GradientMinOn -> do css <- mapM minify cs pure $ OldLinearGradient x (minifyColorHints css) GradientMinOff -> pure g - minifyWith g@(LinearGradient x cs) = do + minify g@(LinearGradient x cs) = do conf <- ask case gradientSettings conf of - GradientMinOn -> do css <- mapM minifyWith cs + GradientMinOn -> do css <- mapM minify cs newX <- minifyAngleOrSide x pure $ LinearGradient newX (minifyColorHints css) GradientMinOff -> pure g - minifyWith g@(RadialGradient sh sz p cs) = do + minify g@(RadialGradient sh sz p cs) = do conf <- ask case gradientSettings conf of - GradientMinOn -> do css <- mapM minifyWith cs + GradientMinOn -> do css <- mapM minify cs let np = minifyRadialPosition True {-shouldMinifyPosition conf-} p pure $ minShapeAndSize sh sz np (minifyColorHints css) GradientMinOff -> pure g @@ -254,21 +260,18 @@ Just y -> case y of Left a -> if a == defaultGradientAngle then pure Nothing - else minifyWith a >>= pure . Just . Left + else minify a >>= pure . Just . Left Right b -> if b == defaultGradientSideOrCorner then pure Nothing else pure $ Just (minifySide b) - where minifySide (TopSide, Nothing) = Left (Angle 0 Deg) + where 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 -defaultGradientAngle :: Angle -defaultGradientAngle = Angle 180 Deg - -defaultGradientSideOrCorner :: SideOrCorner -defaultGradientSideOrCorner = (BottomSide, Nothing) + defaultGradientAngle = Angle 180 Deg + defaultGradientSideOrCorner = (BottomSide, Nothing) instance ToText Gradient where toBuilder (OldLinearGradient mas csl) = maybe mempty f mas @@ -300,11 +303,15 @@ handleEither (Left a) (Right s) = angleSideEq a s handleEither (Right s) (Left a) = angleSideEq a s handleEither s1 s2 = s1 == s2 - _ == _ = error "Non supported gradient comparison" + LinearGradient{} == _ = False + _ == LinearGradient{} = False + _ == _ = False -- TODO implement other comparisons angleSideEq :: Angle -> SideOrCorner -> Bool -angleSideEq (Angle 0 Deg) (TopSide, Nothing) = True 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 diff --git a/src/Hasmin/Types/Numeric.hs b/src/Hasmin/Types/Numeric.hs --- a/src/Hasmin/Types/Numeric.hs +++ b/src/Hasmin/Types/Numeric.hs @@ -11,14 +11,19 @@ -- All Rational newtypes to ensure dimension conversion precision. -- ----------------------------------------------------------------------------- -module Hasmin.Types.Numeric ( - Percentage(..), toPercentage, - Number(..), toNumber, fromNumber, - Alphavalue(..), toAlphavalue, mkAlphavalue +module Hasmin.Types.Numeric + ( Percentage(..) + , toPercentage + , Number(..) + , toNumber + , fromNumber + , Alphavalue(..) + , toAlphavalue + , mkAlphavalue ) where import Data.Text (pack) -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Utils import Text.Printf (printf) @@ -55,13 +60,13 @@ deriving (Eq, Show, Ord, Real, RealFrac) instance Num Alphavalue where - a + b = mkAlphavalue $ toRational a + toRational b - a * b = mkAlphavalue $ toRational a * toRational b - abs = id -- numbers are never negative, so abs doesn't do anything + abs = id -- numbers are never negative, so abs doesn't do anything + a - b = mkAlphavalue $ toRational a - toRational b + a + b = mkAlphavalue $ toRational a + toRational b + a * b = mkAlphavalue $ toRational a * toRational b + fromInteger = toAlphavalue signum a | toRational a == 0 = 0 | otherwise = 1 - fromInteger = toAlphavalue - a - b = mkAlphavalue $ toRational a - toRational b instance ToText Alphavalue where toText = pack . trimLeadingZeros . showRat . toRational @@ -98,14 +103,16 @@ -- | Show a Rational in decimal notation, removing leading zeros, -- and not displaying fractional part if the number is an integer. showRat :: Rational -> String -showRat r | abs (r - fromInteger x) < eps = printf "%d" x - | otherwise = printf "%f" d +showRat r + | abs (r - fromInteger x) < eps = printf "%d" x + | otherwise = printf "%f" d where x = round r d = fromRational r :: Double trimLeadingZeros :: String -> String -trimLeadingZeros l@(x:xs) | x == '-' = x : go xs - | otherwise = go l +trimLeadingZeros l@(x:xs) + | x == '-' = x : go xs + | otherwise = go l where go ('0':y:ys) = go (y:ys) go z = z trimLeadingZeros [] = "" diff --git a/src/Hasmin/Types/PercentageLength.hs b/src/Hasmin/Types/PercentageLength.hs --- a/src/Hasmin/Types/PercentageLength.hs +++ b/src/Hasmin/Types/PercentageLength.hs @@ -16,26 +16,27 @@ import Hasmin.Types.Dimension import Hasmin.Types.Numeric -import Hasmin.Types.Class +import Hasmin.Class -- | CSS data type, i.e.: [length | percentage] -- Though because of the name it would be more intuitive to define: --- type LengthPercentage = Either Distance Percentage, +-- type LengthPercentage = Either Length Percentage, -- they are inverted here to make use of Either's Functor instance, because it -- makes no sense to minify a Percentage. -type PercentageLength = Either Percentage Distance +type PercentageLength = Either Percentage Length -- TODO see if this instance can be deleted altogether. instance Minifiable PercentageLength where - minifyWith x@(Right _) = mapM minifyWith x - minifyWith x@(Left p) | p == 0 = pure $ Right (Distance 0 Q) -- minifies 0% to 0 - | otherwise = pure x + minify x@(Right _) = mapM minify x + minify x@(Left p) + | p == 0 = pure $ Right NullLength -- minifies 0% to 0 + | otherwise = pure x isNonZeroPercentage :: PercentageLength -> Bool isNonZeroPercentage (Left p) = p /= 0 isNonZeroPercentage _ = False -isZero :: (Num a, Eq a) => Either a Distance -> Bool -isZero = either (== 0) (== Distance 0 Q) +isZero :: (Num a, Eq a) => Either a Length -> Bool +isZero = either (== 0) isZeroLen diff --git a/src/Hasmin/Types/Position.hs b/src/Hasmin/Types/Position.hs --- a/src/Hasmin/Types/Position.hs +++ b/src/Hasmin/Types/Position.hs @@ -20,7 +20,7 @@ import qualified Data.Text as T import Data.Text.Lazy.Builder (singleton, fromText) import Data.Maybe (isJust) -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.Dimension import Hasmin.Types.PercentageLength import Hasmin.Utils @@ -46,7 +46,7 @@ , offset2 :: Maybe PercentageLength } deriving (Show) instance Minifiable Position where - minifyWith p = pure $ minifyPosition p + minify p = pure $ minifyPosition p instance ToText Position where toBuilder (Position a b c d) = mconcatIntersperse fromText (singleton ' ') $ filter (not . T.null) [f a, f b, f c, f d] @@ -213,12 +213,12 @@ minAxis PosCenter x = (Just PosCenter, Just x) instance Eq Position where - x == y = minify x `equals` minify y - where equals (Position a b c d) (Position e f g h) = - a == e && b == f && c == g && d == h + x == y = let (Position a b c d) = minifyPosition x + (Position e f g h) = minifyPosition y + in a == e && b == f && c == g && d == h l0 :: Maybe PercentageLength -l0 = Just (Right (Distance 0 Q)) +l0 = Just $ Right NullLength p100 :: Maybe PercentageLength p100 = Just $ Left 100 diff --git a/src/Hasmin/Types/RepeatStyle.hs b/src/Hasmin/Types/RepeatStyle.hs --- a/src/Hasmin/Types/RepeatStyle.hs +++ b/src/Hasmin/Types/RepeatStyle.hs @@ -7,57 +7,61 @@ -- Stability : experimental -- Portability : unknown -- --- \ data type used in background-repeat. Specification: --- --- ----------------------------------------------------------------------------- -module Hasmin.Types.RepeatStyle ( - RepeatStyle(..) +module Hasmin.Types.RepeatStyle + ( RepeatStyle(..) , RSKeyword(..) ) where -import Control.Monad.Reader (ask) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton) -import Hasmin.Types.Class +import Hasmin.Class +-- | CSS > +-- data type, used in the properties @background-repeat@ and @background@. data RepeatStyle = RepeatX | RepeatY - | RSPair RSKeyword (Maybe RSKeyword) + | RepeatStyle1 RSKeyword + | RepeatStyle2 RSKeyword RSKeyword deriving Show instance ToText RepeatStyle where - toBuilder RepeatX = "repeat-x" - toBuilder RepeatY = "repeat-y" - toBuilder (RSPair r1 r2 ) = toBuilder r1 <> maybe mempty (\x -> singleton ' ' <> toBuilder x) r2 + toBuilder RepeatX = "repeat-x" + toBuilder RepeatY = "repeat-y" + toBuilder (RepeatStyle1 x) = toBuilder x + toBuilder (RepeatStyle2 x y) = toBuilder x <> singleton ' ' <> toBuilder y instance Minifiable RepeatStyle where - minifyWith r = do - conf <- ask - pure $ if True {- shouldMinifyRepeatStyle conf -} - then minifyRepeatStyle r - else r + minify r = pure $ minifyRepeatStyle r + where minifyRepeatStyle :: RepeatStyle -> RepeatStyle + minifyRepeatStyle (RepeatStyle2 RsRepeat RsNoRepeat) = RepeatX + minifyRepeatStyle (RepeatStyle2 RsNoRepeat RsRepeat) = RepeatY + minifyRepeatStyle rs2@(RepeatStyle2 x y) + | x == y = RepeatStyle1 x + | otherwise = rs2 + minifyRepeatStyle x = x + instance Eq RepeatStyle where RepeatX == RepeatX = True - a@RepeatX == b@RSPair{} = b == a + a@RepeatX == b@RepeatStyle2{} = b == a + RepeatStyle2 RsRepeat RsNoRepeat == RepeatX = True RepeatY == RepeatY = True - a@RepeatY == b@RSPair{} = b == a - RSPair RsNoRepeat (Just RsRepeat) == RepeatY = True - RSPair RsRepeat (Just RsNoRepeat) == RepeatX = True - RSPair RsNoRepeat (Just RsRepeat) == RSPair RsNoRepeat (Just RsRepeat) = True - RSPair RsRepeat (Just RsNoRepeat) == RSPair RsRepeat (Just RsNoRepeat) = True - RSPair RsSpace (Just RsSpace) == RSPair RsSpace Nothing = True - RSPair RsSpace (Just RsSpace) == RSPair RsSpace (Just RsSpace) = True - RSPair RsRound (Just RsRound) == RSPair RsRound Nothing = True - RSPair RsRound (Just RsRound) == RSPair RsRound (Just RsRound) = True - RSPair RsNoRepeat (Just RsNoRepeat) == RSPair RsNoRepeat Nothing = True - RSPair RsNoRepeat (Just RsNoRepeat) == RSPair RsNoRepeat (Just RsNoRepeat) = True - RSPair RsRepeat (Just RsRepeat) == RSPair RsRepeat Nothing = True - RSPair RsRepeat (Just RsRepeat) == RSPair RsRepeat (Just RsRepeat) = True - RSPair x Nothing == RSPair y Nothing = x == y - a@(RSPair _ Nothing) == b@(RSPair _ _) = b == a - RSPair x y == RSPair z w = x == z && y == w + a@RepeatY == b@RepeatStyle2{} = b == a + RepeatStyle2 RsNoRepeat RsRepeat == RepeatY = True + RepeatStyle2 RsNoRepeat RsRepeat == RepeatStyle2 RsNoRepeat RsRepeat = True + RepeatStyle2 RsRepeat RsNoRepeat == RepeatStyle2 RsRepeat RsNoRepeat = True + RepeatStyle2 RsSpace RsSpace == RepeatStyle2 RsSpace RsSpace = True + RepeatStyle2 RsSpace RsSpace == RepeatStyle1 RsSpace = True + RepeatStyle2 RsRound RsRound == RepeatStyle2 RsRound RsRound = True + RepeatStyle2 RsRound RsRound == RepeatStyle1 RsRound = True + RepeatStyle2 RsNoRepeat RsNoRepeat == RepeatStyle2 RsNoRepeat RsNoRepeat = True + RepeatStyle2 RsNoRepeat RsNoRepeat == RepeatStyle1 RsNoRepeat = True + RepeatStyle2 RsRepeat RsRepeat == RepeatStyle2 RsRepeat RsRepeat = True + RepeatStyle2 RsRepeat RsRepeat == RepeatStyle1 RsRepeat = True + RepeatStyle1 x == RepeatStyle1 y = x == y + a@RepeatStyle1{} == b@RepeatStyle2{} = b == a + RepeatStyle2 x1 y1 == RepeatStyle2 x2 y2 = x1 == x2 && y1 == y2 _ == _ = False -data RSKeyword = RsRepeat +data RSKeyword = RsRepeat | RsSpace | RsRound | RsNoRepeat @@ -67,11 +71,3 @@ toBuilder RsSpace = "space" toBuilder RsRound = "round" toBuilder RsNoRepeat = "no-repeat" - -minifyRepeatStyle :: RepeatStyle -> RepeatStyle -minifyRepeatStyle (RSPair RsRepeat (Just RsNoRepeat)) = RepeatX -minifyRepeatStyle (RSPair RsNoRepeat (Just RsRepeat)) = RepeatY -minifyRepeatStyle (RSPair x (Just y)) - | x == y = RSPair x Nothing - | otherwise = RSPair x (Just y) -minifyRepeatStyle x = x diff --git a/src/Hasmin/Types/Selector.hs b/src/Hasmin/Types/Selector.hs --- a/src/Hasmin/Types/Selector.hs +++ b/src/Hasmin/Types/Selector.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE OverloadedStrings - , FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Hasmin.Types.Selector @@ -9,8 +9,8 @@ -- Portability : unknown -- ----------------------------------------------------------------------------- -module Hasmin.Types.Selector ( - Selector(..) +module Hasmin.Types.Selector + ( Selector(..) , SimpleSelector(..) , CompoundSelector , Combinator(..) @@ -18,6 +18,7 @@ , AnPlusB(..) , Att(..) , specialPseudoElements + , specificity ) where import Control.Applicative (liftA2) @@ -30,27 +31,19 @@ import qualified Data.List.NonEmpty as N import Hasmin.Config -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.String import Hasmin.Utils -{- -class Specificity a where - specificity :: a -> (Int, Int, Int, Int) - -addSpecificity :: (Int, Int, Int, Int) - -> (Int, Int, Int, Int) - -> (Int, Int, Int, Int) -addSpecificity (a1,b1,c1,d1) (a2,b2,c2,d2) = (a1 + a2, b1 + b2, c1 + c2, d1 + d2) --} - --- | Combinators are: whitespace, "greater-than sign" (U+003E, >), "plus sign" --- (U+002B, +) and "tilde" (U+007E, ~). White space may appear between a --- combinator and the simple selectors around it. Only the characters "space" --- (U+0020), "tab" (U+0009), "line feed" (U+000A), "carriage return" (U+000D), --- and "form feed" (U+000C) can occur in whitespace. Other space-like --- characters, such as "em-space" (U+2003) and "ideographic space" (U+3000), are --- never part of whitespace. +-- Note: whitespace may appear between a combinator and the simple selectors +-- around it. Only the characters "space" (U+0020), "tab" (U+0009), "line feed" +-- (U+000A), "carriage return" (U+000D), and "form feed" (U+000C) can occur in +-- whitespace. Other space-like characters, such as "em-space" (U+2003) and +-- "ideographic space" (U+3000), are never part of whitespace. +-- +-- | A , +-- which can either: whitespace, "greater-than sign" (U+003E, >), "plus sign" +-- (U+002B, +) or "tilde" (U+007E, ~). data Combinator = Descendant -- ^ ' ' | Child -- ^ '>' | AdjacentSibling -- ^ '+' @@ -63,8 +56,13 @@ toBuilder AdjacentSibling = "+" toBuilder GeneralSibling = "~" --- An empty selector, containing no sequence of simple selectors and no +-- Note: an empty selector, containing no sequence of simple selectors and no -- pseudo-element, is an invalid selector. +-- +-- | Data type representing a CSS selector. Technically, it is a +-- , which +-- consists of one or more , +-- separated by . data Selector = Selector CompoundSelector [(Combinator, CompoundSelector)] deriving (Eq, Show) @@ -77,39 +75,49 @@ <> mconcat (fmap build ccss) where build (comb, compSel) = toBuilder comb <> toBuilder compSel instance Minifiable Selector where - minifyWith (Selector c xs) = do - newC <- minifyWith c - newCs <- (mapM . mapM) minifyWith xs + minify (Selector c xs) = do + newC <- minify c + newCs <- (mapM . mapM) minify xs pure $ Selector newC newCs -{- -instance Specificity Selector where - specificity (Selector (x :| xs) ss) = - case x of - (Type _ _) -> f (0,0,0,1) xs `addSpecificity` g (0,0,0,0) ss - (Universal _) -> f (0,0,0,0) xs `addSpecificity` g (0,0,0,0) ss - where f = foldr (addSpecificity . specificity) - g = foldr (addSpecificity . specificity . snd) --} +type Specificity = (Int, Int, Int) +-- | Given a selector, calculate it's specificity. Technically, specificity is a +-- 4-tuple, where the first and most important value is defined by whether the +-- rule is inline or not, but that doesn't matter when only analyzing a CSS +-- file. +specificity :: Selector -> Specificity +specificity (Selector cs css) = + foldr (\x ys -> specificity' (snd x) `addSpe` ys) (specificity' cs) css + where spe Universal{} = (0,0,0) + spe Type{} = (0,0,1) + spe PseudoElem{} = (0,0,1) + spe AttributeSel{} = (0,1,0) + spe ClassSel{} = (0,1,0) + spe PseudoClass{} = (0,1,0) + spe Lang{} = (0,1,0) + spe FunctionalPseudoClass{} = (0,1,0) + spe FunctionalPseudoClass1{} = (0,1,0) + spe FunctionalPseudoClass2{} = (0,1,0) + spe FunctionalPseudoClass3{} = (0,1,0) + spe IdSel{} = (1,0,0) + addSpe :: Specificity -> Specificity -> Specificity + addSpe (a1,b1,c1) (a2,b2,c2) = (a1 + a2, b1 + b2, c1 + c2) + specificity' :: CompoundSelector -> Specificity + specificity' = foldr (\x ys -> spe x `addSpe` ys) (0,0,0) + -- | Called -- in CSS2.1, but in CSS Syntax Module Level 3. type CompoundSelector = NonEmpty SimpleSelector --- instance ToText a => ToText (NonEmpty a) where instance ToText CompoundSelector where toBuilder ns@(Universal{} :| xs) | length ns > 1 = mconcat $ fmap toBuilder xs toBuilder ns = mconcat $ N.toList (fmap toBuilder ns) instance Minifiable CompoundSelector where - minifyWith (a :| xs) = liftA2 (:|) (minifyWith a) (mapM minifyWith xs) - -{- -instance Specificity a => Specificity (NonEmpty a) where - specificity = foldr (\x y -> specificity x `addSpecificity` y) (0,0,0,0) --} + minify (a :| xs) = liftA2 (:|) (minify a) (mapM minify xs) -- | Certain selectors support namespace prefixes. Namespace prefixes are -- declared with the @namespace rule. A type selector containing a namespace @@ -178,50 +186,51 @@ f (y:ys) = " of " <> toBuilder y <> mconcat (fmap (\z -> singleton ',' <> toBuilder z) ys) --- Pseudo-elements that support the old pseudo-element syntax of a single --- semicolon, as well as the new one of two semicolons. +-- | List of pseudo-elements that support the old syntax of a single semicolon, +-- as well as the new one of two semicolons. specialPseudoElements :: [Text] specialPseudoElements = fmap T.toCaseFold ["after", "before", "first-line", "first-letter"] instance Minifiable SimpleSelector where - minifyWith a@(AttributeSel att) = do + minify a@(AttributeSel att) = do conf <- ask pure $ if shouldRemoveQuotes conf then AttributeSel (removeAttributeQuotes att) else a - minifyWith a@(Lang x) = do + where removeAttributeQuotes :: Att -> Att + removeAttributeQuotes (attId :=: val) = attId :=: either Left removeQuotes val + removeAttributeQuotes (attId :~=: val) = attId :~=: either Left removeQuotes val + removeAttributeQuotes (attId :|=: val) = attId :|=: either Left removeQuotes val + removeAttributeQuotes (attId :^=: val) = attId :^=: either Left removeQuotes val + removeAttributeQuotes (attId :$=: val) = attId :$=: either Left removeQuotes val + removeAttributeQuotes (attId :*=: val) = attId :*=: either Left removeQuotes val + removeAttributeQuotes x@Attribute{} = x + minify a@(Lang x) = do conf <- ask pure $ if shouldRemoveQuotes conf then case x of Left _ -> a Right s -> Lang (removeQuotes s) else a - minifyWith (FunctionalPseudoClass1 i cs) = FunctionalPseudoClass1 i <$> mapM minifyWith cs - minifyWith (FunctionalPseudoClass2 i n) = FunctionalPseudoClass2 i <$> minifyWith n - minifyWith (FunctionalPseudoClass3 i n cs) = FunctionalPseudoClass3 i <$> minifyWith n <*> pure cs - minifyWith x = pure x + minify (FunctionalPseudoClass1 i cs) = FunctionalPseudoClass1 i <$> mapM minify cs + minify (FunctionalPseudoClass2 i n) = FunctionalPseudoClass2 i <$> minify n + minify (FunctionalPseudoClass3 i n cs) = FunctionalPseudoClass3 i <$> minify n <*> pure cs + minify x = pure x +-- | Data type representing the @\'+\'@ and @\'-\'@ signs, used by 'AnPlusB'. data Sign = Plus | Minus deriving (Eq, Show) -isPositive :: Maybe Sign -> Bool -isPositive Nothing = True -isPositive (Just Plus) = True -isPositive (Just Minus) = False - instance ToText Sign where toBuilder Plus = singleton '+' toBuilder Minus = singleton '-' --- We could maybe model the AB constructor with an Either, --- to make sure AB NoValue Nothing isn't possible (which is invalid). --- Also, modelling a BValue would cover all remaining cases, --- for example +6 vs 6, -0 vs 0 vs +0. +-- | The > microsyntax type. data AnPlusB = Even | Odd - | A (Maybe Sign) (Maybe Int) -- "sign n number", e.g. +3n, -2n, 1n. - | B Int -- "sign number", e.g. +1, +2, 3. + | A (Maybe Sign) (Maybe Int) -- "sign n number", e.g. +3n, -2n, 1n. + | B Int -- "sign number", e.g. +1, +2, 3. | AB (Maybe Sign) (Maybe Int) Int -- "sign n number sign number", e.g. 2n+1 deriving (Eq, Show) instance ToText AnPlusB where @@ -241,36 +250,39 @@ maybeToBuilder = maybe mempty toBuilder instance Minifiable AnPlusB where - minifyWith x = do - conf <- ask - pure $ if shouldMinifyMicrosyntax conf - then minifyAnPlusB x - else x + minify x = do + conf <- ask + pure $ if shouldMinifyMicrosyntax conf + then minifyAnPlusB x + else x + where minifyAN :: Maybe Sign -> Maybe Int -> (Maybe Sign, Maybe Int) + minifyAN (Just Plus) i = minifyAN Nothing i + minifyAN s (Just 1) = minifyAN s Nothing + minifyAN s i = (s, i) -minifyAnPlusB :: AnPlusB -> AnPlusB -minifyAnPlusB Even = A Nothing (Just 2) -minifyAnPlusB (A ms mi) = - case mi of - Just 0 -> B 0 - _ -> uncurry A (minifyAN ms mi) -minifyAnPlusB (AB _ (Just 0) b) = B b -minifyAnPlusB (AB ms mi b) - | isPositive ms && mi == Just 2 = - if b == 1 || b < 0 && odd b - then Odd - else if even b && b <= 0 - then minifyAnPlusB Even - else AB ms' mi' b - | otherwise = if b == 0 - then A ms' mi' - else AB ms' mi' b - where (ms', mi') = minifyAN ms mi -minifyAnPlusB x = x + minifyAnPlusB :: AnPlusB -> AnPlusB + minifyAnPlusB Even = A Nothing (Just 2) + minifyAnPlusB (A ms mi) = + case mi of + Just 0 -> B 0 + _ -> uncurry A (minifyAN ms mi) + minifyAnPlusB (AB _ (Just 0) b) = B b + minifyAnPlusB (AB ms mi b) + | isPositive ms && mi == Just 2 = + if b == 1 || b < 0 && odd b + then Odd + else if even b && b <= 0 + then minifyAnPlusB Even + else AB ms' mi' b + | b == 0 = A ms' mi' + | otherwise = AB ms' mi' b + where (ms', mi') = minifyAN ms mi + isPositive :: Maybe Sign -> Bool + isPositive Nothing = True + isPositive (Just Plus) = True + isPositive (Just Minus) = False -minifyAN :: Maybe Sign -> Maybe Int -> (Maybe Sign, Maybe Int) -minifyAN (Just Plus) i = minifyAN Nothing i -minifyAN s (Just 1) = minifyAN s Nothing -minifyAN s i = (s, i) + minifyAnPlusB y = y type AttId = Text type AttValue = Either Text StringType @@ -291,12 +303,3 @@ toBuilder (attid :^=: attval) = fromText attid <> fromText "^=" <> toBuilder attval toBuilder (attid :$=: attval) = fromText attid <> fromText "$=" <> toBuilder attval toBuilder (attid :*=: attval) = fromText attid <> fromText "*=" <> toBuilder attval - -removeAttributeQuotes :: Att -> Att -removeAttributeQuotes (attId :=: val) = attId :=: either Left removeQuotes val -removeAttributeQuotes (attId :~=: val) = attId :~=: either Left removeQuotes val -removeAttributeQuotes (attId :|=: val) = attId :|=: either Left removeQuotes val -removeAttributeQuotes (attId :^=: val) = attId :^=: either Left removeQuotes val -removeAttributeQuotes (attId :$=: val) = attId :$=: either Left removeQuotes val -removeAttributeQuotes (attId :*=: val) = attId :*=: either Left removeQuotes val -removeAttributeQuotes a@Attribute{} = a diff --git a/src/Hasmin/Types/Shadow.hs b/src/Hasmin/Types/Shadow.hs --- a/src/Hasmin/Types/Shadow.hs +++ b/src/Hasmin/Types/Shadow.hs @@ -5,56 +5,56 @@ -- Copyright : (c) 2017 Cristian Adrián Ontivero -- License : BSD3 -- Stability : experimental --- Portability : non-portable +-- Portability : unknown -- ----------------------------------------------------------------------------- -module Hasmin.Types.Shadow ( - Shadow(..) +module Hasmin.Types.Shadow + ( Shadow(..) ) where -import Control.Monad.Reader (ask) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton) import Data.Bool (bool) -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.Color import Hasmin.Types.Dimension -data Shadow = Shadow { inset :: Bool - , sOffsetX :: Distance - , sOffsetY :: Distance - , blurRadius :: Maybe Distance - , spreadRadius :: Maybe Distance - , sColor :: Maybe Color +-- | CSS > +-- data type, used by the @box-shadow@ property. +data Shadow = Shadow { inset :: Bool + , sOffsetX :: Length + , sOffsetY :: Length + , blurRadius :: Maybe Length + , spreadRadius :: Maybe Length + , sColor :: Maybe Color } deriving (Eq, Show) instance ToText Shadow where toBuilder (Shadow i ox oy br sr c) = bool mempty "inset " i <> toBuilder ox <> singleton ' ' - <> toBuilder oy <> f br <> f sr <> f c - where f x = maybe mempty (\y -> singleton ' ' <> toBuilder y) x -- don't eta reduce this! + <> toBuilder oy <> prependSpace br + <> prependSpace sr <> prependSpace c + where prependSpace x = maybe mempty (\y -> singleton ' ' <> toBuilder y) x -- don't eta reduce this! instance Minifiable Shadow where - minifyWith (Shadow i ox oy br sr c) = do - conf <- ask - x <- minifyWith ox - y <- minifyWith oy - nb <- mapM minifyWith br - ns <- mapM minifyWith sr - c2 <- mapM minifyWith c + minify (Shadow i ox oy br sr c) = do + -- conf <- ask + x <- minify ox + y <- minify oy + nb <- mapM minify br + ns <- mapM minify sr + c2 <- mapM minify c pure $ if True {- shouldMinifyShadows conf -} then let (a, b) = minifyBlurAndSpread nb ns in Shadow i x y a b c2 else Shadow i x y nb ns c2 - -minifyBlurAndSpread :: Maybe Distance -> Maybe Distance - -> (Maybe Distance, Maybe Distance) -minifyBlurAndSpread (Just br) Nothing - | br == Distance 0 Q = (Nothing, Nothing) - | otherwise = (Just br, Nothing) -minifyBlurAndSpread (Just br) (Just sr) - | sr == Distance 0 Q = minifyBlurAndSpread (Just br) Nothing - | otherwise = (Just br, Just sr) -minifyBlurAndSpread x y = (x, y) + where minifyBlurAndSpread :: Maybe Length -> Maybe Length -> (Maybe Length, Maybe Length) + minifyBlurAndSpread (Just br') Nothing + | isZeroLen br' = (Nothing, Nothing) + | otherwise = (Just br', Nothing) + minifyBlurAndSpread (Just br') (Just sr') + | isZeroLen sr' = minifyBlurAndSpread (Just br') Nothing + | otherwise = (Just br', Just sr') + minifyBlurAndSpread x y = (x, y) diff --git a/src/Hasmin/Types/String.hs b/src/Hasmin/Types/String.hs --- a/src/Hasmin/Types/String.hs +++ b/src/Hasmin/Types/String.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Hasmin.Types.String @@ -8,8 +8,8 @@ -- Portability : unknown -- ----------------------------------------------------------------------------- -module Hasmin.Types.String ( - removeQuotes +module Hasmin.Types.String + ( removeQuotes , unquoteUrl , unquoteFontFamily , mapString @@ -29,14 +29,11 @@ import Hasmin.Config import Hasmin.Parser.Utils -import Hasmin.Types.Class +import Hasmin.Class --- | The \ data type represents a string, formed by Unicode --- characters, delimited by either double (") or single (') quotes. --- Specification: --- --- 1. > data type. +-- It represents a string, formed by Unicode characters, delimited by either +-- double (") or single (') quotes. data StringType = DoubleQuotes Text | SingleQuotes Text deriving (Show, Eq) @@ -44,7 +41,7 @@ toBuilder (DoubleQuotes t) = singleton '\"' <> fromText t <> singleton '\"' toBuilder (SingleQuotes t) = singleton '\'' <> fromText t <> singleton '\'' instance Minifiable StringType where - minifyWith (DoubleQuotes t) = do + minify (DoubleQuotes t) = do conf <- ask convertedText <- convertEscapedText t pure $ if T.any ('\"' ==) convertedText @@ -53,7 +50,7 @@ -- TODO make it so that the best quotes are used for the file then DoubleQuotes convertedText else DoubleQuotes convertedText - minifyWith (SingleQuotes t) = do + minify (SingleQuotes t) = do conf <- ask convertedText <- convertEscapedText t pure $ if T.any ('\'' ==) convertedText @@ -98,7 +95,7 @@ toIdent = unquote ident toUnquotedURL :: Text -> Maybe Text -toUnquotedURL = unquote nonquotedurl +toUnquotedURL = unquote unquotedURL toUnquotedFontFamily :: Text -> Maybe Text toUnquotedFontFamily = unquote fontfamilyname diff --git a/src/Hasmin/Types/Stylesheet.hs b/src/Hasmin/Types/Stylesheet.hs --- a/src/Hasmin/Types/Stylesheet.hs +++ b/src/Hasmin/Types/Stylesheet.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Hasmin.Types.Stylesheet @@ -16,32 +17,35 @@ , KeyframeBlock(..) , SupportsCondition(..) , SupportsCondInParens(..) - , isEmpty , minifyRules + , collapse + , mergeRules ) where import Control.Applicative (liftA2) import Control.Monad ((>=>)) -import Control.Monad.Reader (Reader, ask) +import Control.Monad.Reader (Reader, ask, asks) import Data.Monoid ((<>)) import Data.Text (Text) import Data.Text.Lazy.Builder (singleton, fromText, Builder) -import Data.List (sortBy, (\\)) +import Data.List (union, sort, sortBy, (\\)) import Data.Map.Strict (Map) import Data.List.NonEmpty (NonEmpty) import Data.Foldable (toList) +import Data.Maybe (fromJust) import qualified Data.Map.Strict as Map -import qualified Data.Set as S +import qualified Data.Set as Set import qualified Data.Text as T import Hasmin.Config import Hasmin.Types.Selector -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.Value import Hasmin.Types.Declaration import Hasmin.Types.String import Hasmin.Types.Numeric import Hasmin.Utils +import Hasmin.Properties -- | Data type for media queries. For the syntax, see -- . @@ -49,8 +53,8 @@ | MediaQuery2 [Expression] -- ^ Second possibility in the grammar deriving (Show, Eq) instance Minifiable MediaQuery where - minifyWith (MediaQuery1 t1 t2 es) = MediaQuery1 t1 t2 <$> mapM minifyWith es - minifyWith (MediaQuery2 es) = MediaQuery2 <$> mapM minifyWith es + minify (MediaQuery1 t1 t2 es) = MediaQuery1 t1 t2 <$> mapM minify es + minify (MediaQuery2 es) = MediaQuery2 <$> mapM minify es instance ToText MediaQuery where toBuilder (MediaQuery1 t1 t2 es) = notOrOnly <> fromText t2 <> expressions @@ -63,8 +67,8 @@ | InvalidExpression Text deriving (Show, Eq) instance Minifiable Expression where - minifyWith (Expression t mv) = Expression t <$> mapM minifyWith mv - minifyWith x = pure x + minify (Expression t mv) = Expression t <$> mapM minify mv + minify x = pure x instance ToText Expression where toBuilder (Expression t mv) = singleton '(' <> fromText t <> v <> singleton ')' @@ -79,16 +83,15 @@ toText To = "to" toText (KFPercentage p) = toText p instance Minifiable KeyframeSelector where - minifyWith x = do + minify kfs = do conf <- ask pure $ if shouldMinifyKeyframeSelectors conf - then minifyKFS x - else x - -minifyKFS :: KeyframeSelector -> KeyframeSelector -minifyKFS From = KFPercentage $ Percentage 0 -minifyKFS (KFPercentage (Percentage 100)) = To -minifyKFS x = x + then minifyKFS kfs + else kfs + where minifyKFS :: KeyframeSelector -> KeyframeSelector + minifyKFS From = KFPercentage $ Percentage 0 + minifyKFS (KFPercentage (Percentage 100)) = To + minifyKFS x = x data KeyframeBlock = KeyframeBlock [KeyframeSelector] [Declaration] deriving (Eq, Show) @@ -99,13 +102,15 @@ <> mconcatIntersperse toBuilder (singleton ';') ds <> singleton '}' instance Minifiable KeyframeBlock where - minifyWith (KeyframeBlock ss ds) = do - decs <- mapM minifyWith ds - sels <- mapM minifyWith ss + minify (KeyframeBlock ss ds) = do + decs <- mapM minify ds + sels <- mapM minify ss pure $ KeyframeBlock sels decs type VendorPrefix = Text +-- | A CSS rule, either a normal style rule, or one of the many possible +-- at-rules. data Rule = AtCharset StringType | AtImport (Either StringType Url) [MediaQuery] | AtNamespace Text (Either StringType Url) @@ -149,110 +154,105 @@ <> singleton ' ' <> fromText n <> singleton '{' <> mconcat (fmap toBuilder bs) <> singleton '}' instance Minifiable Rule where - minifyWith (AtMedia mqs rs) = liftA2 AtMedia (mapM minifyWith mqs) (mapM minifyWith rs) - minifyWith (AtSupports sc rs) = liftA2 AtSupports (minifyWith sc) (mapM minifyWith rs) - minifyWith (AtKeyframes vp n bs) = AtKeyframes vp n <$> mapM minifyWith bs - minifyWith (AtBlockWithRules t rs) = AtBlockWithRules t <$> mapM minifyWith rs - minifyWith (AtBlockWithDec t ds) = do - decs <- cleanRule ds >>= compactLonghands >>= mapM minifyWith + minify (AtMedia mqs rs) = liftA2 AtMedia (mapM minify mqs) (mapM minify rs) + minify (AtSupports sc rs) = liftA2 AtSupports (minify sc) (mapM minify rs) + minify (AtKeyframes vp n bs) = AtKeyframes vp n <$> mapM minify bs + minify (AtBlockWithRules t rs) = AtBlockWithRules t <$> mapM minify rs + minify (AtBlockWithDec t ds) = do + decs <- cleanRule ds >>= collapseLonghands >>= mapM minify pure $ AtBlockWithDec t decs - minifyWith (StyleRule ss ds) = do - decs <- cleanRule ds >>= compactLonghands >>= mapM minifyWith >>= sortDeclarations - sels <- mapM minifyWith ss >>= removeDuplicateSelectors >>= sortSelectors + minify (StyleRule ss ds) = do + decs <- cleanRule ds >>= collapseLonghands >>= mapM minify >>= sortDeclarations + sels <- mapM minify ss >>= removeDuplicateSelectors >>= sortSelectors pure $ StyleRule sels decs - minifyWith (AtImport esu mqs) = AtImport esu <$> mapM minifyWith mqs - minifyWith (AtCharset s) = AtCharset <$> mapString lowercaseText s - minifyWith x = pure x + where sortSelectors :: [Selector] -> Reader Config [Selector] + sortSelectors sls = do + conf <- ask + pure $ case selectorSorting conf of + -- Selector's Ord instance implements lexicographical order + Lexicographical -> sort sls + NoSorting -> sls -cleanRule :: [Declaration] -> Reader Config [Declaration] -cleanRule ds = do - conf <- ask - pure $ if shouldCleanRules conf - then clean ds - else ds + removeDuplicateSelectors :: [Selector] -> Reader Config [Selector] + removeDuplicateSelectors sls = do + conf <- ask + pure $ if shouldRemoveDuplicateSelectors conf + then nub' sls + else sls -sortSelectors :: [Selector] -> Reader Config [Selector] -sortSelectors sls = do - conf <- ask - pure $ case selectorSorting conf of - Lexicographical -> sortBy lexico sls - NoSorting -> sls + minify (AtImport esu mqs) = AtImport esu <$> mapM minify mqs + minify (AtCharset s) = AtCharset <$> mapString lowercaseText s + minify x = pure x + sortDeclarations :: [Declaration] -> Reader Config [Declaration] sortDeclarations ds = do conf <- ask pure $ case declarationSorting conf of Lexicographical -> sortBy lexico ds NoSorting -> ds + where lexico :: ToText a => a -> a -> Ordering + lexico s1 s2 = compare (toText s1) (toText s2) -removeDuplicateSelectors :: [Selector] -> Reader Config [Selector] -removeDuplicateSelectors sls = do +cleanRule :: [Declaration] -> Reader Config [Declaration] +cleanRule ds = do conf <- ask - pure $ if shouldRemoveDuplicateSelectors conf - then nub' sls - else sls - -gatherLonghands :: [Declaration] -> Map (Text, Bool) Declaration -gatherLonghands = go Map.empty - where go m [] = m - go m (d@(Declaration p _ i _):ds) - | S.member p longhands = go (Map.insert (p,i) d m) ds - | otherwise = go m ds - longhands = S.fromList (marginLonghands ++ paddingLonghands) + pure $ if shouldCleanRules conf + then clean ds + else ds --- TODO delete this. -marginLonghands = ["margin-top", "margin-right", "margin-bottom", "margin-left"] -paddingLonghands = ["padding-top", "padding-right", "padding-bottom", "padding-left"] +collapseLonghands :: [Declaration] -> Reader Config [Declaration] +collapseLonghands decs = do + -- conf <- ask + pure $ if True {- shouldGatherLonghands conf -} + then collapse decs + else decs -compactTRBL :: Text -> [Text] -> Map (Text, Bool) Declaration - -> (Maybe Declaration, [Declaration]) -compactTRBL name lhs m = - case sequenceA (map getDeclaration lhs) of - Just l -> (Just (Declaration name (shValues l) False False), l) - Nothing -> (Nothing, []) - where getDeclaration x = Map.lookup (x, False) m - shValues = mkValues . map (head . valuesToList . valueList) +-- | Given a list of declarations, gathers the longhands, and if every longhand +-- of a given shorthand is present, \"collapses\" them into the shorthand +-- (i.e. replaces all the declarations for an equivalent shorthand). +collapse :: [Declaration] -> [Declaration] +collapse decs = collapse' $ zipWith collapseTRBL trbls longhands + where collapse' [] = decs + collapse' (f:fs) = case f (gatherLonghands decs) of + (Just sh, l) -> (collapse' fs \\ l) ++ [sh] + (Nothing, _) -> collapse' fs -compactMargin = compactTRBL "margin" marginLonghands -compactPadding = compactTRBL "padding" paddingLonghands --- ,("border-color", mergeIntoTRBL) --- ,("border-width", mergeIntoTRBL) --- ,("border-style", mergeIntoTRBL) + gatherLonghands :: [Declaration] -> Map (Text, Bool) Declaration + gatherLonghands = go Map.empty + where go m [] = m + go m (d@(Declaration p _ i _):ds) + | p `Set.member` longhandsSet = go (Map.insert (p,i) d m) ds + | otherwise = go m ds + longhandsSet = Set.fromList (concat longhands) -compacter m ds = compacter' [compactMargin, compactPadding] - where compacter' [] = ds - compacter' (f:fs) = case f m of - (Just sh, l) -> (compacter' fs \\ l) ++ [sh] - (Nothing, _) -> compacter' fs + trbls :: [Text] + trbls = ["margin", "padding", "border-color", "border-width", "border-style"] -compactLonghands :: [Declaration] -> Reader Config [Declaration] -compactLonghands ds = do - conf <- ask - pure $ if True {- shouldGatherLonghands conf -} - then compacter (gatherLonghands ds) ds - else ds + longhands :: [[Text]] + longhands = map subpropertiesOf trbls --- Used for sorting selectors --- TODO: move to the correct place, and maybe rename. -lexico :: ToText a => a -> a -> Ordering -lexico s1 s2 = compare (toText s1) (toText s2) + subpropertiesOf :: Text -> [Text] + subpropertiesOf p = subproperties . fromJust $ Map.lookup p propertiesTraits -isEmpty :: Rule -> Bool -isEmpty (StyleRule _ ds) = null ds -isEmpty (AtMedia _ rs) = null rs || all isEmpty rs -isEmpty (AtKeyframes _ _ kfbs) = null kfbs -isEmpty (AtBlockWithDec _ ds) = null ds -isEmpty (AtBlockWithRules _ rs) = null rs || all isEmpty rs -isEmpty _ = False + collapseTRBL :: Text -> [Text] -> Map (Text, Bool) Declaration + -> (Maybe Declaration, [Declaration]) + collapseTRBL name lnhs m = + case traverse getDeclaration lnhs of + -- If every longhand is present, return the collapsed ones + Just l -> (Just (Declaration name (shValues l) False False), l) + -- If a longhand was missing, don't combine because it's unsafe + Nothing -> (Nothing, []) + where getDeclaration x = Map.lookup (x, False) m + shValues = mkValues . map (head . valuesToList . valueList) -- O(n log n) implementation, vs. O(n^2) which is the normal nub. -- Note that nub has only an Eq constraint, while this one has an Ord one. -- taken from: http://buffered.io/posts/a-better-nub/ nub' :: (Ord a) => [a] -> [a] -nub' = go S.empty +nub' = go Set.empty where go _ [] = [] - go s (x:xs) | S.member x s = go s xs - | otherwise = x : go (S.insert x s) xs - + go s (x:xs) | Set.member x s = go s xs + | otherwise = x : go (Set.insert x s) xs data SupportsCondition = Not SupportsCondInParens | And SupportsCondInParens (NonEmpty SupportsCondInParens) @@ -265,10 +265,10 @@ toBuilder (Or x y) = appendWith " or " x y toBuilder (Parens x) = toBuilder x instance Minifiable SupportsCondition where - minifyWith (And x y) = And <$> pure x <*> mapM pure y - minifyWith (Or x y) = Or <$> pure x <*> mapM pure y - minifyWith (Parens x) = Parens <$> pure x - minifyWith (Not x) = + minify x@And{} = pure x + minify x@Or{} = pure x + minify x@Parens{} = pure x + minify (Not x) = case x of ParensCond (Not y) -> case y of ParensCond a@And{} -> pure a @@ -297,31 +297,120 @@ toBuilder (ParensDec x) = "(" <> toBuilder x <> ")" toBuilder (ParensCond x) = "(" <> toBuilder x <> ")" instance Minifiable SupportsCondInParens where - minifyWith (ParensDec x) = ParensDec <$> minifyWith x - minifyWith (ParensCond x) = ParensCond <$> minifyWith x + minify (ParensDec x) = ParensDec <$> minify x + minify (ParensCond x) = ParensCond <$> minify x -combineAdjacentMediaQueries :: [Rule] -> [Rule] -combineAdjacentMediaQueries (a@(AtMedia mqs es) : b@(AtMedia mqs2 es2) : xs) - | mqs == mqs2 = combineAdjacentMediaQueries (AtMedia mqs (es ++ es2) : xs) - | otherwise = a : combineAdjacentMediaQueries (b:xs) -combineAdjacentMediaQueries (x:xs) = x : combineAdjacentMediaQueries xs -combineAdjacentMediaQueries [] = [] +instance Minifiable [Rule] where + minify = minifyRules --- Set of functions to minify rules minifyRules :: [Rule] -> Reader Config [Rule] minifyRules = handleAdjacentMediaQueries >=> handleEmptyBlocks - >=> traverse minifyWith -- minify rules individually + >=> mergeStyleRules + >=> traverse minify -- minify rules individually where handleEmptyBlocks :: [Rule] -> Reader Config [Rule] handleEmptyBlocks rs = do conf <- ask pure $ if shouldRemoveEmptyBlocks conf then filter (not . isEmpty) rs else rs + + isEmpty :: Rule -> Bool + isEmpty (StyleRule _ ds) = null ds + isEmpty (AtMedia _ rs) = null rs || all isEmpty rs + isEmpty (AtKeyframes _ _ kfbs) = null kfbs + isEmpty (AtBlockWithDec _ ds) = null ds + isEmpty (AtBlockWithRules _ rs) = null rs || all isEmpty rs + isEmpty _ = False + handleAdjacentMediaQueries :: [Rule] -> Reader Config [Rule] - handleAdjacentMediaQueries rs = do - conf <- ask - pure $ combineAdjacentMediaQueries rs + handleAdjacentMediaQueries rs = + pure $ combineAdjacentMediaQueries rs + where combineAdjacentMediaQueries :: [Rule] -> [Rule] + combineAdjacentMediaQueries (a@(AtMedia mqs es) : b@(AtMedia mqs2 es2) : xs) + | mqs == mqs2 = combineAdjacentMediaQueries (AtMedia mqs (es ++ es2) : xs) + | otherwise = a : combineAdjacentMediaQueries (b:xs) + combineAdjacentMediaQueries (x:xs) = x : combineAdjacentMediaQueries xs + combineAdjacentMediaQueries [] = [] + +mergeStyleRules :: [Rule] -> Reader Config [Rule] +mergeStyleRules xs = do + mergeSettings <- asks rulesMergeSettings + pure $ case mergeSettings of + MergeRulesOn -> mergeRules xs + MergeRulesOff -> xs + +-- Imperative pseudocode: +-- +-- for rule r1 in positions [0..n-2] +-- for rule r2 in positions [r1 pos..n-1] +-- if r1 and r2 have the same declarations: +-- merge (i.e. combine both into r1, remove r2 from map) +-- else if r1 and r2 have the same specificity, and some declaration overlaps +-- continue with next r1 +-- else +-- continue with the next r2 +mergeRules :: [Rule] -> [Rule] +mergeRules zs = Map.elems $ mergeRules' 0 1 rulesInMap + where rulesInMap = Map.fromList $ zip [0..] zs + mapSize = Map.size rulesInMap + + mergeRules' :: Int -> Int -> Map Int Rule -> Map Int Rule + mergeRules' i j m + | i == mapSize - 1 = m + | j == mapSize = mergeRules' (i+1) (i+2) m + | otherwise = + case Map.lookupGE i m of + Nothing -> m + Just (key, r) -> + let index = if key >= j then key + 1 else j + in case Map.lookupGE index m of + Nothing -> m + Just (key2, r2) -> + let newIndex = key2 + 1 + in case mergeAndRemove r r2 key key2 newIndex m of + Nothing -> if shouldSkip r r2 + then mergeRules' (key+1) (key+2) m + else mergeRules' key newIndex m + Just m' -> m' + + mergeAndRemove :: Rule -> Rule -> Int -> Int -> Int -> Map Int Rule -> Maybe (Map Int Rule) + mergeAndRemove (StyleRule ss ds) (StyleRule ss2 ds2) key key2 newIndex m + | Set.fromList ds2 == Set.fromList ds = + let ruleMergedBySelectors = StyleRule (ss `union` ss2) ds + newMap = Map.delete key2 (Map.insert key ruleMergedBySelectors m) + in Just $ mergeRules' key newIndex newMap + | Set.fromList ss == Set.fromList ss2 = + let ruleMergedByDeclarations = StyleRule ss (ds `union` ds2) + newMap = Map.delete key2 (Map.insert key ruleMergedByDeclarations m) + in Just $ mergeRules' key newIndex newMap + | otherwise = Nothing + mergeAndRemove _ _ _ _ _ _ = Nothing + + overlaps :: Declaration -> Declaration -> Bool + overlaps (Declaration p1 _ _ _) (Declaration p2 _ _ _) = + p1 == p2 || overlaps' + where overlaps' = + case Map.lookup p2 propertiesTraits of + Nothing -> True -- Be safe, in the absence of information, assume the worst + Just pinfo -> p1 `elem` subproperties pinfo || p1 `elem` overwrittenBy pinfo + + shouldSkip :: Rule -> Rule -> Bool + shouldSkip (StyleRule ss ds) (StyleRule ss2 ds2) = + thereIsAPairOfSelectorsWithTheSameSpecificity && twoDeclarationsClash + where thereIsAPairOfSelectorsWithTheSameSpecificity = any (\x -> any (\y -> specificity x == specificity y) ss) ss2 + twoDeclarationsClash = any (\x -> any (`overlaps` x) ds) ds2 + shouldSkip StyleRule{} AtKeyframes{} = False + shouldSkip StyleRule{} (AtBlockWithDec t _) + | t == "font-face" = False + | otherwise = True + -- TODO see better what needs to be skipped and what doesn't need to + -- be, e.g. what should be done between a style rule and a at-media + -- rule? + -- + -- Skip whatever isn't a pair of style rules + shouldSkip _ _ = True + {- supports_rule diff --git a/src/Hasmin/Types/TimingFunction.hs b/src/Hasmin/Types/TimingFunction.hs --- a/src/Hasmin/Types/TimingFunction.hs +++ b/src/Hasmin/Types/TimingFunction.hs @@ -2,15 +2,15 @@ ----------------------------------------------------------------------------- -- | -- Module : Hasmin.Types.TimingFunction --- Copyright : (c) 2016 Cristian Adrián Ontivero +-- Copyright : © 2017 Cristian Adrián Ontivero -- License : BSD3 -- Stability : experimental --- Portability : non-portable +-- Portability : unknown -- ----------------------------------------------------------------------------- -module Hasmin.Types.TimingFunction ( - TimingFunction(..) - , StepsSecondParam(..) +module Hasmin.Types.TimingFunction + ( TimingFunction(..) + , StepPosition(..) ) where import Control.Monad.Reader (ask) @@ -19,17 +19,13 @@ import Data.Maybe (isNothing, fromJust) import Data.Text.Lazy.Builder (singleton) import Hasmin.Config -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Utils import Hasmin.Types.Numeric --- | CSS \ data type. Specifications: --- --- 1. --- 2. --- 3. +-- | CSS > data type. data TimingFunction = CubicBezier Number Number Number Number - | Steps Int (Maybe StepsSecondParam) + | Steps Int (Maybe StepPosition) | Ease | EaseIn | EaseInOut @@ -43,11 +39,22 @@ Steps i1 ms1 == Steps i2 ms2 = i1 == i2 && (ms1 == ms2 || (isNothing ms1 && fromJust ms2 == End) || (fromJust ms1 == End && isNothing ms2)) - s@Steps{} == x = maybe False (== s) (toSteps x) - x == s@Steps{} = s == x + s@Steps{} == x = toSteps x == Just s + where toSteps :: TimingFunction -> Maybe TimingFunction + toSteps StepEnd = Just $ Steps 1 (Just End) + toSteps StepStart = Just $ Steps 1 (Just Start) + toSteps _ = Nothing + x == s@Steps{} = s == x CubicBezier x1 x2 x3 x4 == CubicBezier y1 y2 y3 y4 = x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 - c@CubicBezier{} == x = maybe False (== c) (toCubicBezier x) + c@CubicBezier{} == x = toCubicBezier x == Just c + where toCubicBezier :: TimingFunction -> Maybe TimingFunction + toCubicBezier Ease = Just $ CubicBezier 0.25 0.1 0.25 1 + toCubicBezier EaseIn = Just $ CubicBezier 0.42 0 1 1 + toCubicBezier EaseInOut = Just $ CubicBezier 0.42 0 0.58 1 + toCubicBezier Linear = Just $ CubicBezier 0 0 1 1 + toCubicBezier EaseOut = Just $ CubicBezier 0 0 0.58 1 + toCubicBezier _ = Nothing x == c@CubicBezier{} = c == x StepEnd == StepEnd = True StepStart == StepStart = True @@ -58,24 +65,12 @@ EaseInOut == EaseInOut = True _ == _ = False -toCubicBezier :: TimingFunction -> Maybe TimingFunction -toCubicBezier Ease = Just $ CubicBezier 0.25 0.1 0.25 1 -toCubicBezier EaseIn = Just $ CubicBezier 0.42 0 1 1 -toCubicBezier EaseInOut = Just $ CubicBezier 0.42 0 0.58 1 -toCubicBezier Linear = Just $ CubicBezier 0 0 1 1 -toCubicBezier EaseOut = Just $ CubicBezier 0 0 0.58 1 -toCubicBezier _ = Nothing - -toSteps :: TimingFunction -> Maybe TimingFunction -toSteps StepEnd = Just $ Steps 1 (Just End) -toSteps StepStart = Just $ Steps 1 (Just Start) -toSteps _ = Nothing - - -data StepsSecondParam = Start - | End -- End is the default value +-- | A step position, as used by the +-- . +data StepPosition = Start + | End -- End is the default value deriving (Eq, Show) -instance ToText StepsSecondParam where +instance ToText StepPosition where toBuilder Start = "start" toBuilder End = "end" instance ToText TimingFunction where @@ -93,32 +88,31 @@ toBuilder StepEnd = "step-end" instance Minifiable TimingFunction where - minifyWith x = do + minify tf = do conf <- ask pure $ if shouldMinifyTimingFunctions conf - then minifyTimingFunction x - else x - -minifyTimingFunction :: TimingFunction -> TimingFunction -minifyTimingFunction x@(CubicBezier a b c 1) - | a == 0.25 && b == 0.1 && c == 0.25 = Ease - | b == 0 = if a == 0.42 - then if c == 1 - then EaseIn - else if c == 0.58 - then EaseInOut - else x - else if a == 0 - then if c == 1 - then Linear - else if c == 0.58 - then EaseOut - else x - else x -minifyTimingFunction x@CubicBezier{} = x -minifyTimingFunction (Steps 1 ms) = - case ms of - Just Start -> StepStart - _ -> StepEnd -minifyTimingFunction (Steps i (Just End)) = Steps i Nothing -minifyTimingFunction x = x + then minifyTimingFunction tf + else tf + where minifyTimingFunction :: TimingFunction -> TimingFunction + minifyTimingFunction x@(CubicBezier a b c 1) + | a == 0.25 && b == 0.1 && c == 0.25 = Ease + | b == 0 = if a == 0.42 + then if c == 1 + then EaseIn + else if c == 0.58 + then EaseInOut + else x + else if a == 0 + then if c == 1 + then Linear + else if c == 0.58 + then EaseOut + else x + else x + minifyTimingFunction x@CubicBezier{} = x + minifyTimingFunction (Steps 1 ms) = + case ms of + Just Start -> StepStart + _ -> StepEnd + minifyTimingFunction (Steps i (Just End)) = Steps i Nothing + minifyTimingFunction x = x diff --git a/src/Hasmin/Types/TransformFunction.hs b/src/Hasmin/Types/TransformFunction.hs --- a/src/Hasmin/Types/TransformFunction.hs +++ b/src/Hasmin/Types/TransformFunction.hs @@ -7,14 +7,13 @@ -- Stability : experimental -- Portability : non-portable -- --- CSS \ data type. --- ----------------------------------------------------------------------------- module Hasmin.Types.TransformFunction ( TransformFunction(..) , mkMat , mkMat3d , combine + , simplify ) where import Control.Monad.Reader (mapReader, Reader, ask, local) @@ -22,7 +21,7 @@ import Data.Monoid ((<>)) import Data.Either (isRight) import qualified Data.Text as T -import Data.Number.FixedFunctions (sin, cos, acos, tan, atan) +import Data.Number.FixedFunctions (tan, atan) import Prelude hiding (sin, cos, acos, tan, atan) import qualified Data.Matrix as M import Data.Matrix (Matrix) @@ -30,8 +29,9 @@ 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.Types.Class +import Hasmin.Class import Hasmin.Utils import Hasmin.Types.Dimension import Hasmin.Types.PercentageLength @@ -43,29 +43,32 @@ -- takes two \ (which makes sense since translateX() and -- translateY() also do). +-- | CSS > +-- data type. data TransformFunction = Mat (Matrix Number) | Mat3d (Matrix Number) - | Perspective Distance + | Perspective Length | Rotate Angle - | Rotate3d Number Number Number Angle | RotateX Angle | RotateY Angle | RotateZ Angle + | Rotate3d Number Number Number Angle | Scale Number (Maybe Number) - | Scale3d Number Number Number | ScaleX Number | ScaleY Number | ScaleZ Number + | Scale3d Number Number Number | Skew Angle (Maybe Angle) | SkewX Angle | SkewY Angle | Translate PercentageLength (Maybe PercentageLength) - | Translate3d PercentageLength PercentageLength Distance | TranslateX PercentageLength | TranslateY PercentageLength - | TranslateZ Distance + | TranslateZ Length + | Translate3d PercentageLength PercentageLength Length deriving (Eq, Show) --- | There are a series of equivalences to keep in mind: translate(0), + +-- 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), @@ -73,7 +76,7 @@ -- shortest of them all: skew(0) -- All of these translate to the 4x4 identity matrix. instance Minifiable TransformFunction where - minifyWith (Mat3d m) = do + minify (Mat3d m) = do conf <- ask if shouldMinifyTransformFunction conf then case possibleRepresentations m of @@ -88,21 +91,21 @@ if currentLength < newLength then go f y zs else go f z zs - minifyWith x = do + minify x = do conf <- ask if shouldMinifyTransformFunction conf then case toMatrix3d x of - Just mat3d -> minifyWith mat3d + Just mat3d -> minify mat3d Nothing -> simplify x - else pure x + else simplify x {- s = SkewX (Angle 45 Deg) -tx = TranslateX (Right $ Distance (-6) PX) +tx = TranslateX (Right $ Length (-6) PX) ry = RotateY (Angle (-9) Deg) ry2 = Rotate3d 0 (-1) 0 (Angle 9 Deg) -t = TranslateZ (Distance 100 PX) -t2 = Translate (Right (Distance 100 PX)) Nothing +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 @@ -164,16 +167,16 @@ y = maybe 0 (fromPixelsToNum . fromRight') mpl toMatrix3d (TranslateX pl) | isNonZeroPercentage pl = Nothing - | isRight pl && isRelativeDistance (fromRight' 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 && isRelativeDistance (fromRight' 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) - | isRelativeDistance d = Nothing + | isRelativeLength d = Nothing | otherwise = Just . Mat3d $ mkTranslate3dMatrix 0 0 z where z = fromPixelsToNum d toMatrix3d (Scale n mn) = Just . Mat3d $ mkScale3dMatrix n y 1 @@ -188,18 +191,18 @@ toMatrix3d (SkewY a) = Just . Mat3d $ mkSkewMatrix 0 (tangent a) toMatrix3d (Translate3d pl1 pl2 d) | isNonZeroPercentage pl1 || isNonZeroPercentage pl2 = Nothing - | isRight pl1 && isRelativeDistance (fromRight' pl1) = Nothing - | isRight pl2 && isRelativeDistance (fromRight' pl2) = Nothing - | isRelativeDistance d = 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) - | d == Distance 0 Q = Nothing - | otherwise = let c = fromPixelsToNum d - in Just . Mat3d $ mkPerspectiveMatrix c + | 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: @@ -272,7 +275,7 @@ | abs (m12 + m21) < ep2 && abs (m13 + m31) < ep2 && abs (m23 - m32) < ep2 - && abs (m11 + m22 + m33 - 3) < ep2 = Rotate3d 1 0 0 (Angle 0 Deg) + && 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 @@ -296,14 +299,13 @@ where result vx vy vz = Rotate3d vx vy vz (Angle 180 Deg) -} -isRelativeDistance :: Distance -> Bool -isRelativeDistance (Distance _ u) = isRelative u - -fromPixelsToNum :: Distance -> Number -fromPixelsToNum (Distance n u) = toPixels n u +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 @@ -356,11 +358,11 @@ | mkTranslate3dMatrix x y z == m = Translate3d tx ty tz : others | otherwise = [] where x = M.unsafeGet 1 4 m - tx = Right $ Distance x PX + tx = Right $ Length x PX y = M.unsafeGet 2 4 m - ty = Right $ Distance y PX + ty = Right $ Length y PX z = M.unsafeGet 3 4 m - tz = Distance z PX + 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)] @@ -382,7 +384,7 @@ matrixToPerspective :: Matrix Number -> [TransformFunction] matrixToPerspective m - | c /= 0 && mkPerspectiveMatrix d == m = [Perspective $ Distance d PX] + | c /= 0 && mkPerspectiveMatrix d == m = [Perspective $ Length d PX] | otherwise = [] where c = M.unsafeGet 4 3 m d = (-1)/c @@ -438,20 +440,20 @@ simplify :: TransformFunction -> Reader Config TransformFunction simplify (Translate pl mpl) | isNothing mpl || isZero (fromJust mpl) = do - x <- mapM minifyWith pl + x <- mapM minify pl pure $ Translate x Nothing - | otherwise = do x <- mapM minifyWith pl - y <- (mapM . mapM) minifyWith mpl + | otherwise = do x <- mapM minify pl + y <- (mapM . mapM) minify mpl pure $ Translate x y simplify (TranslateX pl) = do - x <- mapM minifyWith pl + 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 minifyWith pl + 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) @@ -464,69 +466,70 @@ 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 ma) - | defaultSecondArgument = do ang <- minifyWith a - simplify $ Skew ang Nothing - | otherwise = liftA2 Skew (minifyWith a) (mapM minifyWith ma) - where defaultSecondArgument = maybe False (== Angle 0 Deg) ma +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) - | a == Angle 0 Deg = pure $ Skew (Angle 0 Deg) Nothing - | otherwise = fmap SkewY (minifyWith a) + | isZeroAngle a = pure $ Skew NullAngle Nothing + | otherwise = fmap SkewY (minify a) simplify (SkewX a) - | a == Angle 0 Deg = pure $ Skew (Angle 0 Deg) Nothing - | otherwise = fmap SkewX (minifyWith a) + | isZeroAngle a = pure $ Skew NullAngle Nothing + | otherwise = fmap SkewX (minify a) simplify (Rotate a) - | a == Angle 0 Deg = pure $ Skew (Angle 0 Deg) Nothing - | otherwise = fmap Rotate (minifyWith a) + | isZeroAngle a = pure $ Skew NullAngle Nothing + | otherwise = fmap Rotate (minify a) simplify (RotateX a) - | a == Angle 0 Deg = pure $ Skew (Angle 0 Deg) Nothing - | otherwise = fmap RotateX (minifyWith a) + | isZeroAngle a = pure $ Skew NullAngle Nothing + | otherwise = fmap RotateX (minify a) simplify (RotateY a) - | a == Angle 0 Deg = pure $ Skew (Angle 0 Deg) Nothing - | otherwise = fmap RotateY (minifyWith 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) - | a == Angle 0 Deg = pure $ Skew (Angle 0 Deg) Nothing - | otherwise = fmap Rotate (minifyWith 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 (minifyWith 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 (Angle 0 Deg) Nothing + | n == 1 = pure $ Skew NullAngle Nothing | otherwise = pure $ ScaleZ n -simplify (Perspective d) = fmap Perspective (minifyWith d) +simplify (Perspective d) = fmap Perspective (minify d) simplify (TranslateZ d) - | d == Distance 0 Q = pure $ Skew (Angle 0 Deg) Nothing - | otherwise = fmap TranslateZ (minifyWith 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 && z == Distance 0 Q = either (f TranslateX) (g TranslateX) x - | isZero x && isZero y = simplify $ TranslateZ z - | isZero x && z == Distance 0 Q = either (f TranslateY) (g TranslateY) y - where f con a | a == 0 = simplify . con . Right $ Distance 0 Q + | 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 \ whenever possible, leaving +-- | Combines consecutive @\@ 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 conmutative) +-- list (since matrix multiplication isn't commutative) -- Example: +-- -- >>> import Control.Monad.Reader --- >>> let t10 = Translate (Right (Distance 10 PX)) Nothing --- >>> let tp = Translate (Left (Percentage 100)) Nothing --- >>> let s90 = Skew (Angle 90 Deg) Nothing +-- >>> 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] @@ -539,9 +542,9 @@ where getLength = T.length . toStrict . toLazyText asBuilder = mconcatIntersperse toBuilder (singleton ' ') combinedFunctions = mapM handleMatrices . groupByMatrices $ zip (fmap toMatrix3d xs) xs - minifiedOriginal = mapM minifyWith xs + minifiedOriginal = mapM minify xs groupByMatrices = groupBy (\(a,_) (b,_) -> isJust a && isJust b) handleMatrices l@((x,a):_) - | isJust x = minifyWith . Mat3d . foldr (*) (M.identity 4 :: Matrix Number) $ fmap (getMat . fromJust . fst) l + | 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" diff --git a/src/Hasmin/Types/Value.hs b/src/Hasmin/Types/Value.hs --- a/src/Hasmin/Types/Value.hs +++ b/src/Hasmin/Types/Value.hs @@ -31,7 +31,7 @@ import Hasmin.Config import Hasmin.Types.BgSize -import Hasmin.Types.Class +import Hasmin.Class import Hasmin.Types.Color import Hasmin.Types.Dimension import Hasmin.Types.FilterFunction @@ -45,12 +45,13 @@ import Hasmin.Types.TransformFunction import Hasmin.Utils +-- | A CSS . data Value = Inherit | Initial | Unset | NumberV Number | PercentageV Percentage - | DistanceV Distance + | LengthV Length | AngleV Angle | DurationV Duration | FrequencyV Frequency @@ -62,7 +63,7 @@ | TimingFuncV TimingFunction | FilterV FilterFunction | ShadowV Shadow - | ShadowText Distance Distance (Maybe Distance) (Maybe Color) -- type + | ShadowText Length Length (Maybe Length) (Maybe Color) -- type | PositionV Position | RepeatStyleV RepeatStyle | BgSizeV BgSize @@ -80,8 +81,8 @@ | UrlV Url | Format [StringType] | Local (Either Text StringType) - | Rect Distance Distance Distance Distance -- Should be in , but that accepts only rect() - | Other TextV + | Rect Length Length Length Length -- Should be in , but that accepts only rect() + | Other TextV -- ^ Unrecognized text deriving (Eq, Show) -- | Redefines equality to be case-insensitive, since CSS literal values such as @@ -97,12 +98,15 @@ mkOther :: Text -> Value mkOther = Other . TextV +-- A > value, which can +-- contain either a CSS > +-- (i.e. text surrounded by single or double quotes), or an unquoted string. newtype Url = Url (Either Text StringType) deriving (Eq, Show) instance ToText Url where toBuilder (Url x) = "url(" <> toBuilder x <> singleton ')' instance Minifiable Url where - minifyWith u@(Url x) = do + minify u@(Url x) = do conf <- ask pure $ if shouldRemoveQuotes conf then Url $ either Left unquoteUrl x @@ -115,7 +119,7 @@ toBuilder (NumberV n) = toBuilder n toBuilder (PercentageV p) = (fromText . toText) p toBuilder (ColorV c) = toBuilder c - toBuilder (DistanceV d) = toBuilder d + toBuilder (LengthV d) = toBuilder d toBuilder (AngleV a) = toBuilder a toBuilder (DurationV d) = toBuilder d toBuilder (FrequencyV f) = toBuilder f @@ -173,25 +177,25 @@ <> maybeToBuilder ml <> maybeToBuilder mc instance Minifiable Value where - minifyWith (ColorV c) = ColorV <$> minifyWith c - minifyWith (DistanceV d) = DistanceV <$> minifyWith d - minifyWith (AngleV a) = AngleV <$> minifyWith a - minifyWith (DurationV d) = DurationV <$> minifyWith d - minifyWith (FrequencyV f) = FrequencyV <$> minifyWith f - minifyWith (ResolutionV r) = ResolutionV <$> minifyWith r - minifyWith (GradientV t g) = GradientV t <$> minifyWith g - minifyWith (FilterV f) = FilterV <$> minifyWith f - minifyWith (TransformV tf) = TransformV <$> minifyWith tf - minifyWith (TimingFuncV tf) = TimingFuncV <$> minifyWith tf - minifyWith (StringV s) = StringV <$> minifyWith s - minifyWith (UrlV u) = UrlV <$> minifyWith u - minifyWith (Format x) = Format <$> mapM minifyWith x - minifyWith (PositionV p) = PositionV <$> minifyWith p - minifyWith (RepeatStyleV r) = RepeatStyleV <$> minifyWith r - minifyWith (BgSizeV b) = BgSizeV <$> minifyWith b - minifyWith (ShadowV s) = ShadowV <$> minifyWith s - minifyWith (ShadowText l1 l2 ml mc) = minifyPseudoShadow ShadowText l1 l2 ml mc - minifyWith (BgLayer img pos sz rst att b1 b2) = do + minify (ColorV c) = ColorV <$> minify c + minify (LengthV d) = LengthV <$> minify d + minify (AngleV a) = AngleV <$> minify a + minify (DurationV d) = DurationV <$> minify d + minify (FrequencyV f) = FrequencyV <$> minify f + minify (ResolutionV r) = ResolutionV <$> minify r + minify (GradientV t g) = GradientV t <$> minify g + minify (FilterV f) = FilterV <$> minify f + minify (TransformV tf) = TransformV <$> minify tf + minify (TimingFuncV tf) = TimingFuncV <$> minify tf + minify (StringV s) = StringV <$> minify s + minify (UrlV u) = UrlV <$> minify u + minify (Format x) = Format <$> mapM minify x + minify (PositionV p) = PositionV <$> minify p + minify (RepeatStyleV r) = RepeatStyleV <$> minify r + minify (BgSizeV b) = BgSizeV <$> minify b + minify (ShadowV s) = ShadowV <$> minify s + minify (ShadowText l1 l2 ml mc) = minifyPseudoShadow ShadowText l1 l2 ml mc + minify (BgLayer img pos sz rst att b1 b2) = do -- conf <- ask (i,s,p,r,a) <- minifyBgLayer img pos sz rst att (bgOrigin, bgClip) <- handleBoxes b1 b2 @@ -201,7 +205,7 @@ -- better because it is more frequent. then BgLayer (Just $ mkOther "none") p s r a bgOrigin bgClip else BgLayer i p s r a bgOrigin bgClip - minifyWith (FinalBgLayer img pos sz rst att b1 b2 col) = do + minify (FinalBgLayer img pos sz rst att b1 b2 col) = do -- conf <- ask (i,s,p,r,a) <- minifyBgLayer img pos sz rst att c <- handleColor col @@ -212,7 +216,7 @@ -- better because it is more frequent. then FinalBgLayer (Just $ mkOther "none") p s r a bgOrigin bgClip c else FinalBgLayer i p s r a bgOrigin bgClip c - minifyWith (SingleTransition prop tdur tf tdel) = do + minify (SingleTransition prop tdur tf tdel) = do let p = if prop == Just (TextV "all") then Nothing else prop -- TODO lowercase here @@ -221,7 +225,7 @@ pure $ if isNothing p && isNothing tDuration && isNothing tDelay && isNothing tfunc then SingleTransition p (Just $ Duration 0 S) tfunc tDelay else SingleTransition p tDuration tfunc tDelay - minifyWith (SingleAnimation t1 tf t2 ic ad af ap kf) = do + minify (SingleAnimation t1 tf t2 ic ad af ap kf) = do (tdur, tdel) <- handleTime t1 t2 tfunc <- handleTimingFunction tf icount <- handleIterationCount ic @@ -250,12 +254,12 @@ simplifyDirection = removeIfEqualTo "normal" simplifyPauseState = removeIfEqualTo "running" simplifyFillMode = removeIfEqualTo "none" - minifyWith (FontV fsty fvar fwgt fstr fsz lh ff) = do + minify (FontV fsty fvar fwgt fstr fsz lh ff) = do let sty = removeIfEqualTo "normal" fsty var = removeIfEqualTo "normal" fvar str = removeIfEqualTo "normal" fstr wgt <- optimizeFontWeight fwgt - sz <- minifyWith fsz + sz <- minify fsz l <- optimizeLineHeight lh fam <- traverse optimizeFontFamily ff pure $ FontV sty var wgt str sz l fam @@ -275,11 +279,11 @@ case x of Other t -> if t == TextV "normal" then pure Nothing - else Just <$> minifyWith x - y -> Just <$> minifyWith y + else Just <$> minify x + y -> Just <$> minify y - minifyWith (GenericFunc n vs) = GenericFunc n <$> minifyWith vs - minifyWith (Local x) = do + minify (GenericFunc n vs) = GenericFunc n <$> minify vs + minify (Local x) = do conf <- ask v <- lowercaseParameters x pure . Local $ if shouldRemoveQuotes conf @@ -293,20 +297,20 @@ case letterCase conf of Lowercase -> case y of Left a -> mapReader Left $ lowercaseText a - Right b -> mapReader Right $ mapString lowercaseText b >>= minifyWith + Right b -> mapReader Right $ mapString lowercaseText b >>= minify Original -> pure y - minifyWith x = pure x + minify x = pure x handleRepeatStyle :: Maybe RepeatStyle -> Reader Config (Maybe RepeatStyle) handleRepeatStyle (Just x) - | x == RSPair RsRepeat Nothing = pure Nothing - | otherwise = Just <$> minifyWith x + | x == RepeatStyle1 RsRepeat = pure Nothing + | otherwise = Just <$> minify x handleRepeatStyle Nothing = pure Nothing handleImage :: Maybe Value -> Reader Config (Maybe Value) handleImage (Just x) | x == Other "none" = pure Nothing - | otherwise = Just <$> minifyWith x + | otherwise = Just <$> minify x handleImage Nothing = pure Nothing handleBoxes :: Maybe TextV -> Maybe TextV -> Reader Config (Maybe TextV, Maybe TextV) @@ -326,12 +330,12 @@ handleColor = maybe (pure Nothing) f where f x = if x == Named "transparent" then pure Nothing - else Just <$> minifyWith x + else Just <$> minify x handleBgSize :: Maybe BgSize -> Reader Config (Maybe BgSize) -handleBgSize (Just b@BgSize{}) = do - minb <- minifyWith b - pure $ if minb == BgSize (Right Auto) Nothing +handleBgSize (Just b) = do + minb <- minify b + pure $ if minb == BgSize1 (Right Auto) then Nothing else Just minb handleBgSize x = pure x @@ -339,27 +343,29 @@ handlePosition :: Bool -> Maybe Position -> Reader Config (Maybe Position) handlePosition _ Nothing = pure Nothing handlePosition cannotRemovePos (Just p) - | cannotRemovePos = Just <$> minifyWith p + | cannotRemovePos = Just <$> minify p | otherwise = do - conf <- ask - mp <- minifyWith p + -- conf <- ask + mp <- minify p pure $ if mp == Position Nothing l0 Nothing l0 then Nothing else Just $ if True {- shouldMinifyPosition conf -} then mp else p +-- Represents a list of values, an the separators used between them. data Values = Values Value [(Separator, Value)] deriving (Show, Eq) instance ToText Values where toBuilder (Values v vs) = toBuilder v <> foldr f mempty vs where f (sep, val) z = toBuilder sep <> toBuilder val <> z instance Minifiable Values where - minifyWith (Values v vs) = do - newV <- minifyWith v - newVs <- (mapM . mapM) minifyWith vs + minify (Values v vs) = do + newV <- minify v + newVs <- (mapM . mapM) minify vs pure $ Values newV newVs +-- | A value separator. data Separator = Space | Slash | Comma deriving (Show, Eq) instance ToText Separator where @@ -391,24 +397,24 @@ handleTimingFunction Nothing = pure Nothing handleTimingFunction (Just tfunc) | tfunc == Ease = pure Nothing - | otherwise = Just <$> minifyWith tfunc + | otherwise = Just <$> minify tfunc -- Used for SingleAnimation and SingleTransition minification. handleTime :: Maybe Duration -> Maybe Duration -> Reader Config (Maybe Duration, Maybe Duration) handleTime (Just t) Nothing = if t == Duration 0 S then pure (Nothing, Nothing) - else do newT <- minifyWith t + else do newT <- minify t pure (Just newT, Nothing) handleTime (Just t1) (Just t2) | t1 == Duration 0 S = if t2 == t1 then pure (Nothing, Nothing) - else do newT2 <- minifyWith t2 - newT1 <- minifyWith t1 + else do newT2 <- minify t2 + newT1 <- minify t1 pure (Just newT1, Just newT2) - | otherwise = do newT1 <- minifyWith t1 + | otherwise = do newT1 <- minify t1 if t2 == Duration 0 S then pure (Just t1, Nothing) - else do newT2 <- minifyWith t2 + else do newT2 <- minify t2 pure (Just newT1, Just newT2) handleTime _ _ = pure (Nothing, Nothing) diff --git a/src/Hasmin/Utils.hs b/src/Hasmin/Utils.hs --- a/src/Hasmin/Utils.hs +++ b/src/Hasmin/Utils.hs @@ -21,8 +21,9 @@ import Data.Monoid ((<>)) import qualified Data.Text as T -import Hasmin.Types.Class +import Hasmin.Class + textualLength :: ToText a => a -> Int textualLength = T.length . toText @@ -38,9 +39,9 @@ | otherwise = y <> mconcatIntersperse toMonoid y xs replaceAt :: Int -> a -> [a] -> [a] -replaceAt i v ls = case splitAt i ls of - (xs, _:vs) -> xs ++ (v:vs) - (xs, []) -> xs +replaceAt index val ls = case splitAt index ls of + (xs, _:vs) -> xs ++ (val:vs) + (xs, []) -> xs fromRight' :: Either a b -> b fromRight' (Right x) = x diff --git a/tests/Hasmin/Parser/InternalSpec.hs b/tests/Hasmin/Parser/InternalSpec.hs --- a/tests/Hasmin/Parser/InternalSpec.hs +++ b/tests/Hasmin/Parser/InternalSpec.hs @@ -3,7 +3,6 @@ module Hasmin.Parser.InternalSpec where import Test.Hspec --- import Test.QuickCheck import Hasmin.Parser.Internal import Hasmin.Parser.Value @@ -18,19 +17,19 @@ declarationTestInfo :: [(String, Text, Text)] declarationTestInfo = - [("parses declaration with unknown property and value, ending in ';'", + [("Parses declaration with unknown property and value, ending in ';'", "a:b;", "a:b") - ,("parses declaration with unknown property and value, ending in '}'", + ,("Parses declaration with unknown property and value, ending in '}'", "a:b}", "a:b") - ,("ignores comments before colon", + ,("Ignores comments before colon", "a/**/:b;", "a:b") - ,("ignores comments after colon", + ,("Ignores comments after colon", "a:/**/b;", "a:b") - ,("parses !important and prints it back without space", + ,("Parses !important and prints it back without space", "a:b ! important;", "a:b!important") - ,("ignores comments before semicolon", + ,("Ignores comments before semicolon", "a:b/**/;", "a:b") - ,("parse declaration starting with '+' (IE <= 7)", + ,("Parses declaration starting with '+' (IE <= 7)", "+property:a", "+property:a") ] @@ -43,17 +42,18 @@ fontStyle `shouldSucceedOn` ("oblique" :: Text) fontStyle `shouldFailOn` ("anything else" :: Text) -{- -styleRuleParser :: Spec - describe "style rule parser" $ do - it "parses rule whose final declaration ends in ';'" $ do - "a { margin : 0;}" ~> (styleRule --} +styleRuleParserTests :: Spec +styleRuleParserTests = + describe "Style rule parser tests" $ + mapM_ (matchSpecWithDesc styleRule) styleRuleTestInfo + styleRuleTestInfo :: [(String, Text, Text)] styleRuleTestInfo = [("simple style rule", "a { margin : 0 ;}", "a{margin:0}") + ,("Parses rule with an empty declaration (semicolon alone)", + "h1 { ; }", "h1{}") ,("handles unset", "h1 {\n border: unset\n}", "h1{border:unset}") ,("handles initial", @@ -208,9 +208,10 @@ spec :: Spec spec = do declarationParserTests + declarationParsersTests selectorParserTests selectorParserFailures - declarationParsersTests + styleRuleParserTests main :: IO () main = hspec spec diff --git a/tests/Hasmin/Parser/ValueSpec.hs b/tests/Hasmin/Parser/ValueSpec.hs --- a/tests/Hasmin/Parser/ValueSpec.hs +++ b/tests/Hasmin/Parser/ValueSpec.hs @@ -94,12 +94,11 @@ transformFunctionParserTestsInfo :: [(Text, Text)] transformFunctionParserTestsInfo = - [("skew( 0deg )", "skew(0)") - ,("skew(23GRAD /**/,/**/0deg)", "skew(23grad,0)") + [("skew( 0deg )", "skew(0deg)") + ,("skew(23GRAD /**/,/**/0deg)", "skew(23grad,0deg)") ,("sKeWY(/**/1rad)", "skewy(1rad)") ,("SkeWx(0.2turn/**/)", "skewx(.2turn)") ,("SkeWx(0.2turn)", "skewx(.2turn)") - ,("SkeWx(0.2turn)", "skewx(.2turn)") ,("translate(0% )", "translate(0%)") ,("translate( 0 )", "translate(0)") ,("translate( 1in )", "translate(1in)") @@ -107,7 +106,7 @@ ,("translate(0, 0%)", "translate(0,0%)") ,("translate(0%, 0)", "translate(0%,0)") ,("translate(0, 0)", "translate(0,0)") - ,("translate(10px, 3em)", "translate(10px,3em)") + ,("translate(12px, 3em)", "translate(12px,3em)") ,("translateX(0%)", "translatex(0%)") ,("translateX(/* 3q */ 4q)", "translatex(4q)") ] diff --git a/tests/Hasmin/TestUtils.hs b/tests/Hasmin/TestUtils.hs --- a/tests/Hasmin/TestUtils.hs +++ b/tests/Hasmin/TestUtils.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module Hasmin.TestUtils ( - module Hasmin.TestUtils +module Hasmin.TestUtils + ( module Hasmin.TestUtils , module Test.QuickCheck , module Test.Hspec , module Test.Hspec.Attoparsec @@ -11,13 +11,15 @@ import Test.QuickCheck import Test.Hspec.Attoparsec (parseSatisfies, (~>)) -import Data.Text (Text, unpack, singleton) -import Data.Attoparsec.Text (Parser) import Control.Applicative (liftA2, liftA3) import Control.Monad (liftM4) +import Control.Monad.Reader (runReader) +import Data.Text (Text, unpack, singleton) +import Data.Attoparsec.Text (Parser) import Hasmin.Types.BgSize -import Hasmin.Types.Class +import Hasmin.Class +import Hasmin.Config import Hasmin.Types.Color import Hasmin.Types.Declaration import Hasmin.Types.Dimension @@ -25,22 +27,28 @@ import Hasmin.Types.Numeric import Hasmin.Types.Position import Hasmin.Types.TimingFunction +import Hasmin.Types.RepeatStyle import Hasmin.Utils + +minifyWithTestConfig :: Minifiable a => a -> a +minifyWithTestConfig x = runReader (minify x) cfg + where cfg = defaultConfig { dimensionSettings = DimMinOn } + -- | Check that a color is equivalent to their minified representation form prop_minificationEq :: (Minifiable a, Eq a) => a -> Bool -prop_minificationEq d = minify d == d +prop_minificationEq d = minifyWithTestConfig d == d -- Given a parser and a 3-tuple, prints a test description, -- applies the parser, and compares its result with the expected result matchSpecWithDesc :: ToText a => Parser a -> (String, Text, Text) -> Spec -matchSpecWithDesc parser (description, textToParse, expectedResult) = +matchSpecWithDesc parser (description, textToParse, expectedResult) = it description $ (toText <$> (textToParse ~> parser)) `parseSatisfies` (== expectedResult) matchSpec :: ToText a => Parser a -> (Text, Text) -> Spec matchSpec parser (textToParse, expectedResult) = - it (unpack textToParse) $ + it (unpack textToParse) $ (toText <$> (textToParse ~> parser)) `parseSatisfies` (== expectedResult) mkGen :: [a] -> Gen a @@ -50,8 +58,8 @@ instance ToText Declarations where toText (Declarations ds) = mconcatIntersperse toText (singleton ';') ds -instance Arbitrary Distance where - arbitrary = liftA2 Distance arbitrary distanceUnit +instance Arbitrary Length where + arbitrary = liftA2 Length arbitrary distanceUnit -- TODO keep it DRY, avoid repeating constructor list here (i.e. SPOF) where distanceUnit = mkGen [IN, CM, MM, Q, PC, PT, PX, EM, EX, CH, VH, VW, VMIN, VMAX, REM] @@ -78,9 +86,6 @@ instance Arbitrary PosKeyword where arbitrary = mkGen [PosCenter, PosLeft, PosRight, PosTop, PosBottom] --- instance Arbitrary Position where - -- arbitrary = oneof [ fmap (\x -> Position x Nothing Nothing Nothing) arbitrary ] - instance Arbitrary Percentage where arbitrary = fmap Percentage (arbitrary :: Gen Rational) @@ -99,12 +104,14 @@ ] instance Arbitrary BgSize where - arbitrary = liftA2 BgSize arbitrary arbitrary + arbitrary = oneof [ liftA2 BgSize2 arbitrary arbitrary + , fmap BgSize1 arbitrary + ] instance Arbitrary Auto where arbitrary = pure Auto -instance Arbitrary StepsSecondParam where +instance Arbitrary StepPosition where arbitrary = oneof [pure Start, pure End] instance Arbitrary TimingFunction where @@ -126,22 +133,32 @@ , liftM4 mkHex4 hexChar hexChar hexChar hexChar , liftM4 mkHex8 hexString hexString hexString hexString , liftA3 mkRGBInt intRange intRange intRange - , liftA3 mkRGBPer ratRange ratRange ratRange + , liftA3 mkRGBPer ratRange ratRange ratRange , liftM4 mkRGBAInt intRange intRange intRange alphaRange - , liftM4 mkRGBAPer ratRange ratRange ratRange alphaRange + , liftM4 mkRGBAPer ratRange ratRange ratRange alphaRange , liftA3 mkHSL hueRange ratRange ratRange - , liftM4 mkHSLA hueRange ratRange ratRange alphaRange + , liftM4 mkHSLA hueRange ratRange ratRange alphaRange ] where intRange = choose (0, 255) ratRange = toPercentage <$> (choose (0, 100) :: Gen Float) alphaRange = toAlphavalue <$> (choose (0, 1) :: Gen Float) hueRange = choose (0, 360) --- | Generates color keywords uniformly distributed +instance Arbitrary RepeatStyle where + arbitrary = frequency [(1, pure RepeatX) + ,(1, pure RepeatY) + ,(8, liftA2 RepeatStyle2 arbitrary arbitrary) + ,(8, fmap RepeatStyle1 arbitrary) + ] + +instance Arbitrary RSKeyword where + arbitrary = mkGen [RsRepeat, RsSpace, RsRound, RsNoRepeat] + +-- | Generates color keywords uniformly distributed colorKeyword :: Gen Text colorKeyword = mkGen $ fmap fst keywordColors --- | Generates a hexadecimal character uniformly distributed +-- | Generates a hexadecimal character uniformly distributed hexChar :: Gen Char hexChar = mkGen hexadecimals @@ -149,5 +166,5 @@ hexString = liftA2 (\x y -> [x,y]) hexChar hexChar hexadecimals :: String -hexadecimals = "0123456789abcdef" +hexadecimals = "0123456789abcdef" diff --git a/tests/Hasmin/Types/BgSizeSpec.hs b/tests/Hasmin/Types/BgSizeSpec.hs --- a/tests/Hasmin/Types/BgSizeSpec.hs +++ b/tests/Hasmin/Types/BgSizeSpec.hs @@ -4,7 +4,6 @@ import Data.Text (Text) import Hasmin.Parser.Value -import Hasmin.Types.Class import Hasmin.Types.BgSize import Hasmin.TestUtils @@ -18,7 +17,7 @@ bgSizeTests = describe " minification tests" $ mapM_ (matchSpec f) bgSizeTestsInfo - where f = minify <$> value + where f = minifyWithTestConfig <$> value bgSizeTestsInfo :: [(Text, Text)] bgSizeTestsInfo = @@ -29,7 +28,7 @@ spec :: Spec spec = do quickcheckBgSize - bgSizeTests + bgSizeTests main :: IO () main = hspec spec diff --git a/tests/Hasmin/Types/ColorSpec.hs b/tests/Hasmin/Types/ColorSpec.hs --- a/tests/Hasmin/Types/ColorSpec.hs +++ b/tests/Hasmin/Types/ColorSpec.hs @@ -2,8 +2,6 @@ module Hasmin.Types.ColorSpec where -import Control.Applicative (liftA2) -import Control.Monad import Data.Foldable import Data.Maybe (fromJust) import Data.Text (Text) @@ -11,9 +9,7 @@ import Hasmin.Parser.Value import Hasmin.TestUtils -import Hasmin.Types.Class import Hasmin.Types.Color -import Hasmin.Types.Numeric colorTests :: Spec colorTests = @@ -35,8 +31,8 @@ -- | Multiple equivalent red color representations redColor :: [Text] -redColor = - [ "red" +redColor = + [ "red" , "#f00", "#F00", "#ff0000", "#fF0000", "#Ff0000", "#FF0000" , "rgb(255,0,0)" , "rgb(100%,0%,0%)" , "rgba(255,0,0,1)", "rgba(255,0,0,1.0)" @@ -48,7 +44,7 @@ -- Every color is yellow commentsAndSpacesInColors :: [Text] -commentsAndSpacesInColors = +commentsAndSpacesInColors = [ "rgb(/**/255,255,0)" , "rgb(255,/**/255,0)" , "rgb(255,255,/**/0)" @@ -88,10 +84,10 @@ ] colorMinificationTests :: Spec -colorMinificationTests = +colorMinificationTests = describe "color minification" $ mapM_ (matchSpec f) colorMinificationTestsInfo - where f = minify <$> color + where f = minifyWithTestConfig <$> color colorMinificationTestsInfo :: [(Text, Text)] colorMinificationTestsInfo = @@ -101,7 +97,7 @@ ] spec :: Spec -spec = do colorTests +spec = do colorTests colorParserTests colorMinificationTests colorParserSpacesAndCommentsTests diff --git a/tests/Hasmin/Types/DeclarationSpec.hs b/tests/Hasmin/Types/DeclarationSpec.hs --- a/tests/Hasmin/Types/DeclarationSpec.hs +++ b/tests/Hasmin/Types/DeclarationSpec.hs @@ -8,7 +8,6 @@ import Hasmin.Parser.Internal import Hasmin.TestUtils -import Hasmin.Types.Class import Hasmin.Types.Declaration declarationTests :: Spec @@ -20,10 +19,10 @@ propertySpecificTests = describe "property specific changes" $ mapM_ (matchSpec f) propertySpecificTestsInfo - where f = minify <$> declaration + where f = minifyWithTestConfig <$> declaration -propertySpecificTestsInfo :: [(Text, Text)] -propertySpecificTestsInfo = +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\"") @@ -145,13 +144,13 @@ declarationTestsInfo :: [(Text, Text)] -declarationTestsInfo = +declarationTestsInfo = [("box-shadow:0 7px 0 #fefefe, 0 14px 0 #fefefe", "box-shadow:0 7px 0 #fefefe,0 14px 0 #fefefe") ] cleaningTests :: Spec -cleaningTests = +cleaningTests = describe "cleaning function" $ mapM_ (matchSpecWithDesc f) cleaningTestsInfo where f = (Declarations . clean) <$> declarations @@ -256,8 +255,7 @@ minifyDecTests :: Spec minifyDecTests = describe "minifyDec function" $ - mapM_ (matchSpec f) minifyDecTestsInfo - where f = minify <$> declaration + mapM_ (matchSpec (minifyWithTestConfig <$> declaration)) minifyDecTestsInfo shorthandInitialValuesTests :: Spec shorthandInitialValuesTests = do @@ -266,11 +264,13 @@ testMatches "animation minification" animationTestsInfo testMatches "font minification" fontTestsInfo testMatches "outline minification" outlineTestsInfo - anyOrderShorthandTests - where testMatches a i = describe a $ mapM_ (matchSpecWithDesc (minify <$> declaration)) i + anyOrderShorthandTests + where testMatches :: String -> [(String, Text, Text)] -> SpecWith () + testMatches desc i = describe desc $ + mapM_ (matchSpecWithDesc (minifyWithTestConfig <$> declaration)) i backgroundTestsInfo :: [(String, Text, Text)] -backgroundTestsInfo = +backgroundTestsInfo = [("Does not remove from background when the cannot be removed", "background: 0 0 / 3px", "background:0 0/3px") ,("Removes when it is the default and no is present", @@ -292,7 +292,7 @@ ] transitionTestsInfo :: [(String, Text, Text)] -transitionTestsInfo = +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", @@ -308,7 +308,7 @@ ] animationTestsInfo :: [(String, Text, Text)] -animationTestsInfo = +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", @@ -336,7 +336,7 @@ ] fontTestsInfo :: [(String, Text, Text)] -fontTestsInfo = +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", @@ -356,7 +356,7 @@ -- 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 = +outlineTestsInfo = [("Removes default outline-color", "outline:invert solid 1px", "outline:solid 1px") ,("Removes default outline-style", @@ -368,12 +368,12 @@ ] -- Tests for shorthands whose initial values are "medium none currentColor", --- and can go on any order. +-- and can go on any order. anyOrderShorthandTests :: Spec anyOrderShorthandTests = describe "Shorthands that accept values in any order (mostly: medium none currentColor)" $ - traverse_ (mapM_ (matchSpec (minify <$> declaration))) d - where d = fmap f shorthandsToTest + 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" @@ -435,9 +435,9 @@ ] spec :: Spec -spec = do cleaningTests +spec = do cleaningTests minifyDecTests - shorthandInitialValuesTests + shorthandInitialValuesTests declarationTests propertySpecificTests diff --git a/tests/Hasmin/Types/DimensionSpec.hs b/tests/Hasmin/Types/DimensionSpec.hs --- a/tests/Hasmin/Types/DimensionSpec.hs +++ b/tests/Hasmin/Types/DimensionSpec.hs @@ -2,18 +2,14 @@ module Hasmin.Types.DimensionSpec where -import Control.Applicative (liftA2) - import Hasmin.Types.Dimension -import Hasmin.Types.Numeric -import Hasmin.Types.Class import Hasmin.TestUtils dimensionTests :: Spec dimensionTests = describe "Dimension tests with quickcheck" $ do it "Minified s are equivalent to the original ones" $ - property (prop_minificationEq :: Distance -> Bool) + property (prop_minificationEq :: Length -> Bool) it "Minified s are equivalent to the original ones" $ property (prop_minificationEq :: Angle -> Bool) it "Minified