hasmin 1.0 → 1.0.1
raw patch · 21 files changed
+534/−311 lines, 21 filesdep +bifunctorsdep ~criteriondep ~doctestPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: bifunctors
Dependency ranges changed: criterion, doctest
API changes (from Hackage documentation)
+ Hasmin.Parser.Internal: atMedia :: Parser Rule
+ Hasmin.Types.String: DoubleQuotes :: Text -> StringType
+ Hasmin.Types.String: SingleQuotes :: Text -> StringType
+ Hasmin.Types.String: convertEscaped :: Parser Text
+ Hasmin.Types.String: data StringType
+ Hasmin.Types.String: instance GHC.Classes.Eq Hasmin.Types.String.StringType
+ Hasmin.Types.String: instance GHC.Show.Show Hasmin.Types.String.StringType
+ Hasmin.Types.String: instance Hasmin.Class.Minifiable Hasmin.Types.String.StringType
+ Hasmin.Types.String: instance Hasmin.Class.ToText Hasmin.Types.String.StringType
+ Hasmin.Types.String: mapString :: (Text -> Reader Config Text) -> StringType -> Reader Config StringType
+ Hasmin.Types.String: removeQuotes :: StringType -> Either Text StringType
+ Hasmin.Types.String: unquoteFontFamily :: StringType -> Either Text StringType
+ Hasmin.Types.String: unquoteUrl :: StringType -> Either Text StringType
+ Hasmin.Types.Stylesheet: instance Hasmin.Class.Minifiable [Hasmin.Types.Stylesheet.MediaQuery]
- Hasmin.Class: class ToText a where toText = toStrict . toLazyText . toBuilder toBuilder = fromText . toText
+ Hasmin.Class: class ToText a
Files
- CHANGELOG.md +47/−0
- hasmin.cabal +3/−9
- src/Hasmin.hs +1/−1
- src/Hasmin/Parser/Internal.hs +32/−38
- src/Hasmin/Parser/Utils.hs +9/−1
- src/Hasmin/Parser/Value.hs +114/−124
- src/Hasmin/Types/BgSize.hs +1/−1
- src/Hasmin/Types/Declaration.hs +18/−20
- src/Hasmin/Types/Dimension.hs +7/−2
- src/Hasmin/Types/FilterFunction.hs +5/−5
- src/Hasmin/Types/Gradient.hs +20/−22
- src/Hasmin/Types/PercentageLength.hs +10/−8
- src/Hasmin/Types/Selector.hs +55/−17
- src/Hasmin/Types/String.hs +54/−15
- src/Hasmin/Types/Stylesheet.hs +43/−27
- src/Hasmin/Types/Value.hs +10/−14
- tests/Hasmin/Parser/InternalSpec.hs +13/−0
- tests/Hasmin/Types/DimensionSpec.hs +2/−0
- tests/Hasmin/Types/SelectorSpec.hs +19/−5
- tests/Hasmin/Types/StringSpec.hs +22/−0
- tests/Hasmin/Types/StylesheetSpec.hs +49/−2
CHANGELOG.md view
@@ -1,6 +1,53 @@ # Changelog This project adheres to [PVP](https://pvp.haskell.org). +## 1.0.1++### Added++* Removing `all` and `all and` in media query lists, since `all`+ is assumed when not present. In other words, the following+ rules are equivalent:+ ```css+ @media all {/*..*/}+ @media {/*..*/}+ ```+ and so are these:+ ```css+ @media all and (min-width: 500px) {/*..*/}+ @media (min-width: 500px) {/*..*/}+ ```+ Note that this applies to media query lists in at-import rules too.++* Replacing the `url()` notation for a \<string> when used in the `@import`+ rule.++* Four pseudoelement minifications:++ 1. `:nth-of-type(1)` --> `:first-of-type`.+ 2. `:nth-last-of-type(1)` --> `:last-of-type`.+ 3. `:nth-child(1)` --> `:first-child`.+ 4. `:nth-last-child(1)` --> `:last-child`.++* `[class~=x]` to `.x` minification.++### Improved+* \<position> parser, making hasmin around four times faster on stylesheets with+ many \<position> values.++### Fixed+* Length's Eq instance, which would equate lengths with the same numerical+ value when one had an absolute unit, and the other relative, e.g. 1in and 1em.+* Escaped character conversion: converting characters would crash the program+ when:++ 1. The escaped character had more than 6 hexadecimal digits (6 is the specs+ maximum); E.g. `\aaaaaaa`.+ 2. The escaped character's numerical representation was out of the unicode+ range.++ This is no longer the case.+ ## 1.0 ### Added
hasmin.cabal view
@@ -1,5 +1,5 @@ name: hasmin -version: 1.0 +version: 1.0.1 license: BSD3 license-file: LICENSE author: (c) 2017 Cristian Adrián Ontivero <cristianontivero@gmail.com> @@ -34,17 +34,11 @@ main-is: Main.hs other-modules: Paths_hasmin build-depends: base >=4.9 && <5.1 - , attoparsec >=0.12 && <0.14 - , containers >=0.5 && <0.6 , optparse-applicative >=0.11 && <0.15 - , parsers >=0.12.3 && <0.13 , text >=1.2 && <1.3 , hopfli >=0.2 && <0.4 , bytestring >=0.10.2.0 && <0.11 , gitrev >=1.0.0 && <1.4 - , matrix >=0.3.4 && <0.4 - , mtl >=2.2.1 && <2.3 - , numbers >=3000.2.0.0 && <3000.3 , hasmin library @@ -68,6 +62,7 @@ , Hasmin.Types.FilterFunction , Hasmin.Types.Position , Hasmin.Types.BgSize + , Hasmin.Types.String , Hasmin.Utils , Hasmin.Types.TimingFunction other-modules: Hasmin.Parser.Utils @@ -76,10 +71,9 @@ , Hasmin.Types.Gradient , Hasmin.Types.PercentageLength , Hasmin.Types.Shadow - , Hasmin.Types.String build-depends: base >=4.9 && <5.1 + , bifunctors >=5.4 && <5.5 , attoparsec >=0.12 && <0.14 - , bytestring >=0.10.2.0 && <0.11 , containers >=0.5 && <0.6 , matrix >=0.3.4 && <0.4 , mtl >=2.2.1 && <2.3
src/Hasmin.hs view
@@ -34,7 +34,7 @@ minifyCSSWith cfg t = do sheet <- parseOnly stylesheet t let rs = runReader (minifyRules sheet) cfg- pure . TL.toStrict . toLazyText . mconcat $ map toBuilder rs+ pure . TL.toStrict . toLazyText $ foldMap toBuilder rs -- | Minify 'Text' CSS, using a default set of configurations (with most -- minification techniques enabled). 'minifyCSS' is equivalent to
src/Hasmin/Parser/Internal.hs view
@@ -11,6 +11,7 @@ module Hasmin.Parser.Internal ( stylesheet , atRule+ , atMedia , styleRule , rule , rules@@ -20,9 +21,7 @@ , supportsCondition ) where -import Control.Arrow (first)-import Control.Applicative ((<|>), many, some, empty)-import qualified Data.List.NonEmpty as NE+import Control.Applicative ((<|>), many, some, empty, optional) import Data.Functor (($>)) import Data.Attoparsec.Combinator (lookAhead, sepBy, endOfInput) import Data.Attoparsec.Text (asciiCI, char, many1, manyTill,@@ -33,6 +32,7 @@ import Data.Text (Text) import Data.Text.Lazy.Builder as LB import Data.Map.Strict (Map)+import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Attoparsec.Text as A@@ -59,11 +59,11 @@ -- | Parser for selector combinators, i.e. ">>" (descendant), '>' (child), '+' -- (adjacent sibling), '~' (general sibling), and ' ' (descendant) combinators. combinator :: Parser Combinator-combinator = (skipComments *> ((string ">>" $> Descendant)+combinator = (skipComments *> ((string ">>" $> DescendantBrackets) <|> (char '>' $> Child) <|> (char '+' $> AdjacentSibling) <|> (char '~' $> GeneralSibling)))- <|> (satisfy ws $> Descendant)+ <|> (satisfy ws $> DescendantSpace) where ws c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f' compoundSelector :: Parser CompoundSelector@@ -150,30 +150,27 @@ Just p -> functionParser p Nothing -> functionParser (FunctionalPseudoClass i <$> A.takeWhile (/= ')')) _ -> pure $ PseudoClass i- pseudoElementSelector = do- parsedColon <- option False (char ':' $> True)- if parsedColon- then PseudoElem <$> ident- else ident >>= handleSpecialCase- where handleSpecialCase :: Text -> Parser SimpleSelector- handleSpecialCase t = if T.toCaseFold t `elem` specialPseudoElements- then pure $ PseudoElem t- else empty+ pseudoElementSelector =+ (char ':' *> (PseudoElem <$> ident)) <|> (ident >>= handleSpecialCase)+ where+ handleSpecialCase :: Text -> Parser SimpleSelector+ handleSpecialCase t+ | isSpecialPseudoElement = pure $ PseudoElem t+ | otherwise = empty+ where isSpecialPseudoElement = T.toCaseFold t `elem` specialPseudoElements -- \<An+B> microsyntax parser. anplusb :: Parser AnPlusB anplusb = (asciiCI "even" $> Even) <|> (asciiCI "odd" $> Odd) <|> do- s <- option Nothing (Just <$> parseSign)- x <- option mempty digits- case x of- [] -> ciN *> skipComments *> option (A s Nothing) (AB s Nothing <$> bValue)- _ -> do n <- option False (ciN $> True)- let a = read x :: Int- if n- then skipComments *> option (A s (Just a)) (AB s (Just a) <$> bValue)- else pure $ B (getSign s * a)+ s <- optional parseSign+ dgts <- option mempty digits+ case dgts of+ [] -> ciN *> skipComments *> option (A s Nothing) (AB s Nothing <$> bValue)+ _ -> let n = read dgts :: Int+ in (ciN *> skipComments *> option (A s $ Just n) (AB s (Just n) <$> bValue))+ <|> (pure . B $ getSign s * n) where ciN = satisfy (\c -> c == 'N' || c == 'n') parseSign = (char '-' $> Minus) <|> (char '+' $> Plus) getSign (Just Minus) = -1@@ -187,7 +184,7 @@ -- Functional pseudo classes parsers map fpcMap :: Map Text (Parser SimpleSelector)-fpcMap = Map.fromList $ fmap (first T.toCaseFold)+fpcMap = Map.fromList [buildTuple "nth-of-type" (\x -> FunctionalPseudoClass2 x <$> anplusb) ,buildTuple "nth-last-of-type" (\x -> FunctionalPseudoClass2 x <$> anplusb) ,buildTuple "nth-column" (\x -> FunctionalPseudoClass2 x <$> anplusb)@@ -286,9 +283,7 @@ pure $ AtImport esu mql atCharset :: Parser Rule-atCharset = do- st <- lexeme stringtype <* char ';'- pure $ AtCharset st+atCharset = AtCharset <$> (lexeme stringtype <* char ';') -- @namespace <namespace-prefix>? [ <string> | <uri> ]; -- where@@ -301,14 +296,13 @@ else decideBasedOn i _ <- skipComments <* char ';' pure ret- where decideBasedOn x =- let urltext = T.toCaseFold "url"- in if T.toCaseFold x == urltext- then do c <- A.peekChar- case c of- Just '(' -> AtNamespace mempty <$> (char '(' *> (Right <$> url))- _ -> AtNamespace x <$> (skipComments *> stringOrUrl)- else AtNamespace x <$> (skipComments *> stringOrUrl)+ where decideBasedOn x+ | T.toCaseFold x == "url" =+ do c <- A.peekChar+ case c of+ Just '(' -> AtNamespace mempty <$> (char '(' *> (Right <$> url))+ _ -> AtNamespace x <$> (skipComments *> stringOrUrl)+ | otherwise = AtNamespace x <$> (skipComments *> stringOrUrl) atKeyframe :: Text -> Parser Rule atKeyframe t = do@@ -360,7 +354,7 @@ supportsCondInParens :: Parser SupportsCondInParens supportsCondInParens = do _ <- char '('- x <- lexeme ((ParensCond <$> supportsCondition) <|> (ParensDec <$> atSupportsDeclaration))+ x <- lexeme $ (ParensCond <$> supportsCondition) <|> (ParensDec <$> atSupportsDeclaration) _ <- char ')' pure x @@ -456,8 +450,8 @@ expression = char '(' *> skipComments *> (expr <|> expFallback) where expr = do e <- ident <* skipComments- v <- option Nothing (char ':' *> lexeme (Just <$> value))- _ <- char ')'+ v <- optional (char ':' *> lexeme value)+ _ <- char ')' -- Needed here for expFallback to trigger pure $ Expression e v expFallback = InvalidExpression <$> A.takeWhile (/= ')') <* char ')'
src/Hasmin/Parser/Utils.hs view
@@ -18,8 +18,10 @@ , digits , comma , colon+ , slash , opt , nmchar+ , hexadecimal ) where import Control.Applicative ((<|>), many)@@ -50,6 +52,9 @@ colon :: Parser Char colon = lexeme $ char ':' +slash :: Parser Char+slash = lexeme $ char '/'+ lexeme :: Parser a -> Parser a lexeme p = skipComments *> p <* skipComments @@ -78,7 +83,7 @@ is <- many (skipComments *> ident) if T.toLower i `elem` invalidNames then mzero- else pure $ i <> mconcat (map (" "<>) is)+ else pure $ i <> foldMap (" "<>) is where invalidNames = ["serif", "sans-serif", "monospace", "cursive", "fantasy", "inherit", "initial", "unset", "default"] @@ -133,3 +138,6 @@ -- | Parser one or more digits. digits :: Parser String digits = many1 digit++hexadecimal :: Parser Char+hexadecimal = satisfy C.isHexDigit
src/Hasmin/Parser/Value.hs view
@@ -11,8 +11,8 @@ -- Parsers for CSS values. -- ------------------------------------------------------------------------------module Hasmin.Parser.Value (- valuesFor+module Hasmin.Parser.Value+ ( valuesFor , valuesFallback , value , valuesInParens@@ -31,7 +31,7 @@ , fontStyle ) where -import Control.Applicative ((<|>), many, liftA3)+import Control.Applicative ((<|>), many, liftA3, optional) import Control.Arrow (first, (&&&)) import Control.Monad (mzero) import Data.Functor (($>))@@ -135,8 +135,6 @@ 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@@ -228,7 +226,7 @@ -- parsers to use (e.g.: see the parsers int, or rational) int' :: Parser String int' = do- sign <- option '+' (char '-' <|> char '+')+ sign <- char '-' <|> pure '+' d <- digits case sign of '+' -> pure d@@ -260,12 +258,7 @@ -- | Parser for <https://drafts.csswg.org/css-fonts-3/#propdef-font-style \<font-style\>>, -- used in the @font-style@ and @font@ properties. fontStyle :: Parser Value-fontStyle = do- k <- ident- if Set.member k keywords- then pure $ mkOther k- else mzero- where keywords = Set.fromList ["normal", "italic", "oblique"]+fontStyle = Other <$> matchKeywords ["normal", "italic", "oblique"] {- fontWeight :: Parser Value@@ -282,14 +275,9 @@ fontSize = fontSizeKeyword <|> (LengthV <$> distance) <|> (PercentageV <$> percentage)- where fontSizeKeyword = do- v1 <- ident- if Set.member v1 keywords- then pure $ mkOther v1- else mzero- keywords = Set.fromList ["medium", "xx-small", "x-small", "small"- ,"large", "x-large", "xx-large", "smaller"- ,"larger"]+ where fontSizeKeyword = Other <$> matchKeywords+ ["large", "xx-small", "x-small", "small", "medium",+ "x-large", "xx-large", "smaller" , "larger"] {- [ [ <‘font-style’> || <font-variant-css21> || <‘font-weight’> || - <‘font-stretch’> ]? <‘font-size’> [ / <‘line-height’> ]? <‘font-family’> ] |@@ -298,65 +286,79 @@ -} --- TODO clean parsers pos1, pos2, and pos4 positionvalue :: Parser Value positionvalue = PositionV <$> position -- | Parser for <https://drafts.csswg.org/css-values-3/#position \<position\>>. position :: Parser Position-position = pos4 <|> pos2 <|> pos1+position = perLen <|> kword+ where+ perLen = percentageLength >>= startsWithPL+ kword = do+ i <- ident+ case Map.lookup (T.toCaseFold i) keywords of+ Just x -> skipComments *> x+ Nothing -> mzero+ keywords = Map.fromList+ [("left", startsWith (Just PosLeft) tb)+ ,("right", startsWith (Just PosRight) tb)+ ,("top", startsWith (Just PosTop) lr)+ ,("bottom", startsWith (Just PosBottom) lr)+ ,("center", startsWithCenter)]+ tb = (asciiCI "top" $> Just PosTop, asciiCI "bottom" $> Just PosBottom)+ lr = (asciiCI "left" $> Just PosLeft, asciiCI "right" $> Just PosRight) -pos1 :: Parser Position-pos1 = (asciiCI "left" $> f (Just PosLeft))- <|> (asciiCI "center" $> f (Just PosCenter))- <|> (asciiCI "right" $> f (Just PosRight))- <|> (asciiCI "top" $> f (Just PosTop))- <|> (asciiCI "bottom" $> f (Just PosBottom))- <|> ((\a -> Position Nothing a Nothing Nothing) <$> (Just <$> percentageLength))- where f x = Position x Nothing Nothing Nothing+ startsWithPL :: PercentageLength -> Parser Position+ startsWithPL x = skipComments *>+ (followsWithPL <|> someKeyword <|> wasASinglePL)+ where+ pl = Just x+ followsWithPL = Position Nothing pl Nothing <$> (Just <$> percentageLength)+ wasASinglePL = pure $ Position Nothing pl Nothing Nothing+ someKeyword = do+ i <- ident+ case T.toCaseFold i of+ "center" -> pure $ Position Nothing pl (Just PosCenter) Nothing+ "top" -> pure $ Position Nothing pl (Just PosTop) Nothing+ "bottom" -> pure $ Position Nothing pl (Just PosBottom) Nothing+ _ -> mzero -pos2 :: Parser Position-pos2 = firstx <|> firsty- where firstx = do- a <- (asciiCI "left" $> Position (Just PosLeft) Nothing)- <|> (asciiCI "center" $> Position (Just PosCenter) Nothing)- <|> (asciiCI "right" $> Position (Just PosRight) Nothing)- <|> ((Position Nothing . Just) <$> percentageLength)- skipComments *> ((asciiCI "top" $> a (Just PosTop) Nothing)- <|> (asciiCI "center" $> a (Just PosCenter) Nothing)- <|> (asciiCI "bottom" $> a (Just PosBottom) Nothing)- <|> ((a Nothing . Just) <$> percentageLength))- firsty = do- a <- (asciiCI "top" $> Position (Just PosTop) Nothing)- <|> (asciiCI "center" $> Position (Just PosCenter) Nothing)- <|> (asciiCI "bottom" $> Position (Just PosBottom) Nothing)- <|> ((Position Nothing . Just) <$> percentageLength)- skipComments *> ((asciiCI "left" $> a (Just PosLeft) Nothing)- <|> (asciiCI "center" $> a (Just PosCenter) Nothing)- <|> (asciiCI "right" $> a (Just PosRight) Nothing)- <|> ((a Nothing . Just) <$> percentageLength))+ maybePL :: Parser (Maybe PercentageLength)+ maybePL = optional percentageLength -pos4 :: Parser Position-pos4 = firstx <|> firsty- where posTop = asciiCI "top" $> Position (Just PosTop)- posRight = asciiCI "right" $> Position (Just PosRight)- posBottom = asciiCI "bottom" $> Position (Just PosBottom)- posLeft = asciiCI "left" $> Position (Just PosLeft)- firstx = do- x <- (asciiCI "center" $> Position (Just PosCenter) Nothing)- <|> ((posLeft <|> posRight) <*> (skipComments *> option Nothing (Just <$> percentageLength)))- _ <- skipComments- (asciiCI "center" $> x (Just PosCenter) Nothing)- <|> (((asciiCI "top" $> x (Just PosTop)) <|> (asciiCI "bottom" $> x (Just PosBottom)))- <*> (skipComments *> option Nothing (Just <$> percentageLength)))- firsty = do- x <- (asciiCI "center" $> Position (Just PosCenter) Nothing)- <|> ((posTop <|> posBottom) <*> (skipComments *> option Nothing (Just <$> percentageLength)))- _ <- skipComments- (asciiCI "center" $> x (Just PosCenter) Nothing)- <|> (((asciiCI "left" $> x (Just PosLeft)) <|> (asciiCI "right" $> x (Just PosRight)))- <*> (skipComments *> option Nothing (Just <$> percentageLength)))+ startsWithCenter :: Parser Position+ startsWithCenter = followsWithPL+ <|> followsWithAKeyword+ <|> pure (posTillNow Nothing Nothing)+ where+ followsWithPL = (posTillNow Nothing . Just) <$> percentageLength+ followsWithAKeyword = do+ i <- ident <* skipComments+ let f x = posTillNow (Just x) <$> maybePL+ case T.toCaseFold i of+ "left" -> f PosLeft+ "right" -> f PosRight+ "top" -> f PosTop+ "bottom" -> f PosBottom+ "center" -> pure $ posTillNow (Just PosCenter) Nothing+ _ -> mzero+ posTillNow = Position (Just PosCenter) Nothing + -- Used for the cases when a position starts with the X axis (left and right+ -- keywords) or Y axis (top and bottom)+ startsWith :: Maybe PosKeyword+ -> (Parser (Maybe PosKeyword), Parser (Maybe PosKeyword))+ -> Parser Position+ startsWith x (p1, p2) = do+ pl <- optional (percentageLength <* skipComments)+ let endsWithCenter = Position x pl <$> center <*> pure Nothing+ endsWithKeywordAndMaybePL = Position x pl <$> posKeyword <*> maybePL+ endsWithPL = pure $ Position x Nothing Nothing pl+ endsWithCenter <|> endsWithKeywordAndMaybePL <|> endsWithPL+ where+ posKeyword = (p1 <|> p2) <* skipComments+ center = asciiCI "center" $> Just PosCenter+ {- transformOrigin :: Parser Values transformOrigin = twoVal <|> oneVal@@ -447,16 +449,13 @@ box2 :: Parser (TextV, Maybe TextV) box2 = do x <- box <* skipComments- y <- option Nothing (Just <$> box)+ y <- optional box pure (x,y) -- used for the background property, which takes among other things: -- <position> [ / <bg-size> ]? positionAndBgSize :: Parser (Position, Maybe BgSize)-positionAndBgSize = do- x <- position <* skipComments- y <- option Nothing (Just <$> (char '/' *> skipComments *> bgSize))- pure (x,y)+positionAndBgSize = (,) <$> position <*> optional (slash *> bgSize) matchKeywords :: [Text] -> Parser TextV matchKeywords listOfKeywords = do@@ -499,7 +498,7 @@ singleTransitionProperty = do i <- ident let lowercased = T.toLower i- if Set.member lowercased excludedKeywords+ if lowercased `Set.member` excludedKeywords then mzero else pure $ TextV i excludedKeywords = Set.fromList ["initial", "inherit", "unset", "default", "none"]@@ -508,21 +507,17 @@ timingFunction :: Parser TimingFunction timingFunction = do i <- ident- let lowercased = T.toLower i- case Map.lookup lowercased timingFunctionKeywords of- Just x -> x- Nothing -> char '(' *> (if lowercased == "steps"- then steps- else if lowercased == "cubic-bezier"- then cubicbezier- else mzero)- where timingFunctionKeywords = Map.fromList [("ease", pure Ease)- ,("ease-in", pure EaseIn)- ,("ease-in-out", pure EaseInOut)- ,("ease-out", pure EaseOut)- ,("linear", pure Linear)- ,("step-end", pure StepEnd)- ,("step-start", pure StepStart)]+ fromMaybe mzero $ Map.lookup (T.toLower i) timingFunctionKeywords+ where timingFunctionKeywords = Map.fromList+ [("ease", pure Ease)+ ,("ease-in", pure EaseIn)+ ,("ease-in-out", pure EaseInOut)+ ,("ease-out", pure EaseOut)+ ,("linear", pure Linear)+ ,("step-end", pure StepEnd)+ ,("step-start", pure StepStart)+ ,("steps", char '(' *> steps)+ ,("cubic-bezier", char '(' *> cubicbezier)] backgroundSize :: Parser Values backgroundSize = parseCommaSeparated (BgSizeV <$> bgSize)@@ -609,7 +604,7 @@ where systemFonts = Other <$> parseIdents ["caption", "icon", "menu", "message-box", "small-caption", "status-bar"] fontSizeAndLineHeight = do fsz <- fontSize <* skipComments- lh <- option Nothing (Just <$> (char '/' *> lexeme lineHeight))+ lh <- optional (char '/' *> lexeme lineHeight) pure (fsz, lh) lineHeight = let validNum = do n <- numericalvalue case n of@@ -700,7 +695,7 @@ unquotedFontFamily = do v <- ident vs <- many (skipComments *> ident)- pure $ v <> mconcat (map (T.singleton ' ' <>) vs)+ pure $ v <> foldMap (T.singleton ' ' <>) vs textualvalue :: Parser Value@@ -881,8 +876,8 @@ dropShadow = functionParser $ do l1 <- distance l2 <- lexeme distance- l3 <- option Nothing ((Just <$> distance) <* skipComments)- c <- option Nothing (Just <$> color)+ l3 <- optional (distance <* skipComments)+ c <- optional color pure $ DropShadow l1 l2 l3 c textShadow :: Parser Values@@ -895,7 +890,7 @@ lns = do l1 <- distance l2 <- lexeme distance- l3 <- option Nothing ((Just <$> distance) <* skipComments)+ l3 <- optional (distance <* skipComments) pure (l1,l2,l3) -- | Parser for <https://drafts.csswg.org/css-backgrounds-3/#typedef-shadow \<shadow>>@@ -926,14 +921,14 @@ fourLengths = do l1 <- distance l2 <- lexeme distance- l3 <- option Nothing ((Just <$> distance) <* skipComments)- l4 <- option Nothing ((Just <$> distance) <* skipComments)+ l3 <- optional (distance <* skipComments)+ l4 <- optional (distance <* skipComments) pure (l1,l2,l3,l4) radialgradient :: Parser Gradient radialgradient = functionParser $ do (def, c) <- option (True, RadialGradient Nothing Nothing) ((False,) <$> endingShapeAndSize <* skipComments)- p <- option Nothing (asciiCI "at" *> skipComments *> (Just <$> position))+ p <- optional (asciiCI "at" *> skipComments *> position) _ <- if def && isNothing p then pure '*' -- do nothing else comma@@ -962,25 +957,21 @@ -- : [<angle>|to <side-or-corner> ,]? <color-stop> [, <color-stop>]+ lineargradient :: Parser Gradient lineargradient = functionParser (lg <|> oldLg)- where lg = do- x <- option Nothing angleOrSide- c <- colorStopList- pure $ LinearGradient x c- oldLg = do- x <- option Nothing ((ga <|> ((Just . Right) <$> sideOrCorner)) <* comma)- c <- colorStopList- pure $ OldLinearGradient x c+ where lg = LinearGradient <$> optional angleOrSide <*> colorStopList+ oldLg = OldLinearGradient <$> optional ((ga <|> sc) <* comma)+ <*> colorStopList angleOrSide = (ga <|> gs) <* comma- ga = (Just . Left) <$> angle- gs = asciiCI "to" *> skipComments *> ((Just . Right) <$> sideOrCorner)+ ga = Left <$> angle+ gs = asciiCI "to" *> skipComments *> sc+ sc = Right <$> sideOrCorner -- <side-or-corner> = [left | right] || [top | bottom] sideOrCorner :: Parser (Side, Maybe Side) sideOrCorner = orderOne <|> orderTwo where orderOne = (,) <$> leftright <* skipComments- <*> option Nothing (Just <$> topbottom)+ <*> optional topbottom orderTwo = (,) <$> topbottom <* skipComments- <*> option Nothing (Just <$> leftright)+ <*> optional leftright leftright :: Parser Side leftright = (asciiCI "left" $> LeftSide)@@ -1000,7 +991,7 @@ colorStop :: Parser ColorStop colorStop = ColorStop <$> color <* skipComments- <*> option Nothing (Just <$> percentageLength <* skipComments)+ <*> optional (percentageLength <* skipComments) -- | Parser for <https://drafts.csswg.org/css-color-3/#colorunits \<color\>>. color :: Parser Color@@ -1041,15 +1032,15 @@ -- | Assumes "translate(" has been already parsed translate :: Parser TransformFunction translate = functionParser $ do- pl <- percentageLength <* skipComments- mpl <- option Nothing (char ',' *> skipComments *> (Just <$> percentageLength))+ pl <- percentageLength+ mpl <- optional (comma *> percentageLength) pure $ Translate pl mpl -- | Parser of scale() function. Assumes "scale(" has been already parsed scale :: Parser TransformFunction scale = functionParser $ do- n <- number <* skipComments- mn <- option Nothing (char ',' *> skipComments *> (Just <$> number))+ n <- number+ mn <- optional (comma *> number) pure $ Scale n mn scale3d :: Parser TransformFunction@@ -1058,16 +1049,15 @@ skew :: Parser TransformFunction skew = functionParser $ do- a <- angle <* skipComments- ma <- option Nothing (char ',' *> skipComments *> (Just <$> angle))+ a <- angle+ ma <- optional (comma *> angle) pure $ Skew a ma translate3d :: Parser TransformFunction-translate3d = functionParser $ do- x <- percentageLength <* comma- y <- percentageLength <* comma- z <- distance- pure $ Translate3d x y z+translate3d = functionParser $+ Translate3d <$> percentageLength <* comma+ <*> percentageLength <* comma+ <*> distance matrix :: Parser TransformFunction matrix = functionParser $ do@@ -1100,7 +1090,7 @@ steps :: Parser TimingFunction steps = functionParser $ do i <- int- s <- option Nothing (comma *> (Just <$> startOrEnd))+ s <- optional (comma *> startOrEnd) pure $ Steps i s where startOrEnd = (asciiCI "end" $> End) <|> (asciiCI "start" $> Start)
src/Hasmin/Types/BgSize.hs view
@@ -73,5 +73,5 @@ minifyBgSizeArg :: Either PercentageLength Auto -> Reader Config (Either PercentageLength Auto)-minifyBgSizeArg (Left a) = Left <$> minify a+minifyBgSizeArg (Left a) = Left <$> minifyPL a minifyBgSizeArg (Right Auto) = pure $ Right Auto
src/Hasmin/Types/Declaration.hs view
@@ -40,16 +40,17 @@ import Hasmin.Utils -- | A CSS <https://www.w3.org/TR/css-syntax-3/#declaration \<declaration\>>.-data Declaration = Declaration { propertyName :: Text -- ^ Property name of the declaration.- , valueList :: Values -- ^ Values used in the declaration.- , isImportant :: Bool -- ^ Whether the declaration is \"!important\" (i.e. ends with it).- , hasIEhack :: Bool -- ^ Whether the declaration ends with the \"\\9\" IE hack.- } deriving (Eq, Show)+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 ':'- <> toBuilder vs <> imp <> (if h then " \\9" else mempty)- where imp | i = "!important"- | otherwise = mempty+ <> toBuilder vs <> imp <> iehack+ where imp = if i then "!important" else mempty+ iehack = if h then "\\9" else mempty instance Ord Declaration where -- Just use a lexicographical ordering, since the instance is required by Set@@ -159,7 +160,7 @@ zeroPercentageToLength x = PercentageV x f (BgSizeV bgsz) = pure . BgSizeV $ case bgsz of- BgSize1 x -> BgSize1 (zeroPerToLength x) + BgSize1 x -> BgSize1 (zeroPerToLength x) BgSize2 x y -> BgSize2 (zeroPerToLength x) (zeroPerToLength y) x -> x where zeroPerToLength (Left (Left 0)) = Left $ Right NullLength@@ -174,13 +175,13 @@ replaceWithZero :: Text -> Declaration -> Reader Config Declaration replaceWithZero s d@(Declaration p (Values v vs) _ _) | not (null vs) = pure d -- Some error occured, since there should be only one value- | otherwise =+ | otherwise = pure $ case Map.lookup (T.toCaseFold p) propertiesTraits of Just (PropertyInfo iv inhs _ _) -> if f iv inhs == mkOther s- then pure $ d { valueList = Values (LengthV NullLength) [] }- else pure d- Nothing -> pure d+ then d { valueList = Values (LengthV NullLength) [] }+ else d+ Nothing -> d where f (Just (Values x _)) inh | v == Initial || v == Unset && inh == NonInherited = x | otherwise = v@@ -199,9 +200,9 @@ replaceForSynonym :: TextV -> Value replaceForSynonym t- | t == TextV "normal" = NumberV 400- | t == TextV "bold" = NumberV 700- | otherwise = Other t+ | t == "normal" = NumberV 400+ | t == "bold" = NumberV 700+ | otherwise = Other t optimizeTransformOrigin :: Declaration -> Reader Config Declaration optimizeTransformOrigin d@(Declaration _ vals _ _) = do@@ -535,10 +536,7 @@ _ -> Nothing -- E.g.: an iehack read as a value. where originalLength = textualLength d1 + textualLength d2 + 1 -- The (+1) is because of the ; trblValues = v1 : map snd vs- indexTable = fmap (first T.toCaseFold) [("top", 0)- ,("right", 1)- ,("bottom", 2)- ,("left", 3)]+ indexTable = zip ["top", "right", "bottom", "left"] [0..] -- E.g.: margin: 6px 6px 6px 6px; --> margin: 6px; -- margin: 1px 0 2px 0; --> margin: 1px 0 2px;
src/Hasmin/Types/Dimension.hs view
@@ -46,8 +46,9 @@ deriving (Show) instance Eq Length where (Length r1 u1) == (Length r2 u2)- | u1 == u2 = r1 == r2- | otherwise = toInches r1 u1 == toInches r2 u2+ | u1 == u2 = r1 == r2+ | isAbsolute u1 && isAbsolute u2 = toInches r1 u1 == toInches r2 u2+ | otherwise = r1 == 0 && r2 == 0 x == y = isZeroLen x && isZeroLen y instance Minifiable Length where minify NullLength = pure NullLength@@ -62,6 +63,10 @@ isRelative :: LengthUnit -> Bool isRelative x = x == EM || x == EX || x == CH || x == VH || x == VW || x == VMIN || x == VMAX || x == REM++isAbsolute :: LengthUnit -> Bool+isAbsolute x = x == PX || x == PT || x == PC || x == IN+ || x == MM || x == CM || x == Q isRelativeLength :: Length -> Bool isRelativeLength (Length _ u) = isRelative u
src/Hasmin/Types/FilterFunction.hs view
@@ -8,14 +8,15 @@ -- Portability : unknown -- ------------------------------------------------------------------------------module Hasmin.Types.FilterFunction (- FilterFunction(..)+module Hasmin.Types.FilterFunction+ ( FilterFunction(..) , minifyPseudoShadow ) where import Control.Monad.Reader (Reader, ask) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder (singleton, Builder)+ import Hasmin.Config import Hasmin.Class import Hasmin.Types.Dimension@@ -91,9 +92,9 @@ z <- case c of Just r -> if isZeroLen r then pure Nothing- else mapM minify c+ else traverse minify c Nothing -> pure Nothing- c2 <- mapM minify d+ c2 <- traverse minify d pure $ constr x y z c2 minifyNumberPercentage :: Either Number Percentage@@ -117,4 +118,3 @@ filterFunctionEquality (Right a) (Right b) = toRational a == toRational b filterFunctionEquality (Left a) (Right b) = toRational a == toRational b/100 filterFunctionEquality (Right a) (Left b) = toRational a/100 == toRational b-
src/Hasmin/Types/Gradient.hs view
@@ -66,9 +66,8 @@ | otherwise = c1 newC2 | ch2 == Just (Left (Percentage 100)) = c2 {colorHint = Nothing} - | otherwise = if ch2 `notGreaterThan` ch1 - then c2 {colorHint = Just $ Right NullLength} - else c2 + | ch2 `notGreaterThan` ch1 = c2 {colorHint = Just $ Right NullLength} + | otherwise = c2 minifyColorHints (c@(ColorStop a x):xs) = case x of Nothing -> c : analyzeList (Left $ Percentage 0) 1 (c:xs) xs Just y -> if isZero y @@ -85,7 +84,7 @@ Left p -> maybe False (either (<= p) (const False)) y Right d -> maybe False (either (const False) (notGreaterThanLength d)) y where notPositive = maybe False (either (<= 0) notPositiveLength) - + notPositiveLength (Length d _) = d <= 0 notPositiveLength NullLength = True @@ -179,7 +178,10 @@ -- | CSS <https://drafts.csswg.org/css-images-3/#typedef-size \<size\>> data -- type, used by @radial-gradient()@. -data Size = ClosestCorner | ClosestSide | FarthestCorner | FarthestSide +data Size = ClosestCorner + | ClosestSide + | FarthestCorner + | FarthestSide | SL Length | PL PercentageLength PercentageLength deriving (Eq, Show) @@ -254,25 +256,21 @@ minifyAngleOrSide :: Maybe (Either Angle SideOrCorner) -> Reader Config (Maybe (Either Angle SideOrCorner)) -minifyAngleOrSide mas = - case mas of - Nothing -> pure Nothing - Just y -> case y of - Left a -> if a == defaultGradientAngle - then pure Nothing - else minify a >>= pure . Just . Left - Right b -> if b == defaultGradientSideOrCorner - then pure Nothing - else pure $ Just (minifySide b) - where minifySide (TopSide, Nothing) = Left NullAngle +minifyAngleOrSide Nothing = pure Nothing +minifyAngleOrSide (Just (Left a)) + | a == defaultGradientAngle = pure Nothing + | otherwise = (Just . Left) <$> minify a + where defaultGradientAngle = Angle 180 Deg +minifyAngleOrSide (Just (Right b)) + | b == defaultGradientSideOrCorner = pure Nothing + | otherwise = pure $ Just (minifySide b) + where defaultGradientSideOrCorner = (BottomSide, Nothing) + minifySide (TopSide, Nothing) = Left NullAngle minifySide (RightSide, Nothing) = Left (Angle 90 Deg) minifySide (BottomSide, Nothing) = Left (Angle 180 Deg) minifySide (LeftSide, Nothing) = Left (Angle 270 Deg) minifySide z = Right z - defaultGradientAngle = Angle 180 Deg - defaultGradientSideOrCorner = (BottomSide, Nothing) - instance ToText Gradient where toBuilder (OldLinearGradient mas csl) = maybe mempty f mas <> mconcatIntersperse id (singleton ',') (fmap toBuilder csl) @@ -289,9 +287,9 @@ toBuilder (RadialGradient sh sz p cs) = firstPart <> mconcatIntersperse id (singleton ',') (fmap toBuilder cs) where l = catMaybes [fmap toBuilder sh, fmap toBuilder sz, fmap (\x -> "at " <> toBuilder x) p] - firstPart = if null l - then mempty - else mconcatIntersperse id (singleton ' ') l <> singleton ',' + firstPart + | null l = mempty + | otherwise = mconcatIntersperse id (singleton ' ') l <> singleton ',' instance Eq Gradient where LinearGradient x1 csl1 == LinearGradient x2 csl2 =
src/Hasmin/Types/PercentageLength.hs view
@@ -12,11 +12,14 @@ ( PercentageLength , isZero , isNonZeroPercentage+ , minifyPL ) where +import Control.Monad.Reader (Reader) import Hasmin.Types.Dimension import Hasmin.Types.Numeric import Hasmin.Class+import Hasmin.Config -- | CSS <length-percentage> data type, i.e.: [length | percentage] -- Though because of the name it would be more intuitive to define:@@ -25,18 +28,17 @@ -- makes no sense to minify a Percentage. type PercentageLength = Either Percentage Length --- TODO see if this instance can be deleted altogether.-instance Minifiable PercentageLength where- minify x@(Right _) = mapM minify x- minify x@(Left p)- | p == 0 = pure $ Right NullLength -- minifies 0% to 0- | otherwise = pure x +minifyPL :: PercentageLength+ -> Reader Config PercentageLength+minifyPL x@(Right _) = mapM minify x+minifyPL 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 Length -> Bool isZero = either (== 0) isZeroLen--
src/Hasmin/Types/Selector.hs view
@@ -24,6 +24,7 @@ import Control.Applicative (liftA2) import Control.Monad.Reader (ask) import Data.Text (Text)+import Data.Bitraversable (bitraverse) import qualified Data.Text as T import Data.Text.Lazy.Builder (fromText, singleton, Builder) import Data.Monoid ((<>))@@ -44,18 +45,34 @@ -- | A <https://drafts.csswg.org/selectors-4/#selector-combinator selector combinator>, -- which can either: whitespace, "greater-than sign" (U+003E, >), "plus sign" -- (U+002B, +) or "tilde" (U+007E, ~).-data Combinator = Descendant -- ^ ' '- | Child -- ^ '>'- | AdjacentSibling -- ^ '+'- | GeneralSibling -- ^ '~'- deriving (Eq, Show)+data Combinator = DescendantSpace -- ^ ' '+ | DescendantBrackets -- ^ '>>'+ | Child -- ^ '>'+ | AdjacentSibling -- ^ '+'+ | GeneralSibling -- ^ '~'+ deriving (Show) +instance Eq Combinator where+ DescendantSpace == DescendantSpace = True+ DescendantSpace == DescendantBrackets = True+ DescendantBrackets == DescendantSpace = True+ DescendantBrackets == DescendantBrackets = True+ Child == Child = True+ AdjacentSibling == AdjacentSibling = True+ GeneralSibling == GeneralSibling = True+ _ == _ = False+ instance ToText Combinator where- toBuilder Descendant = " "- toBuilder Child = ">"- toBuilder AdjacentSibling = "+"- toBuilder GeneralSibling = "~"+ toBuilder DescendantSpace = " "+ toBuilder DescendantBrackets = " "+ toBuilder Child = ">"+ toBuilder AdjacentSibling = "+"+ toBuilder GeneralSibling = "~" +instance Minifiable Combinator where+ minify DescendantBrackets = pure DescendantSpace+ minify x = pure x+ -- Note: an empty selector, containing no sequence of simple selectors and no -- pseudo-element, is an invalid selector. --@@ -71,13 +88,12 @@ s1 <= s2 = toText s1 <= toText s2 instance ToText Selector where- toBuilder (Selector cs ccss) = toBuilder cs- <> mconcat (fmap build ccss)+ toBuilder (Selector cs ccss) = toBuilder cs <> foldMap build ccss where build (comb, compSel) = toBuilder comb <> toBuilder compSel instance Minifiable Selector where minify (Selector c xs) = do newC <- minify c- newCs <- (mapM . mapM) minify xs+ newCs <- mapM (bitraverse minify minify) xs pure $ Selector newC newCs type Specificity = (Int, Int, Int)@@ -113,8 +129,8 @@ instance ToText CompoundSelector where toBuilder ns@(Universal{} :| xs)- | length ns > 1 = mconcat $ fmap toBuilder xs- toBuilder ns = mconcat $ N.toList (fmap toBuilder ns)+ | length ns > 1 = foldMap toBuilder xs+ toBuilder ns = foldMap toBuilder (N.toList ns) instance Minifiable CompoundSelector where minify (a :| xs) = liftA2 (:|) (minify a) (mapM minify xs)@@ -184,7 +200,7 @@ <> singleton '(' <> toBuilder a <> f xs <> singleton ')' where f [] = mempty f (y:ys) = " of " <> toBuilder y- <> mconcat (fmap (\z -> singleton ',' <> toBuilder z) ys)+ <> foldMap (\z -> singleton ',' <> toBuilder z) ys -- | List of pseudo-elements that support the old syntax of a single semicolon, -- as well as the new one of two semicolons.@@ -192,7 +208,18 @@ specialPseudoElements = fmap T.toCaseFold ["after", "before", "first-line", "first-letter"] +-- Pseudo element names are ASCII case-insensitive+-- https://drafts.csswg.org/selectors-4/#pseudo-element%20syntax instance Minifiable SimpleSelector where+ -- [class~="a"] == .a+ minify a@(AttributeSel (attid :~=: attval))+ -- In HTML attribute names are matched case-insensitively+ | T.toLower attid == "class" =+ pure $ case attval of+ Left z -> ClassSel z+ Right x -> case removeQuotes x of+ Left y -> ClassSel y+ Right _ -> a minify a@(AttributeSel att) = do conf <- ask pure $ if shouldRemoveQuotes conf@@ -213,8 +240,18 @@ Left _ -> a Right s -> Lang (removeQuotes s) else a- minify (FunctionalPseudoClass1 i cs) = FunctionalPseudoClass1 i <$> mapM minify cs- minify (FunctionalPseudoClass2 i n) = FunctionalPseudoClass2 i <$> minify n+ -- Pseudoclasses are ASCII case-insensitive+ -- https://drafts.csswg.org/selectors-4/#pseudo-classes+ minify (FunctionalPseudoClass1 i cs) = FunctionalPseudoClass1 i <$> mapM minify cs+ minify (FunctionalPseudoClass2 i (B 1))+ | iden == "nth-of-type" = pure $ PseudoClass "first-of-type"+ | iden == "nth-last-of-type" = pure $ PseudoClass "last-of-type"+ where iden = T.toLower i+ minify (FunctionalPseudoClass2 i n) = FunctionalPseudoClass2 i <$> minify n+ minify (FunctionalPseudoClass3 i (B 1) [])+ | iden == "nth-last-child" = pure $ PseudoClass "last-child"+ | iden == "nth-child" = pure $ PseudoClass "first-child"+ where iden = T.toLower i minify (FunctionalPseudoClass3 i n cs) = FunctionalPseudoClass3 i <$> minify n <*> pure cs minify x = pure x @@ -229,6 +266,7 @@ -- | The <https://drafts.csswg.org/css-syntax-3/#the-anb-type \<an+b\>> microsyntax type. data AnPlusB = Even | Odd+ -- A Nothing Nothing is "n" alone. | 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
src/Hasmin/Types/String.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- |@@ -12,16 +13,20 @@ ( removeQuotes , unquoteUrl , unquoteFontFamily+ , convertEscaped , mapString , StringType(..) ) where -import Control.Applicative (liftA2)+import Control.Applicative (liftA2, (<|>)) import Control.Monad.Reader (ask, Reader) import Data.Attoparsec.Text (Parser, parse, IResult(Done, Partial, Fail), maybeResult, feed) import Data.Monoid ((<>)) import Data.Text (Text)-import Data.Text.Lazy.Builder (singleton, fromText, toLazyText)+import Data.Foldable (foldl')+import Data.Bits ((.|.), shiftL)+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as B import qualified Data.Attoparsec.Text as A import qualified Data.Char as C import qualified Data.Text as T@@ -33,13 +38,13 @@ -- | The <https://drafts.csswg.org/css-values-3/#strings \<string\>> data type. -- It represents a string, formed by Unicode characters, delimited by either--- double (") or single (') quotes.+-- double (\") or single (\') quotes. data StringType = DoubleQuotes Text | SingleQuotes Text deriving (Show, Eq) instance ToText StringType where- toBuilder (DoubleQuotes t) = singleton '\"' <> fromText t <> singleton '\"'- toBuilder (SingleQuotes t) = singleton '\'' <> fromText t <> singleton '\''+ toBuilder (DoubleQuotes t) = B.singleton '\"' <> B.fromText t <> B.singleton '\"'+ toBuilder (SingleQuotes t) = B.singleton '\'' <> B.fromText t <> B.singleton '\'' instance Minifiable StringType where minify (DoubleQuotes t) = do conf <- ask@@ -67,8 +72,8 @@ else t mapString :: (Text -> Reader Config Text) -> StringType -> Reader Config StringType-mapString f (DoubleQuotes t) = f t >>= pure . DoubleQuotes-mapString f (SingleQuotes t) = f t >>= pure . SingleQuotes+mapString f (DoubleQuotes t) = DoubleQuotes <$> f t+mapString f (SingleQuotes t) = SingleQuotes <$> f t unquoteStringType :: (Text -> Maybe Text) -> StringType -> Either Text StringType unquoteStringType g x@(DoubleQuotes s) = maybe (Right x) Left (g s)@@ -100,12 +105,46 @@ toUnquotedFontFamily :: Text -> Maybe Text toUnquotedFontFamily = unquote fontfamilyname +-- TODO can the Parser be avoided by a fold, or one of the provided library+-- functions? Apart from being cleaner, doing so would simplify other functions.+-- | Parse and convert any escaped unicode to its underlying Char. convertEscaped :: Parser Text-convertEscaped = (TL.toStrict . toLazyText) <$> go- where go = do- t <- fromText <$> A.takeWhile (/= '\\')- c <- A.peekChar- case c of- Just '\\' -> A.char '\\' *> liftA2 (mappend . mappend t . singleton) utf8 go- _ -> pure t- utf8 = C.chr <$> A.hexadecimal+convertEscaped = (TL.toStrict . B.toLazyText) <$> go+ where+ go = do+ nonescapedText <- B.fromText <$> A.takeWhile (/= '\\')+ cont nonescapedText <|> pure nonescapedText+ cont b = do+ _ <- A.char '\\'+ c <- A.peekChar+ case c of+ Just _ -> parseEscapedAndContinue b+ Nothing -> pure (b <> B.singleton '\\')++ parseEscapedAndContinue :: Builder -> Parser Builder+ parseEscapedAndContinue b = do+ u8 <- utf8+ (b `mappend` u8 `mappend`) <$> go++ utf8 :: Parser Builder+ utf8 = do+ mch <- atMost 6 hexadecimal+ pure $ maybe ("\\" <> B.fromString mch) B.singleton (hexToChar mch)++ -- Interpret a hexadecimal string as a decimal Int, and convert it into the+ -- corresponding Char.+ hexToChar :: [Char] -> Maybe Char+ hexToChar xs+ | i > maxChar = Nothing+ | otherwise = Just (C.chr i)+ where i = foldl' step 0 xs+ maxChar = fromEnum (maxBound :: Char)+ step a c+ | w - 48 < 10 = (a `shiftL` 4) .|. fromIntegral (w - 48)+ | w >= 97 = (a `shiftL` 4) .|. fromIntegral (w - 87)+ | otherwise = (a `shiftL` 4) .|. fromIntegral (w - 55)+ where w = C.ord c++ atMost :: Int -> Parser a -> Parser [a]+ atMost 0 _ = pure []+ atMost n p = A.option [] $ liftA2 (:) p (atMost (n-1) p)
src/Hasmin/Types/Stylesheet.hs view
@@ -9,8 +9,8 @@ -- Portability : unknown -- ------------------------------------------------------------------------------module Hasmin.Types.Stylesheet (- Expression(..)+module Hasmin.Types.Stylesheet+ ( Expression(..) , MediaQuery(..) , Rule(..) , KeyframeSelector(..)@@ -53,8 +53,8 @@ | MediaQuery2 [Expression] -- ^ Second possibility in the grammar deriving (Show, Eq) instance Minifiable MediaQuery where- minify (MediaQuery1 t1 t2 es) = MediaQuery1 t1 t2 <$> mapM minify es- minify (MediaQuery2 es) = MediaQuery2 <$> mapM minify es+ minify (MediaQuery1 t1 t2 es) = MediaQuery1 t1 t2 <$> traverse minify es+ minify (MediaQuery2 es) = MediaQuery2 <$> traverse minify es instance ToText MediaQuery where toBuilder (MediaQuery1 t1 t2 es) = notOrOnly <> fromText t2 <> expressions@@ -67,7 +67,7 @@ | InvalidExpression Text deriving (Show, Eq) instance Minifiable Expression where- minify (Expression t mv) = Expression t <$> mapM minify mv+ minify (Expression t mv) = Expression t <$> traverse minify mv minify x = pure x instance ToText Expression where toBuilder (Expression t mv) =@@ -102,10 +102,8 @@ <> mconcatIntersperse toBuilder (singleton ';') ds <> singleton '}' instance Minifiable KeyframeBlock where- minify (KeyframeBlock ss ds) = do- decs <- mapM minify ds- sels <- mapM minify ss- pure $ KeyframeBlock sels decs+ minify (KeyframeBlock ss ds) =+ KeyframeBlock <$> traverse minify ss <*> traverse minify ds type VendorPrefix = Text @@ -123,9 +121,9 @@ deriving (Eq, Show) instance ToText Rule where toBuilder (AtMedia mqs rs) = "@media " <> mconcatIntersperse toBuilder (singleton ',') mqs- <> singleton '{' <> mconcat (fmap toBuilder rs) <> singleton '}'+ <> singleton '{' <> foldMap toBuilder rs <> singleton '}' toBuilder (AtSupports sc rs) = "@supports " <> toBuilder sc- <> singleton '{' <> mconcat (fmap toBuilder rs) <> singleton '}'+ <> singleton '{' <> foldMap toBuilder rs <> singleton '}' toBuilder (AtImport esu mqs) = "@import " <> toBuilder esu <> mediaqueries <> singleton ';' where mediaqueries =@@ -145,25 +143,26 @@ ,singleton '}'] toBuilder (AtBlockWithRules t rs) = mconcat [singleton '@', fromText t, singleton '{'- , mconcat (fmap toBuilder rs), singleton '}']+ , foldMap toBuilder rs, singleton '}'] toBuilder (AtBlockWithDec t ds) = mconcat [singleton '@', fromText t, singleton '{' ,mconcatIntersperse id (singleton ';') (fmap toBuilder ds) ,singleton '}'] toBuilder (AtKeyframes vp n bs) = singleton '@' <> fromText vp <> "keyframes" <> singleton ' ' <> fromText n <> singleton '{'- <> mconcat (fmap toBuilder bs) <> singleton '}'+ <> foldMap toBuilder bs <> singleton '}' instance Minifiable Rule where- 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+ -- @media all {..} == @media {..}+ minify (AtMedia mqs rs) = AtMedia <$> minify mqs <*> traverse minify rs+ minify (AtSupports sc rs) = liftA2 AtSupports (minify sc) (traverse minify rs)+ minify (AtKeyframes vp n bs) = AtKeyframes vp n <$> traverse minify bs+ minify (AtBlockWithRules t rs) = AtBlockWithRules t <$> traverse minify rs+ minify (AtBlockWithDec t ds) = do+ decs <- cleanRule ds >>= collapseLonghands >>= traverse minify pure $ AtBlockWithDec t decs minify (StyleRule ss ds) = do- decs <- cleanRule ds >>= collapseLonghands >>= mapM minify >>= sortDeclarations- sels <- mapM minify ss >>= removeDuplicateSelectors >>= sortSelectors+ decs <- cleanRule ds >>= collapseLonghands >>= traverse minify >>= sortDeclarations+ sels <- traverse minify ss >>= removeDuplicateSelectors >>= sortSelectors pure $ StyleRule sels decs where sortSelectors :: [Selector] -> Reader Config [Selector] sortSelectors sls = do@@ -179,11 +178,28 @@ pure $ if shouldRemoveDuplicateSelectors conf then nub' sls else sls-- minify (AtImport esu mqs) = AtImport esu <$> mapM minify mqs+ -- convert url() to " "+ minify (AtImport esu mqs) =+ case esu of+ Left _ -> AtImport esu <$> minify mqs+ Right (Url ets) -> do a <- traverse minify ets+ let na = either DoubleQuotes id a+ b <- minify mqs+ pure $ AtImport (Left na) b minify (AtCharset s) = AtCharset <$> mapString lowercaseText s minify x = pure x +instance Minifiable [MediaQuery] where+ minify (MediaQuery1 t1 t2 xs : ys)+ | T.null t1 && T.toLower t2 == "all" =+ case xs of+ [] -> minify ys+ _ -> liftA2 (:) (MediaQuery2 <$> traverse minify xs) (minify ys)+ | otherwise = liftA2 (:) (MediaQuery1 t1 t2 <$> traverse minify xs) (minify ys)+ minify (MediaQuery2 es : ys) =+ liftA2 (:) (MediaQuery2 <$> traverse minify es) (minify ys)+ minify [] = pure []+ sortDeclarations :: [Declaration] -> Reader Config [Declaration] sortDeclarations ds = do conf <- ask@@ -252,7 +268,7 @@ nub' = go Set.empty where go _ [] = [] go s (x:xs) | Set.member x s = go s xs- | otherwise = x : go (Set.insert x s) xs+ | otherwise = x : go (Set.insert x s) xs data SupportsCondition = Not SupportsCondInParens | And SupportsCondInParens (NonEmpty SupportsCondInParens)@@ -297,8 +313,8 @@ toBuilder (ParensDec x) = "(" <> toBuilder x <> ")" toBuilder (ParensCond x) = "(" <> toBuilder x <> ")" instance Minifiable SupportsCondInParens where- minify (ParensDec x) = ParensDec <$> minify x- minify (ParensCond x) = ParensCond <$> minify x+ minify (ParensDec x) = ParensDec <$> minify x+ minify (ParensCond x) = ParensCond <$> minify x instance Minifiable [Rule] where minify = minifyRules@@ -401,7 +417,7 @@ 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 _) + shouldSkip StyleRule{} (AtBlockWithDec t _) | t == "font-face" = False | otherwise = True -- TODO see better what needs to be skipped and what doesn't need to
src/Hasmin/Types/Value.hs view
@@ -217,7 +217,7 @@ then FinalBgLayer (Just $ mkOther "none") p s r a bgOrigin bgClip c else FinalBgLayer i p s r a bgOrigin bgClip c minify (SingleTransition prop tdur tf tdel) = do- let p = if prop == Just (TextV "all")+ let p = if prop == Just "all" then Nothing else prop -- TODO lowercase here (tDuration, tDelay) <- handleTime tdur tdel@@ -269,21 +269,17 @@ conf <- ask pure $ replaceForSynonym (fontweightSettings conf) x where replaceForSynonym s (Other t)- | t == TextV "normal" = Nothing- | t == TextV "bold" && s == FontWeightMinOn = Just $ NumberV 700- | otherwise = Just $ Other t+ | t == "normal" = Nothing+ | t == "bold" && s == FontWeightMinOn = Just $ NumberV 700+ | otherwise = Just $ Other t replaceForSynonym _ (NumberV 400) = Nothing replaceForSynonym _ y = Just y- optimizeLineHeight Nothing = pure Nothing- optimizeLineHeight (Just x) =- case x of- Other t -> if t == TextV "normal"- then pure Nothing- else Just <$> minify x- y -> Just <$> minify y+ optimizeLineHeight Nothing = pure Nothing+ optimizeLineHeight (Just (Other "normal")) = pure Nothing+ optimizeLineHeight (Just x) = Just <$> minify x minify (GenericFunc n vs) = GenericFunc n <$> minify vs- minify (Local x) = do+ minify (Local x) = do conf <- ask v <- lowercaseParameters x pure . Local $ if shouldRemoveQuotes conf@@ -322,7 +318,7 @@ handleAttachment :: Maybe TextV -> Reader Config (Maybe TextV) handleAttachment = maybe (pure Nothing) f- where f x = pure $ if x == TextV "scroll"+ where f x = pure $ if x == "scroll" then Nothing else Just x -- TODO might need to lowercase here. @@ -333,7 +329,7 @@ else Just <$> minify x handleBgSize :: Maybe BgSize -> Reader Config (Maybe BgSize)-handleBgSize (Just b) = do +handleBgSize (Just b) = do minb <- minify b pure $ if minb == BgSize1 (Right Auto) then Nothing
tests/Hasmin/Parser/InternalSpec.hs view
@@ -10,6 +10,18 @@ import Data.Text (Text) import Hasmin.TestUtils +ruleParserTest :: Spec+ruleParserTest =+ describe "At-rule parser tests" $+ mapM_ (matchSpecWithDesc atRule) atMediaParserTestInfo++atMediaParserTestInfo :: [(String, Text, Text)]+atMediaParserTestInfo =+ [("Doesn't choke on invalid @media expression",+ "@media screen and (min-resolution: 144 dpi){}",+ "@media screen and (min-resolution: 144 dpi){}")+ ]+ declarationParserTests :: Spec declarationParserTests = describe "declaration parser tests" $@@ -212,6 +224,7 @@ selectorParserTests selectorParserFailures styleRuleParserTests+ ruleParserTest main :: IO () main = hspec spec
tests/Hasmin/Types/DimensionSpec.hs view
@@ -62,6 +62,8 @@ Length 1.27 CM `shouldBe` Length 3 PC it "1.27cm == 48px" $ Length 1.27 CM `shouldBe` Length 48 PX+ it "1in != 1em" $+ Length 1 IN `shouldNotBe` Length 1 EM -- describe "<time> conversions" $ do -- it "" $ Duration 1 S `shouldBe` Duration 1000 Ms -- describe "<frequency> conversions" $ do
tests/Hasmin/Types/SelectorSpec.hs view
@@ -19,12 +19,26 @@ selectorTestsInfo :: [(Text, Text)] selectorTestsInfo =- [("div > p", "div>p")- ,("div p", "div p")- ,("div + p", "div+p")- ,("div ~ p", "div~p")- ,("p::selection", "p::selection")+ [("div > p", "div>p")+ ,("div p", "div p")+ ,("div\tp", "div p")+ ,("div + p", "div+p")+ ,("div ~ p", "div~p")+ ,("div >> p", "div p")++ -- https://drafts.csswg.org/selectors-4/#class-html+ ,("h1[class~=\"x\"]", "h1.x")+ ,("h1[class~=x]", "h1.x")+ ,("h1[class~=\"x\'\"]", "h1[class~=\"x\'\"]")++ ,("p::selection", "p::selection") ,("html:lang( 'de' )", "html:lang(de)")++ -- https://drafts.csswg.org/selectors-4/#the-first-of-type-pseudo+ ,(":nth-of-type(1)", ":first-of-type")+ ,(":nth-last-of-type(1)", ":last-of-type")+ ,(":nth-child(1)", ":first-child")+ ,(":nth-last-child(1)", ":last-child") ] anplusbMinificationTestsInfo :: [(Text, Text)]
tests/Hasmin/Types/StringSpec.hs view
@@ -5,6 +5,7 @@ import Data.Text (Text) import Hasmin.Parser.Value+import Hasmin.Types.String import Hasmin.TestUtils quotesNormalizationTests :: Spec@@ -16,6 +17,8 @@ mapM_ (matchSpec g) unquotingFormatTestsInfo describe "unquotes url() <string>s" $ mapM_ (matchSpec g) unquotingUrlsTestsInfo+ describe "Converts escaped characters properly" $+ mapM_ (matchSpec convertEscaped) escapedCharConversionTestsInfo where f = minifyWithTestConfig <$> stringvalue g = minifyWithTestConfig <$> textualvalue @@ -29,6 +32,25 @@ "'\\22'", "'\"'") ,("Don't convert escaped double quotes when enclosed in double quotes", "\"\\22\"", "\"\\22\"")+ ]++escapedCharConversionTestsInfo :: [(Text, Text)]+escapedCharConversionTestsInfo =+ [("", "")+ ,("\\", "\\")+ ,("\\0", "\NUL")+ ,("\\2a", "*")+ ,("\\02a", "*")+ ,("\\002a", "*")+ ,("\\0002a", "*")+ ,("\\00002a", "*")+ ,("\\00002aa", "*a")+ ,("*\\00002aa", "**a")+ ,("*\\2az", "**z")++ -- This is one more than than Char's maxBound, i.e. out of Unicode's range,+ -- and thus cannot be converted.+ ,("\\110000", "\\110000") ] unquotingUrlsTestsInfo :: [(Text, Text)]
tests/Hasmin/Types/StylesheetSpec.hs view
@@ -18,8 +18,15 @@ combineAdjacentMediaQueriesTestsInfo :: [(Text, Text)] combineAdjacentMediaQueriesTestsInfo =- [("@media all and (min-width:24rem){.Fz\\(s2\\)\\@xs{font-size:1.2rem;}}@media all and (min-width: 24rem){.Px\\(s04\\)\\@xs{padding-left:.25rem; padding-right:.25rem;}}",- "@media all and (min-width:24rem){.Fz\\(s2\\)\\@xs{font-size:1.2rem}.Px\\(s04\\)\\@xs{padding-left:.25rem;padding-right:.25rem}}")+ [("@media (min-width:24rem){.Fz\\(s2\\)\\@xs{font-size:1.2rem;}}@media (min-width:24rem){.Px\\(s04\\)\\@xs{padding-left:.25rem; padding-right:.25rem;}}",+ "@media (min-width:24rem){.Fz\\(s2\\)\\@xs{font-size:1.2rem}.Px\\(s04\\)\\@xs{padding-left:.25rem;padding-right:.25rem}}")+++ {- TODO make Eq instance handle this equality.+ -+ ,("@media all and (min-width:24rem){.Fz\\(s2\\)\\@xs{font-size:1.2rem;}}@media (min-width:24rem){.Px\\(s04\\)\\@xs{padding-left:.25rem; padding-right:.25rem;}}",+ "@media (min-width:24rem){.Fz\\(s2\\)\\@xs{font-size:1.2rem}.Px\\(s04\\)\\@xs{padding-left:.25rem;padding-right:.25rem}}")+ -} ] atRuleTests :: Spec@@ -28,7 +35,41 @@ mapM_ (matchSpec atRule) atRuleTestsInfo describe "@supports minification" $ mapM_ (matchSpec (minifyWithTestConfig <$> atRule)) atSupportsTestInfo+ describe "@import minification" $+ mapM_ (matchSpec (minifyWithTestConfig <$> atRule)) atImportTestInfo+ describe "@media minification" $+ mapM_ (matchSpec (minifyWithTestConfig <$> atRule)) atMediaTestInfo +atMediaTestInfo :: [(Text, Text)]+atMediaTestInfo =+ [("@media all {h1{color:red}}",+ "@media {h1{color:red}}")+ ,("@media all and (min-width: 500px){h1 {color: red}}",+ "@media (min-width:500px){h1{color:red}}")+ ,("@media not all{h1{color:red}}",+ "@media not all{h1{color:red}}")+ ,("@media all and (min-width:500px), not all and (min-device-pixel-ratio:0){h1{a:a}}",+ "@media (min-width:500px),not all and (min-device-pixel-ratio:0){h1{a:a}}")+ ,("@media (min-width:500px),all and (min-device-pixel-ratio:0){h1{a:a}}",+ "@media (min-width:500px),(min-device-pixel-ratio:0){h1{a:a}}")+ ,("@media only all{h1{a:a}}",+ "@media only all{h1{a:a}}")+ ]++atImportTestInfo :: [(Text, Text)]+atImportTestInfo =+ [("@import url(\'landscape.css\');",+ "@import \"landscape.css\";")+ ,("@import url(landscape.css);",+ "@import \"landscape.css\";")+ ,("@import url(landscape.css) all;",+ "@import \"landscape.css\";")+ ,("@import url(landscape.css) screen, all and (min-width:500px);",+ "@import \"landscape.css\" screen,(min-width:500px);")+ ,("@import url(landscape.css) all and (min-width:500px);",+ "@import \"landscape.css\" (min-width:500px);")+ ]+ mergeRulesTest :: Spec mergeRulesTest = describe "Rules merging" $@@ -94,6 +135,12 @@ "@supports (a:a){s{b:b}}") ] +-- TODO test for+{-+.gallery-loading .gallery-loading-container {+ background: #fff url("//corporate-website-test.s3.amazonaws.com/wp-content/themes/ggs-rcw/img/spinner_white_125px.gif") no-repeat center center;+}+-} atRuleTestsInfo :: [(Text, Text)] atRuleTestsInfo = [("@charset \"UTF-8\";",