diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ For a full list of changes, see the history on [GitHub](https://github.com/hapytex/css-selectors). +## Version 0.4.0.0 + +All css items are now a member of the `Generic` and the `Hashable` typeclass. + ## Version 0.3.0.0 The css items are now an instance of `Binary` and can be serialized and deserialized; and compressed. One diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -129,17 +129,21 @@ is often useful, since javascript itself has no syntax for css selectors, and often strings are used to represent these. -## `Binary` instances - -The css-elements are all a member of the `Binary` typeclass, that converts the -css selector to a compact binary format. This is *not* standard format. This is -more to write a css-selector to a binary format and back. - ## `Arbitrary` css selectors One can generate arbitrary CSS selectors (and their subcomponents). It is however not advisable to use this for anything other than for validation purposes (like with `QuickCheck`). + +## `Binary` and `Hashable` instances + +The css-elements are all members of the `Binary` and `Hashable` typeclasses, +The `Binary` typeclass converts the css selector to a compact binary format. +This is *not* standard format. This is more to write a css-selector to a +binary format and back. + +css-elements are an instance of `Hashable` as well, for example to use as +keys in a `HashMap`. ## `css-selectors` is not *safe* Haskell diff --git a/css-selectors.cabal b/css-selectors.cabal --- a/css-selectors.cabal +++ b/css-selectors.cabal @@ -1,5 +1,5 @@ name: css-selectors -version: 0.3.0.0 +version: 0.4.0.0 synopsis: Parsing, rendering and manipulating css selectors in Haskell. description: A library for parsing, manipulating, and rendering css selectors (not css files, @@ -48,6 +48,7 @@ , bytestring >=0.9 , data-default >=0.7 && <0.8 , Decimal >=0.5.1 && <0.5.2 + , hashable >=1.2.7.0 , QuickCheck >=2.13 && <2.14 , shakespeare >=2.0 && <3.0 , template-haskell >=2.12.0 && <2.16.0 @@ -66,6 +67,7 @@ base , binary >=0.2 && <0.8.8.0 , css-selectors + , hashable >=1.2.7.0 , text , test-framework , test-framework-quickcheck2 diff --git a/src/Css3/Selector/Core.hs b/src/Css3/Selector/Core.hs --- a/src/Css3/Selector/Core.hs +++ b/src/Css3/Selector/Core.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, PatternSynonyms, TemplateHaskellQuotes, TypeFamilies #-} +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings, PatternSynonyms, TemplateHaskellQuotes, TypeFamilies #-} {-| Module : Css3.Selector.Core @@ -52,6 +52,7 @@ import Data.Data(Data) import Data.Default(Default(def)) import Data.Function(on) +import Data.Hashable(Hashable) import Data.List(sort, unfoldr) import Data.List.NonEmpty(NonEmpty((:|))) import qualified Data.List.NonEmpty @@ -61,6 +62,7 @@ import Data.Text(Text, cons, inits, intercalate, pack, tails, unpack) import GHC.Exts(IsList(Item, fromList, toList)) +import GHC.Generics(Generic) import Language.Haskell.TH.Lib(appE, conE) import Language.Haskell.TH.Syntax(Lift(lift), Exp(AppE, ConE, LitE), Lit(StringL), Name, Pat(ConP, ListP, ViewP), Q) @@ -77,10 +79,12 @@ -- -- The specificity is calculated with @100*a+10*b+c@ where @a@, @b@ and @c@ -- count certain elements of the css selector. -data SelectorSpecificity = - SelectorSpecificity Int Int Int -- ^ Create a 'SelectorSpecificity' object with a given value for @a@, @b@, and @c@. - deriving (Data, Show) +data SelectorSpecificity + = SelectorSpecificity Int Int Int -- ^ Create a 'SelectorSpecificity' object with a given value for @a@, @b@, and @c@. + deriving (Data, Generic, Show) +instance Hashable SelectorSpecificity + -- | Calculate the specificity value of the 'SelectorSpecificity' specificityValue :: SelectorSpecificity -- ^ The 'SelectorSpecificity' to calculate the specificity value from. -> Int -- ^ The specificity level of the 'SelectorSpecificity'. If the value is higher, the rules in the css selector take precedence. @@ -152,24 +156,30 @@ -- selectors. newtype SelectorGroup = SelectorGroup { unSelectorGroup :: NonEmpty Selector -- ^ Unwrap the given 'NonEmpty' list of 'Selector's from the 'SelectorGroup' object. - } deriving (Data, Eq, Ord, Show) + } deriving (Data, Eq, Generic, Ord, Show) +instance Hashable SelectorGroup + -- | The type of a single selector. This is a sequence of 'SelectorSequence's that -- are combined with a 'SelectorCombinator'. data Selector = Selector SelectorSequence -- ^ Convert a given 'SelectorSequence' to a 'Selector'. | Combined SelectorSequence SelectorCombinator Selector -- ^ Create a combined selector where we have a 'SelectorSequence' that is combined with a given 'SelectorCombinator' to a 'Selector'. - deriving (Data, Eq, Ord, Show) + deriving (Data, Eq, Generic, Ord, Show) +instance Hashable Selector + -- | A type that contains the possible ways to combine 'SelectorSequence's. data SelectorCombinator = Descendant -- ^ The second tag is a descendant of the first one, denoted in css with a space. | Child -- ^ The second tag is the (direct) child of the first one, denoted with a @>@ in css. | DirectlyPreceded -- ^ The second tag is directly preceded by the first one, denoted with a @+@ in css. | Preceded -- ^ The second tag is preceded by the first one, denoted with a @~@ in css. - deriving (Bounded, Data, Enum, Eq, Ord, Read, Show) + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show) +instance Hashable SelectorCombinator + -- | Convert the 'SelectorCombinator' to the equivalent css selector text. A -- space for 'Descendant', a @>@ for 'Child', a @+@ for 'DirectlyPreceded', and -- a @~@ for 'Preceded' @@ -213,8 +223,10 @@ data SelectorSequence = SimpleSelector TypeSelector -- ^ Convert a 'TypeSelector' into a 'SimpleSelector'. | Filter SelectorSequence SelectorFilter -- ^ Apply an additional 'SelectorFilter' to the 'SelectorSequence'. - deriving (Data, Eq, Ord, Show) + deriving (Data, Eq, Generic, Ord, Show) +instance Hashable SelectorSequence + -- | Add a given list of 'SelectorFilter's to the given 'SelectorSequence'. The -- filters are applied left-to-right. addFilters :: SelectorSequence -- ^ The 'SelectorSequence' to apply the filter on. @@ -248,16 +260,20 @@ SHash Hash -- ^ A 'Hash' object as filter. | SClass Class -- ^ A 'Class' object as filter. | SAttrib Attrib -- ^ An 'Attrib' object as filter. - deriving (Data, Eq, Ord, Show) + deriving (Data, Eq, Generic, Ord, Show) +instance Hashable SelectorFilter + -- | A css attribute can come in two flavors: either a constraint that the -- attribute should exists, or a constraint that a certain attribute should have -- a certain value (prefix, suffix, etc.). data Attrib = Exist AttributeName -- ^ A constraint that the given 'AttributeName' should exist. | Attrib AttributeName AttributeCombinator AttributeValue -- ^ A constraint about the value associated with the given 'AttributeName'. - deriving (Data, Eq, Ord, Show) + deriving (Data, Eq, Generic, Ord, Show) +instance Hashable Attrib + -- | A flipped version of the 'Attrib' data constructor, where one first -- specifies the conbinator, then the 'AttributeName' and finally the value. attrib :: AttributeCombinator -- ^ The 'AttributeCombinator' that specifies the required relation between the attribute and a value. @@ -334,8 +350,10 @@ data Namespace = NAny -- ^ A typeselector part that specifies that we accept all namespaces, in css denoted with @*@. | Namespace Text -- ^ A typselector part that specifies that we accept a certain namespace name. - deriving (Data, Eq, Ord, Show) + deriving (Data, Eq, Generic, Ord, Show) +instance Hashable Namespace + -- | The empty namespace. This is /not/ the wildcard namespace (@*@). This is a -- bidirectional namespace and can thus be used in expressions as well. pattern NEmpty :: Namespace @@ -346,22 +364,28 @@ data ElementName = EAny -- ^ A typeselector part that specifies that we accept all element names, in css denoted with @*@. | ElementName Text -- ^ A typeselector part that specifies that we accept a certain element name. - deriving (Data, Eq, Ord, Show) + deriving (Data, Eq, Generic, Ord, Show) +instance Hashable ElementName + -- | A typeselector is a combination of a selector for a namespace, and a -- selector for an element name. One, or both can be a wildcard. data TypeSelector = TypeSelector { selectorNamespace :: Namespace, -- ^ The selector for the namespace. elementName :: ElementName -- ^ The selector for the element name. - } deriving (Data, Eq, Ord, Show) + } deriving (Data, Eq, Generic, Ord, Show) +instance Hashable TypeSelector + -- | An attribute name is a name that optionally has a namespace, and the name -- of the attribute. data AttributeName = AttributeName { attributeNamespace :: Namespace, -- ^ The namespace to which the attribute name belongs. This can be 'NAny' as well. attributeName :: Text -- ^ The name of the attribute over which we make a claim. - } deriving (Data, Eq, Ord, Show) + } deriving (Data, Eq, Generic, Ord, Show) +instance Hashable AttributeName + -- | We use 'Text' as the type to store an attribute value. type AttributeValue = Text @@ -374,19 +398,25 @@ | PrefixMatch -- ^ The value is a prefix of the value in the attribute, denoted with @^=@ in css. | SuffixMatch -- ^ The value is a suffix of the value in the attribute, denoted with @$=@ in css. | SubstringMatch -- ^The value is a substring of the value in the attribute, denoted with @*=@ in css. - deriving (Bounded, Data, Enum, Eq, Ord, Read, Show) + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show) +instance Hashable AttributeCombinator + -- | A css class, this is wrapped in a data type. The type only wraps the class -- name, not the dot prefix. newtype Class = Class { unClass :: Text -- ^ Obtain the name from the class. - } deriving (Data, Eq, Ord, Show) + } deriving (Data, Eq, Generic, Ord, Show) +instance Hashable Class + -- | A css hash (used to match an element with a given id). The type only wraps -- the hash name, not the hash (@#@) prefix. newtype Hash = Hash { unHash :: Text -- ^ Obtain the name from the hash. - } deriving (Data, Eq, Ord, Show) + } deriving (Data, Eq, Generic, Ord, Show) + +instance Hashable Hash -- | Convert the given 'AttributeCombinator' to its css selector counterpart. attributeCombinatorText :: AttributeCombinator -- ^ The 'AttributeCombinator' for which we obtain the corresponding css selector text. diff --git a/src/Css3/Selector/Utils.hs b/src/Css3/Selector/Utils.hs --- a/src/Css3/Selector/Utils.hs +++ b/src/Css3/Selector/Utils.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE Safe #-} + {-| Module : Css3.Selector.Utils Description : A set of utility methods to encode and decode strings. diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,6 +5,7 @@ import Data.Binary(Binary, encode, decode) import Data.Function(on) +import Data.Hashable(Hashable(hashWithSalt)) import Data.Text(pack, unpack) import Test.Framework (defaultMain, testGroup) @@ -70,8 +71,20 @@ testProperty "Binary uniqness: attribute name" (uniqnessEncoding @AttributeName), testProperty "Binary uniqness: class" (uniqnessEncoding @Class), testProperty "Binary uniqness: hash" (uniqnessEncoding @Hash) + ], + testGroup "Check hash constraint for the Hashable instances" [ + testProperty "Different hash implies different items: selector group" (hashingDifferent @SelectorGroup), + testProperty "Different hash implies different items: selector" (hashingDifferent @Selector), + testProperty "Different hash implies different items: selector sequence" (hashingDifferent @SelectorSequence), + testProperty "Different hash implies different items: selector filter" (hashingDifferent @SelectorFilter), + testProperty "Different hash implies different items: namespace" (hashingDifferent @Namespace), + testProperty "Different hash implies different items: element name" (hashingDifferent @ElementName), + testProperty "Different hash implies different items: type selector" (hashingDifferent @TypeSelector), + testProperty "Different hash implies different items: attribute" (hashingDifferent @Attrib), + testProperty "Different hash implies different items: attribute name" (hashingDifferent @AttributeName), + testProperty "Different hash implies different items: class" (hashingDifferent @Class), + testProperty "Different hash implies different items: hash" (hashingDifferent @Hash) ] - ] encodeDecode :: Char -> String -> Bool @@ -85,6 +98,9 @@ binaryEquivalent :: (Binary a, Eq a, ToCssSelector a) => a -> Bool binaryEquivalent x = decode (encode x) == x + +hashingDifferent :: (Hashable a, Eq a) => Int -> a -> a -> Bool +hashingDifferent slt xa xb = (hashWithSalt slt xa == hashWithSalt slt xb) || (xa /= xb) uniqnessEncoding :: (Binary a, Eq a, ToCssSelector a) => a -> a -> Bool uniqnessEncoding ca cb = (encode ca == encode cb) == (ca == cb)