stylist 2.0.0.0 → 2.2.0.0
raw patch · 8 files changed
+108/−22 lines, 8 files
Files
- src/Data/CSS/Preprocessor/PsuedoClasses.hs +1/−2
- src/Data/CSS/Preprocessor/Text.hs +3/−1
- src/Data/CSS/Style/Cascade.hs +1/−1
- src/Data/CSS/Style/Selector/Interpret.hs +13/−7
- src/Data/CSS/Style/Selector/LowerWhere.hs +13/−9
- src/Data/CSS/StyleTree.hs +16/−1
- stylist.cabal +1/−1
- test/Test.hs +60/−0
src/Data/CSS/Preprocessor/PsuedoClasses.hs view
@@ -112,5 +112,4 @@ addRewrite "readonly" "[readonly], [disabled]" & addRewrite "read-write" ":not([readonly]):not([disabled])" & addRewrite "required" "[required]" &- addRewrite "root" "html" &- addRewrite "scope" "html"+ addRewrite "scope" ":root"
src/Data/CSS/Preprocessor/Text.hs view
@@ -54,7 +54,9 @@ shorthand self "white-space" [Ident val] | val `elem` ["normal", "pre", "pre-wrap", "pre-line"] = [("white-space", [Ident val])] | otherwise = shorthand (inner self) "white-space" [Ident val]- shorthand self key value = shorthand (inner self) key $ removeCounters value+ shorthand TextStyle { inner = s } k v+ | Just _ <- longhand s s k $ removeCounters v = [(k, v)]+ | otherwise = shorthand s k v longhand _ self "counter-reset" value = (\v -> self {counterReset = v}) <$> parseCounters 0 value longhand _ self "counter-increment" value = (\v -> self {counterIncrement = v}) <$> parseCounters 1 value
src/Data/CSS/Style/Cascade.hs view
@@ -38,7 +38,7 @@ setVars _ = id -- | Gather properties into a hashmap.-data TrivialPropertyParser = TrivialPropertyParser (HashMap String [Token])+data TrivialPropertyParser = TrivialPropertyParser (HashMap String [Token]) deriving (Show, Eq) instance PropertyParser TrivialPropertyParser where temp = TrivialPropertyParser empty longhand _ (TrivialPropertyParser self) key value =
src/Data/CSS/Style/Selector/Interpret.hs view
@@ -21,7 +21,7 @@ type SelectorFunc = Element -> Bool type AttrsFunc = [Attribute] -> Bool -- Mostly here for the sake of pseudoclasses.-data IL = Tagname Text | NS Text | Fail | Recursive Bool [Selector] | Nth Bool Integer Integer+data IL = Tagname Text | NS Text | Fail | Recursive Bool [Selector] | Nth Bool Integer Integer | Root -- | Converts a parsed CSS selector into a callable function. compile :: Selector -> SelectorFunc@@ -34,15 +34,16 @@ compileInner :: [SimpleSelector] -> SelectorFunc compileInner sel = compileInner' $ lowerInner sel compileInner' :: ([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc-compileInner' ((Tagname tag:tests), attrs) = testTag tag $ compileInner' (tests, attrs)-compileInner' ((NS ns:tests), attrs) = testNS ns $ compileInner' (tests, attrs)-compileInner' ((Fail:_), _) = \_ -> False-compileInner' ((Recursive negate' sels:tests), attrs) =+compileInner' (Tagname tag:tests, attrs) = testTag tag $ compileInner' (tests, attrs)+compileInner' (NS ns:tests, attrs) = testNS ns $ compileInner' (tests, attrs)+compileInner' (Fail:_, _) = \_ -> False+compileInner' (Recursive negate' sels:tests, attrs) = recursiveSelect negate' (map compile sels) $ compileInner' (tests, attrs)-compileInner' ((Nth ofType n 0:tests), attrs) =+compileInner' (Nth ofType n 0:tests, attrs) = nthChild ofType (fromInteger n) $ compileInner' (tests, attrs)-compileInner' ((Nth ofType a b:tests), attrs) =+compileInner' (Nth ofType a b:tests, attrs) = nthChild' ofType (fromInteger a) (fromInteger b) $ compileInner' (tests, attrs)+compileInner' (Root:tests, attrs) = testRoot $ compileInner' (tests, attrs) compileInner' ([], attrs) = testAttrs (compileAttrs $ sortAttrs attrs) matched compileAttrs :: [(Text, Maybe Text, String -> Bool)] -> AttrsFunc compileAttrs ((tag, Nothing, test):attrs) = testAttr tag test $ compileAttrs attrs@@ -66,6 +67,7 @@ (parseNth False (filter (== Whitespace) args):tests, attrs) where (tests, attrs) = lowerInner s lowerInner (Psuedoclass "nth-of-type" args:s) = (parseNth True (filter (== Whitespace) args):tests, attrs) where (tests, attrs) = lowerInner s+lowerInner (Psuedoclass "root" []:s) = (Root:tests, attrs) where (tests, attrs) = lowerInner s lowerInner (Psuedoclass c []:s) = (tests, ("", Nothing, hasWord $ unpack c):attrs) where (tests, attrs) = lowerInner s lowerInner (Psuedoclass _ _:_) = ([Fail], [])@@ -154,6 +156,10 @@ maybeStar :: (t -> Maybe t) -> t -> [t] maybeStar cb x | Just y <- cb x = x : maybeStar cb y | otherwise = [x]++testRoot :: (Element -> Bool) -> Element -> Bool+testRoot cb el | Just _ <- parent el = cb el+ | otherwise = False -------- ---- RuleStore wrapper --------
src/Data/CSS/Style/Selector/LowerWhere.hs view
@@ -6,12 +6,14 @@ import Data.CSS.Syntax.Selector import Data.CSS.Style.Common -lowerSelector :: Selector -> Selector-lowerSelector (Element sel) = Element $ lowerSelector' sel-lowerSelector (Child sel x) = Child (lowerSelector sel) x-lowerSelector (Descendant sel x) = Descendant (lowerSelector sel) x-lowerSelector (Adjacent sel x) = Adjacent (lowerSelector sel) x-lowerSelector (Sibling sel x) = Sibling (lowerSelector sel) x+lowerSelector :: Selector -> [Selector]+lowerSelector (Element [Psuedoclass c args])+ | c `elem` ["is", "where"], (args', []) <- parseSelectors args = args'+lowerSelector (Element sel) = [Element $ lowerSelector' sel]+lowerSelector (Child sel x) = [Child sel' $ lowerSelector' x | sel' <- lowerSelector sel]+lowerSelector (Descendant sel x) = [Descendant sel' $ lowerSelector' x | sel' <- lowerSelector sel]+lowerSelector (Adjacent sel x) = [Adjacent sel' $ lowerSelector' x | sel' <- lowerSelector sel]+lowerSelector (Sibling sel x) = [Sibling sel' $ lowerSelector' x | sel' <- lowerSelector sel] lowerSelector' :: [SimpleSelector] -> [SimpleSelector] lowerSelector' (Psuedoclass c args:sel)@@ -25,8 +27,10 @@ instance RuleStore s => RuleStore (WhereLowerer s) where new = WhereLowerer new addStyleRule (WhereLowerer self) priority rule =- WhereLowerer $ addStyleRule self priority $ rule {- inner = StyleRule (lowerSelector sel) props psuedo+ WhereLowerer $ foldl addStyleRule' self $ lowerSelector sel+ where+ addStyleRule' self' sel' = addStyleRule self' priority $ rule {+ inner = StyleRule sel' props psuedo }- where StyleRule sel props psuedo = inner rule+ StyleRule sel props psuedo = inner rule lookupRules (WhereLowerer self) el = lookupRules self el
src/Data/CSS/StyleTree.hs view
@@ -1,7 +1,8 @@ -- | Abstracts away tree traversals. -- Mostly used by callers including (soon) XML Conduit Stylist, -- but also used internally for generating counter text.-module Data.CSS.StyleTree(StyleTree(..), treeOrder, treeOrder', Path, treeMap, treeFlatten) where+module Data.CSS.StyleTree(StyleTree(..), treeOrder, treeOrder',+ Path, treeMap, treeFlatten, preorder, preorder', postorder) where data StyleTree p = StyleTree { style :: p,@@ -33,3 +34,17 @@ treeFlatten' (StyleTree p []:ps) = p : treeFlatten' ps treeFlatten' (StyleTree _ childs:sibs) = treeFlatten' childs ++ treeFlatten' sibs treeFlatten' [] = []++preorder :: (Maybe b -> Maybe b -> a -> b) -> StyleTree a -> StyleTree b+preorder cb self = head $ preorder' cb Nothing Nothing [self]+preorder' :: (Maybe b -> Maybe b -> a -> b) ->+ Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b]+preorder' cb parent previous (self:sibs) = let self' = cb parent previous $ style self+ in StyleTree self' (preorder' cb (Just self') Nothing $ children self) :+ preorder' cb parent (Just self') sibs+preorder' _ _ _ [] = []++postorder :: (a -> [b] -> [b]) -> StyleTree a -> [StyleTree b]+postorder cb (StyleTree self childs) =+ [StyleTree self' children' | self' <- cb self $ Prelude.map style children']+ where children' = concat $ Prelude.map (postorder cb) childs
stylist.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 2.0.0.0+version: 2.2.0.0 -- A short (one-line) description of the package. synopsis: Apply CSS styles to a document tree.
test/Test.hs view
@@ -15,9 +15,11 @@ import Data.CSS.Style.Selector.Index import Data.CSS.Style.Selector.Interpret import Data.CSS.Style+import Data.CSS.StyleTree import Data.CSS.Preprocessor.Conditions import Data.CSS.Preprocessor.Conditions.Expr (Datum(..), Op(..), parse', eval)+import qualified Data.CSS.Preprocessor.Text as Txt main :: IO () main = hspec spec@@ -444,6 +446,64 @@ let styles = parse conditional "@import url(about:style.css) screen;" extractImports' styles `shouldBe` [] -- TODO @supports is harder to test++ describe "CSS Counters" $ do+ it "Propagates other properties" $ do+ let textStyle = temp :: Txt.TextStyle TrivialPropertyParser+ let textStyle1 = fromJust $ longhand temp textStyle "foo" [Ident "bar"]+ style (Txt.resolve $ StyleTree textStyle1 []) `shouldBe`+ TrivialPropertyParser (fromList [("foo", [Ident "bar"])])++ let textStyle2 = fromJust $ longhand temp textStyle1 "counter-reset" [Ident "heading"]+ style (Txt.resolve $ StyleTree textStyle2 []) `shouldBe`+ TrivialPropertyParser (fromList [("foo", [Ident "bar"])])++ let textStyle3 = fromJust $ longhand temp textStyle2 "counter-set" [Ident "heading"]+ style (Txt.resolve $ StyleTree textStyle3 []) `shouldBe`+ TrivialPropertyParser (fromList [("foo", [Ident "bar"])])++ let textStyle4 = fromJust $ longhand temp textStyle3 "counter-increment" [Ident "heading"]+ style (Txt.resolve $ StyleTree textStyle4 []) `shouldBe`+ TrivialPropertyParser (fromList [("foo", [Ident "bar"])])++ let textStyle5 = fromJust $ longhand temp textStyle4 "white-space" [Ident "normal"]+ style (Txt.resolve $ StyleTree textStyle5 []) `shouldBe`+ TrivialPropertyParser (fromList [("foo", [Ident "bar"]), ("white-space", [Ident "normal"])])++ let textStyle6 = fromJust $ longhand temp textStyle4 "white-space" [Ident "pre"]+ style (Txt.resolve $ StyleTree textStyle6 []) `shouldBe`+ TrivialPropertyParser (fromList [("foo", [Ident "bar"]), ("white-space", [Ident "nowrap"])])++ let textStyle7 = fromJust $ longhand temp textStyle4 "white-space" [Ident "nowrap"]+ style (Txt.resolve $ StyleTree textStyle7 []) `shouldBe`+ TrivialPropertyParser (fromList [("foo", [Ident "bar"]), ("white-space", [Ident "nowrap"])])++ let textStyle8 = fromJust $ longhand temp textStyle4 "white-space" [Ident "pre-wrap"]+ style (Txt.resolve $ StyleTree textStyle8 []) `shouldBe`+ TrivialPropertyParser (fromList [("foo", [Ident "bar"]), ("white-space", [Ident "normal"])])++ let textStyle9 = fromJust $ longhand temp textStyle4 "white-space" [Ident "pre-line"]+ style (Txt.resolve $ StyleTree textStyle9 []) `shouldBe`+ TrivialPropertyParser (fromList [("foo", [Ident "bar"]), ("white-space", [Ident "normal"])])++ it "Inserts counters" $ do+ let textStyle = temp :: Txt.TextStyle TrivialPropertyParser+ shorthand textStyle "content" [Function "counter", Ident "-rhaps-ol", RightParen] `shouldBe`+ [("content", [Function "counter", Ident "-rhaps-ol", RightParen])]+ shorthand textStyle "content" [Function "counters", Ident "-rhaps-ol", Comma, String ".", RightParen] `shouldBe`+ [("content", [Function "counters", Ident "-rhaps-ol", Comma, String ".", RightParen])]++ let textStyle1 = fromJust $ longhand temp textStyle "content" [Function "counter", Ident "-rhaps-ol", RightParen]+ style (Txt.resolve $ StyleTree textStyle1 []) `shouldBe` TrivialPropertyParser (fromList [("content", [])])++ let textStyle2 = fromJust $ longhand temp textStyle1 "counter-reset" [Ident "-rhaps-ol"]+ style (Txt.resolve $ StyleTree textStyle2 []) `shouldBe` TrivialPropertyParser (fromList [("content", [String "0"])])++ let textStyle3 = fromJust $ longhand temp textStyle1 "counter-set" [Ident "-rhaps-ol"]+ style (Txt.resolve $ StyleTree textStyle3 []) `shouldBe` TrivialPropertyParser (fromList [("content", [String "0"])])++ let textStyle4 = fromJust $ longhand temp textStyle1 "counter-increment" [Ident "-rhaps-ol"]+ style (Txt.resolve $ StyleTree textStyle4 []) `shouldBe` TrivialPropertyParser (fromList [("content", [String "1"])]) styleIndex :: StyleIndex styleIndex = new