From 9e7ce5e0276deb36fd859380d5ad1f0683108825 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Mon, 17 Jun 2019 16:27:52 +1200 Subject: [PATCH] Expose common interface above all selector passes. --- src/Stylish/Style/Selector/Common.hs | 30 +++++++++++++++++++++++ src/Stylish/Style/Selector/Index.hs | 28 ++++++++++++--------- src/Stylish/Style/Selector/Interpret.hs | 16 +++++++++++- src/Stylish/Style/Selector/Specificity.hs | 16 +++++++++++- test/Test.hs | 9 ++++--- 5 files changed, 81 insertions(+), 18 deletions(-) create mode 100644 src/Stylish/Style/Selector/Common.hs diff --git a/src/Stylish/Style/Selector/Common.hs b/src/Stylish/Style/Selector/Common.hs new file mode 100644 index 0000000..89c4125 --- /dev/null +++ b/src/Stylish/Style/Selector/Common.hs @@ -0,0 +1,30 @@ +module Stylish.Style.Selector.Common( + RuleStore(..), StyleRule'(..), selector, properties, styleRule' + ) where + +import Stylish.Element +import Stylish.Parse + +class RuleStore a where + addStyleRule :: a -> Int -> StyleRule' -> a + lookupRules :: a -> Element -> [StyleRule'] + +type SelectorFunc = Element -> Bool +data StyleRule' = StyleRule' { + inner :: StyleRule, + compiledSelector :: SelectorFunc, + rank :: (Int, (Int, Int, Int), Int) -- This reads ugly, but oh well. +} +styleRule' rule = StyleRule' { + inner = rule, + compiledSelector = \_ -> True, + rank = (0, (0, 0, 0), 0) +} + +instance Eq StyleRule' where + a == b = inner a == inner b +instance Show StyleRule' where show a = show $ inner a +instance Ord StyleRule' where compare x y = rank x `compare` rank y + +selector rule | StyleRule selector _ <- inner rule = selector +properties rule | StyleRule _ properties <- inner rule = properties diff --git a/src/Stylish/Style/Selector/Index.hs b/src/Stylish/Style/Selector/Index.hs index 5ba9a02..250cde6 100644 --- a/src/Stylish/Style/Selector/Index.hs +++ b/src/Stylish/Style/Selector/Index.hs @@ -9,14 +9,15 @@ import Data.HashMap.Strict import Data.List (nub) import Stylish.Parse import Stylish.Element +import Stylish.Style.Selector.Common import Data.Hashable import Data.Text (unpack, pack) import Data.Text.Internal (Text(..)) data StyleIndex = StyleIndex { - indexed :: HashMap SimpleSelector [StyleRule], - unindexed :: [StyleRule] + indexed :: HashMap SimpleSelector [StyleRule'], + unindexed :: [StyleRule'] } styleIndex = StyleIndex {indexed = empty, unindexed = []} @@ -24,9 +25,19 @@ styleIndex = StyleIndex {indexed = empty, unindexed = []} lookup' :: SimpleSelector -> HashMap SimpleSelector [a] -> [a] lookup' = lookupDefault [] -instance StyleSheet StyleIndex where - addRule self (StyleRule _ []) = self - addRule self rule@(StyleRule selector _) = addRuleForSelector self rule $ simpleSelector selector +instance RuleStore StyleIndex where + addStyleRule self _ rule | [] == properties rule = self + | otherwise = addRuleForSelector self rule $ simpleSelector $ selector rule + lookupRules self element = nub $ Prelude.foldr (++) [] rules + where + get key = lookup' key index + index = indexed self + rules = unindexed self : Prelude.map get (testsForElement element) + +rulesForElement :: StyleIndex -> Element -> [StyleRule] -- For testing +rulesForElement self element = Prelude.map inner $ lookupRules self element + +--- simpleSelector (Element s) = s simpleSelector (Child _ s) = s @@ -48,13 +59,6 @@ selectorKey (Property prop _ : _) = Property prop Exists ---- -rulesForElement :: StyleIndex -> Element -> [StyleRule] -rulesForElement self element = nub $ Prelude.foldr (++) [] rules - where - get key = lookup' key index - index = indexed self - rules = unindexed self : Prelude.map get (testsForElement element) - testsForElement :: Element -> [SimpleSelector] testsForElement element = (Tag $ name element) : (testsForAttributes $ attributes element) diff --git a/src/Stylish/Style/Selector/Interpret.hs b/src/Stylish/Style/Selector/Interpret.hs index 36574b1..c700d88 100644 --- a/src/Stylish/Style/Selector/Interpret.hs +++ b/src/Stylish/Style/Selector/Interpret.hs @@ -1,10 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module Stylish.Style.Selector.Interpret( - compile, SelectorFunc(..) + compile, SelectorFunc(..), + InterpretedRuleStore(..) ) where import Stylish.Parse.Selector import Stylish.Element +import Stylish.Style.Selector.Common import Data.Text.Internal (Text(..)) import Data.Text (unpack) @@ -75,3 +77,15 @@ testAttr _ _ _ [] = False hasWord expected value = expected `elem` words value hasLang expected value = expected == value || isPrefixOf (expected ++ "-") value + +-------- +---- RuleStore wrapper +-------- +data InterpretedRuleStore inner = InterpretedRuleStore inner +instance RuleStore inner => RuleStore (InterpretedRuleStore inner) where + addStyleRule (InterpretedRuleStore self) priority rule = + InterpretedRuleStore $ addStyleRule self priority $ rule { + compiledSelector = compile $ selector rule + } + lookupRules (InterpretedRuleStore self) el = filter call $ lookupRules self el + where call (StyleRule' _ test _) = test el diff --git a/src/Stylish/Style/Selector/Specificity.hs b/src/Stylish/Style/Selector/Specificity.hs index 48da647..0b9d6f0 100644 --- a/src/Stylish/Style/Selector/Specificity.hs +++ b/src/Stylish/Style/Selector/Specificity.hs @@ -1,8 +1,10 @@ module Stylish.Style.Selector.Specificity( - computeSpecificity + OrderedRuleStore ) where import Stylish.Parse.Selector +import Stylish.Style.Selector.Common +import Data.List computeSpecificity :: Selector -> (Int, Int, Int) computeSpecificity (Element selector) = computeSpecificity' selector @@ -19,3 +21,15 @@ computeSpecificity' [] = (0, 0, 0) add :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int) add (a, b, c) (x, y, z) = (a + x, b + y, c + z) + +--- + +data OrderedRuleStore inner = OrderedRuleStore inner Int + +instance RuleStore inner => RuleStore (OrderedRuleStore inner) where + addStyleRule (OrderedRuleStore self count) priority rule = OrderedRuleStore ( + addStyleRule self priority $ rule { + rank = (priority, computeSpecificity $ selector rule, count) + } + ) (count + 1) + lookupRules (OrderedRuleStore self _) el = sort $ lookupRules self el diff --git a/test/Test.hs b/test/Test.hs index 2fbf122..acc47d4 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -10,6 +10,7 @@ import Stylish.Style.Selector.Index import Stylish.Element import Stylish.Style.Selector.Interpret import Stylish.Style.Selector.Specificity +import Stylish.Style.Selector.Common main = hspec spec @@ -73,7 +74,7 @@ spec = do ] describe "Style Index" $ do it "Retrieves appropriate styles" $ do - let index = addRule styleIndex sampleRule + let index = addStyleRule styleIndex 0 $ styleRule' sampleRule let element = ElementNode { name = "a", parent = Nothing, @@ -94,17 +95,17 @@ spec = do rulesForElement index element2 `shouldBe` [] let rule = StyleRule (Element [Class "external"]) [("color", [Ident "green"])] - let index = addRule styleIndex rule + let index = addStyleRule styleIndex 0 $ styleRule' rule rulesForElement index element `shouldBe` [rule] rulesForElement index element2 `shouldBe` [] let rule = StyleRule (Element [Id "mysite"]) [("color", [Ident "green"])] - let index = addRule styleIndex rule + let index = addStyleRule styleIndex 0 $ styleRule' rule rulesForElement index element `shouldBe` [rule] rulesForElement index element2 `shouldBe` [] let rule = StyleRule (Element [Property "href" $ Prefix "https://"]) [("color", [Ident "green"])] - let index = addRule styleIndex rule + let index = addStyleRule styleIndex 0 $ styleRule' rule rulesForElement index element `shouldBe` [rule] rulesForElement index element2 `shouldBe` [] describe "Selector Compiler" $ do -- 2.30.2