css-selectors 0.4.0.3 → 0.5.0.0
raw patch · 9 files changed
+1370/−176 lines, 9 filesdep +data-default-classdep +deepseqdep −data-defaultPVP ok
version bump matches the API change (PVP)
Dependencies added: data-default-class, deepseq
Dependencies removed: data-default
API changes (from Hackage documentation)
+ Css3.Selector.Core: (.::) :: SelectorSequence -> PseudoElement -> PseudoSelectorSequence
+ Css3.Selector.Core: (.@) :: SelectorSequence -> [SelectorFilter] -> SelectorSequence
+ Css3.Selector.Core: (:.::) :: SelectorSequence -> PseudoElement -> PseudoSelectorSequence
+ Css3.Selector.Core: Active :: PseudoClass
+ Css3.Selector.Core: After :: PseudoElement
+ Css3.Selector.Core: Before :: PseudoElement
+ Css3.Selector.Core: Checked :: PseudoClass
+ Css3.Selector.Core: Default :: PseudoClass
+ Css3.Selector.Core: Disabled :: PseudoClass
+ Css3.Selector.Core: Empty :: PseudoClass
+ Css3.Selector.Core: Enabled :: PseudoClass
+ Css3.Selector.Core: FirstLetter :: PseudoElement
+ Css3.Selector.Core: FirstLine :: PseudoElement
+ Css3.Selector.Core: Focus :: PseudoClass
+ Css3.Selector.Core: Fullscreen :: PseudoClass
+ Css3.Selector.Core: Hover :: PseudoClass
+ Css3.Selector.Core: InRange :: PseudoClass
+ Css3.Selector.Core: Indeterminate :: PseudoClass
+ Css3.Selector.Core: Invalid :: PseudoClass
+ Css3.Selector.Core: Lang :: Language -> PseudoClass
+ Css3.Selector.Core: Link :: PseudoClass
+ Css3.Selector.Core: Marker :: PseudoElement
+ Css3.Selector.Core: NAttrib :: Attrib -> Negation
+ Css3.Selector.Core: NClass :: Class -> Negation
+ Css3.Selector.Core: NHash :: Hash -> Negation
+ Css3.Selector.Core: NPseudo :: PseudoClass -> Negation
+ Css3.Selector.Core: NPseudoElement :: PseudoElement -> Negation
+ Css3.Selector.Core: NTypeSelector :: TypeSelector -> Negation
+ Css3.Selector.Core: Nth :: Int -> Int -> Nth
+ Css3.Selector.Core: NthChild :: Nth -> PseudoClass
+ Css3.Selector.Core: NthLastChild :: Nth -> PseudoClass
+ Css3.Selector.Core: NthLastOfType :: Nth -> PseudoClass
+ Css3.Selector.Core: NthOfType :: Nth -> PseudoClass
+ Css3.Selector.Core: OnlyChild :: PseudoClass
+ Css3.Selector.Core: OnlyOfType :: PseudoClass
+ Css3.Selector.Core: Optional :: PseudoClass
+ Css3.Selector.Core: OutOfRange :: PseudoClass
+ Css3.Selector.Core: Placeholder :: PseudoElement
+ Css3.Selector.Core: ReadOnly :: PseudoClass
+ Css3.Selector.Core: ReadWrite :: PseudoClass
+ Css3.Selector.Core: Required :: PseudoClass
+ Css3.Selector.Core: Root :: PseudoClass
+ Css3.Selector.Core: SNot :: Negation -> SelectorFilter
+ Css3.Selector.Core: SPseudo :: PseudoClass -> SelectorFilter
+ Css3.Selector.Core: Selection :: PseudoElement
+ Css3.Selector.Core: Sequence :: SelectorSequence -> PseudoSelectorSequence
+ Css3.Selector.Core: Target :: PseudoClass
+ Css3.Selector.Core: Valid :: PseudoClass
+ Css3.Selector.Core: Visited :: PseudoClass
+ Css3.Selector.Core: [constant] :: Nth -> Int
+ Css3.Selector.Core: [linear] :: Nth -> Int
+ Css3.Selector.Core: data Negation
+ Css3.Selector.Core: data Nth
+ Css3.Selector.Core: data PseudoClass
+ Css3.Selector.Core: data PseudoElement
+ Css3.Selector.Core: data PseudoSelectorSequence
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.Attrib
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.AttributeCombinator
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.AttributeName
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.Class
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.ElementName
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.Hash
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.Namespace
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.Selector
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.SelectorCombinator
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.SelectorFilter
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.SelectorGroup
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.SelectorSequence
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.SelectorSpecificity
+ Css3.Selector.Core: instance Control.DeepSeq.NFData Css3.Selector.Core.TypeSelector
+ Css3.Selector.Core: instance Css3.Selector.Core.ToCssSelector Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance Css3.Selector.Core.ToCssSelector Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance Css3.Selector.Core.ToCssSelector Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance Css3.Selector.Core.ToCssSelector Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance Data.Aeson.Types.ToJSON.ToJSON Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance Data.Aeson.Types.ToJSON.ToJSON Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance Data.Aeson.Types.ToJSON.ToJSON Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance Data.Aeson.Types.ToJSON.ToJSON Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance Data.Binary.Class.Binary Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance Data.Binary.Class.Binary Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance Data.Binary.Class.Binary Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance Data.Binary.Class.Binary Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance Data.Binary.Class.Binary Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance Data.Data.Data Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance Data.Data.Data Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance Data.Data.Data Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance Data.Data.Data Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance Data.Data.Data Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance Data.Default.Class.Default Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance Data.Default.Class.Default Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance Data.Hashable.Class.Hashable Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance Data.Hashable.Class.Hashable Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance Data.Hashable.Class.Hashable Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance Data.Hashable.Class.Hashable Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance Data.Hashable.Class.Hashable Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance Data.String.IsString (Css3.Selector.Core.Nth -> Css3.Selector.Core.PseudoClass)
+ Css3.Selector.Core: instance Data.String.IsString Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance Data.String.IsString Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance GHC.Classes.Eq Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance GHC.Classes.Eq Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance GHC.Classes.Eq Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance GHC.Classes.Eq Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance GHC.Classes.Eq Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance GHC.Classes.Ord Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance GHC.Classes.Ord Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance GHC.Classes.Ord Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance GHC.Classes.Ord Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance GHC.Classes.Ord Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance GHC.Enum.Bounded Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance GHC.Enum.Enum Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance GHC.Generics.Generic Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance GHC.Generics.Generic Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance GHC.Generics.Generic Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance GHC.Generics.Generic Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance GHC.Generics.Generic Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance GHC.Read.Read Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance GHC.Read.Read Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance GHC.Read.Read Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance GHC.Show.Show Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance GHC.Show.Show Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance GHC.Show.Show Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance GHC.Show.Show Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance GHC.Show.Show Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance Language.Haskell.TH.Syntax.Lift Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance Language.Haskell.TH.Syntax.Lift Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance Language.Haskell.TH.Syntax.Lift Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance Language.Haskell.TH.Syntax.Lift Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance Language.Haskell.TH.Syntax.Lift Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance Test.QuickCheck.Arbitrary.Arbitrary Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance Test.QuickCheck.Arbitrary.Arbitrary Css3.Selector.Core.Nth
+ Css3.Selector.Core: instance Test.QuickCheck.Arbitrary.Arbitrary Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance Test.QuickCheck.Arbitrary.Arbitrary Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance Test.QuickCheck.Arbitrary.Arbitrary Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance Text.Blaze.ToMarkup Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance Text.Blaze.ToMarkup Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance Text.Blaze.ToMarkup Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance Text.Blaze.ToMarkup Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: instance Text.Julius.ToJavascript Css3.Selector.Core.Negation
+ Css3.Selector.Core: instance Text.Julius.ToJavascript Css3.Selector.Core.PseudoClass
+ Css3.Selector.Core: instance Text.Julius.ToJavascript Css3.Selector.Core.PseudoElement
+ Css3.Selector.Core: instance Text.Julius.ToJavascript Css3.Selector.Core.PseudoSelectorSequence
+ Css3.Selector.Core: normalizeNth :: Nth -> Nth
+ Css3.Selector.Core: nthContainsValue :: Nth -> Int -> Bool
+ Css3.Selector.Core: nthIsEmpty :: Nth -> Bool
+ Css3.Selector.Core: nthValues :: Nth -> [Int]
+ Css3.Selector.Core: nthValues0 :: Nth -> [Int]
+ Css3.Selector.Core: nthValues1 :: Nth -> [Int]
+ Css3.Selector.Core: pattern Even :: Nth
+ Css3.Selector.Core: pattern FirstChild :: PseudoClass
+ Css3.Selector.Core: pattern FirstOfType :: PseudoClass
+ Css3.Selector.Core: pattern LastChild :: PseudoClass
+ Css3.Selector.Core: pattern LastOfType :: PseudoClass
+ Css3.Selector.Core: pattern Odd :: Nth
+ Css3.Selector.Core: pattern One :: Nth
+ Css3.Selector.Core: type Language = Text
- Css3.Selector.Core: (.:) :: SelectorSequence -> [SelectorFilter] -> SelectorSequence
+ Css3.Selector.Core: (.:) :: SelectorSequence -> PseudoClass -> SelectorSequence
- Css3.Selector.Core: Combined :: SelectorSequence -> SelectorCombinator -> Selector -> Selector
+ Css3.Selector.Core: Combined :: PseudoSelectorSequence -> SelectorCombinator -> Selector -> Selector
- Css3.Selector.Core: Selector :: SelectorSequence -> Selector
+ Css3.Selector.Core: Selector :: PseudoSelectorSequence -> Selector
Files
- CHANGELOG.md +4/−0
- README.md +27/−14
- css-selectors.cabal +3/−2
- src/Css3/Selector/Core.hs +716/−40
- src/Css3/Selector/Lexer.x +186/−38
- src/Css3/Selector/Parser.y +86/−27
- src/Css3/Selector/QuasiQuoters.hs +4/−1
- src/Css3/Selector/Utils.hs +1/−1
- test/Spec.hs +343/−53
CHANGELOG.md view
@@ -2,6 +2,10 @@ For a full list of changes, see the history on [GitHub](https://github.com/hapytex/css-selectors). +## Version 0.5.0.0++Added pseudo-elements and pseudo-classes. The `Binary` instances are updated and *not* backedwards compatible.+ ## Version 0.4.0.0 All css items are now a member of the `Generic` and the `Hashable` typeclass.
README.md view
@@ -10,10 +10,8 @@ It has a *quasiquoter* to enable Haskell to validate the css selector at compile time. -Currently the css grammar is implemented *without* the pseudo-classes,-pseudo-elements and negations. One can furthermore calculate the specificity of-a css-selector, and thus perform an analysis over what css-selector will take-precedence.+One can furthermore calculate the specificity of a css-selector, and thus+perform an analysis over what css-selector will take precedence. The package documentation can be found on the [GitHub pages](https://hapytex.github.io/css-selectors/). @@ -25,24 +23,39 @@ *comma-separated*; 2. A `Selector` is a custom linked list implementation where the "cons" (the `Combined` data constructor) contains a besides a reference to a- `SelectorSequence` (head) and a `Selector` (tail), it specifies what- `SelectorCombinator` is used. A `Selector` has at least one- `SelectorSequence`, this is constructoed with the `Selector` data+ `PseudoSelectorSequence` (head) and a `Selector` (tail), it specifies what+ `PseudoSelectorCombinator` is used. A `Selector` has at least one+ `PseudoSelectorSequence`, this is constructoed with the `Selector` data constructor;- 3. A `SelectorSequence` contains a `TypeSelector` (in case the `TypeSelector`+ 3. A `PseudoSelectorSequence` is a `Selector` sequence with an *optional* `PseudoElement`, that+ pseudo element is written at the end of the `PseudoSelectorSequence` when specified in the CSS+ selector;+ 4. A `SelectorSequence` contains a `TypeSelector` (in case the `TypeSelector` is `Universal`, this does not need to be part of the css-selector expression); and a set of zero or more `SelectorFilter`s;- 4. A `SelectorFilter` is a `Hash`, a `Class`, or an `Attrib`;- 5. Both a `TypeSelector` and an `AttributeName` have a namespace. A namespace+ 5. A `SelectorFilter` is a `Hash`, a `Class`, `Attrib`, `PseudoClass`, or a `Negation`;+ 6. Both a `TypeSelector` and an `AttributeName` have a namespace. A namespace can be any (`*`), empty, or a namespace (which should be a valid identifier);- 6. A `Hash` is a valid identifier prepended with a number sign (`#`);- 7. A `Class` is a valid identifier prepended with a dot (`.`);- 8. An `Attribute` can be an `Exist` object that imposes a constraint that the+ 7. A `Hash` is a valid identifier prepended with a number sign (`#`);+ 8. A `Class` is a valid identifier prepended with a dot (`.`);+ 9. An `Attribute` can be an `Exist` object that imposes a constraint that the attribute should exist for the given tag, or an `Attrib` that specifies that the attribute exists, and that the value for this attribute satisfies a given constraint. This constraint is determined by the- `AttributeCombinator` and the value of the `Attrib` object.+ `AttributeCombinator` and the value of the `Attrib` object;+ 10. A `Negation` is written in a css selector with `:not(…)`. It can contain a `TypeSelector`, `Hash`,+ `Class` or `PseudoClass`, it can *not* contain a nested `:not(…)`.+ 11. A `PseudoClass` is an identifier after a single colon (`:`). Some pseudo classes+ are functions that are then called with a parameter. For the `:nth-child(…)`, `:nth-last-child(…)`,+ `:nth-last-of-type(…)`, and `:nth-of-type(…)` these functions take an `Nth` as parameter. This+ parameter specifies which childs will be selected. The `:lang(…)` pseudo class+ takes the name of a language, for example `en-US`;+ 12. An `Nth` describes what childs are selected, for example `4n+2`, this is used as a function+ parameter for the `NthChild`, `NthLastChild`, `NthLastOfType` and `NthOfType` pseudo classes; and+ 13. A `PseudoElement` is an optional item at the end of a `SelectorSequence`. Usually pseudo elements are+ written with two colons in front, for example `::before` and `::after`. For backwards compatibility,+ these can also be written as `:before` and `:after`. ## Quasiquoter
css-selectors.cabal view
@@ -1,5 +1,5 @@ name: css-selectors-version: 0.4.0.3+version: 0.5.0.0 synopsis: Parsing, rendering and manipulating css selectors in Haskell. description: A library for parsing, manipulating, and rendering css selectors (not css files,@@ -46,8 +46,9 @@ , binary >=0.2 , blaze-markup >=0.8 , bytestring >=0.9- , data-default >=0.7+ , data-default-class >=0.0.1 , Decimal >=0.4.2+ , deepseq >=1.4.3.0 , hashable >=1.2.7.0 , QuickCheck >=2.8 , shakespeare >=2.0
src/Css3/Selector/Core.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, OverloadedStrings, PatternSynonyms, TemplateHaskellQuotes, TypeFamilies #-}+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, OverloadedStrings, PatternSynonyms, TemplateHaskellQuotes, TypeFamilies #-} {-| Module : Css3.Selector.Core@@ -11,15 +11,21 @@ -} module Css3.Selector.Core ( -- * ToCssSelector typeclass- ToCssSelector(..)+ ToCssSelector(toCssSelector, toSelectorGroup, specificity', toPattern, normalize) -- * Selectors and combinators , Selector(..) , SelectorCombinator(..), SelectorGroup(..)+ , PseudoElement(After, Before, FirstLetter, FirstLine, Marker, Placeholder, Selection), PseudoSelectorSequence(Sequence, (:.::)), (.::)+ , PseudoClass(+ Active, Checked, Default, Disabled, Empty, Enabled, Focus, Fullscreen, Hover, Indeterminate, InRange, Invalid, Lang+ , Link, NthChild, NthLastChild, NthLastOfType, NthOfType, OnlyOfType, OnlyChild, Optional, OutOfRange, ReadOnly+ , ReadWrite, Required, Root, Target, Valid, Visited+ ), (.:), pattern FirstChild, pattern FirstOfType, pattern LastChild, pattern LastOfType, Language , SelectorSequence(..) , combinatorText, combine , (.>), (.+), (.~) -- * Filters- , SelectorFilter(..), filters, filters', addFilters, (.:)+ , SelectorFilter(SHash, SClass, SAttrib, SPseudo, SNot), filters, filters', addFilters, (.@) -- * Namespaces , Namespace(..), pattern NEmpty -- * Type selectors@@ -32,6 +38,10 @@ , Class(..), (...) -- * Hashes , Hash(..), (.#)+ -- * Negation+ , Negation(NTypeSelector, NHash, NClass, NAttrib, NPseudo, NPseudoElement)+ -- * Nth items+ , Nth(Nth, linear, constant), pattern Even, pattern Odd, pattern One, nthValues, nthIsEmpty, nthValues0, nthValues1, normalizeNth, nthContainsValue -- * Specificity , SelectorSpecificity(..), specificity, specificityValue -- * Read and write binary content@@ -43,14 +53,16 @@ import Codec.Compression.GZip(CompressParams, compress, compressWith, decompress) import Control.Applicative(liftA2)+import Control.DeepSeq(NFData) import Css3.Selector.Utils(encodeIdentifier, encodeText, toIdentifier) import Data.Aeson(Value(String), ToJSON(toJSON)) import Data.Binary(Binary(put, get), Get, Put, decode, encode, getWord8, putWord8) import Data.ByteString.Lazy(ByteString)+import Data.Char(toLower) import Data.Data(Data)-import Data.Default(Default(def))+import Data.Default.Class(Default(def)) import Data.Function(on) import Data.Hashable(Hashable) import Data.List(sort, unfoldr)@@ -62,22 +74,22 @@ #endif import Data.String(IsString(fromString)) import qualified Data.Text as T-import Data.Text(Text, cons, inits, intercalate, pack, tails, unpack)+import Data.Text(Text, cons, inits, intercalate, pack, snoc, tails, unpack) import GHC.Exts(IsList(Item, fromList, toList)) import GHC.Generics(Generic) import Language.Haskell.TH.Lib(appE, conE) #if MIN_VERSION_template_haskell(2,17,0)-import Language.Haskell.TH.Syntax(Lift(lift, liftTyped), Exp(AppE, ConE, LitE), Lit(StringL), Name, Pat(ConP, ListP, ViewP), Q, unsafeCodeCoerce)+import Language.Haskell.TH.Syntax(Lift(lift, liftTyped), Quote, Exp(AppE, ConE, LitE), Lit(IntegerL, StringL), Name, Pat(ConP, ListP, LitP, ViewP), unsafeCodeCoerce) #elif MIN_VERSION_template_haskell(2,16,0)-import Language.Haskell.TH.Syntax(Lift(lift, liftTyped), Exp(AppE, ConE, LitE), Lit(StringL), Name, Pat(ConP, ListP, ViewP), Q, unsafeTExpCoerce)+import Language.Haskell.TH.Syntax(Lift(lift, liftTyped), Exp(AppE, ConE, LitE), Lit(IntegerL, StringL), Name, Pat(ConP, ListP, LitP, ViewP), Q, unsafeTExpCoerce) #else-import Language.Haskell.TH.Syntax(Lift(lift), Exp(AppE, ConE, LitE), Lit(StringL), Name, Pat(ConP, ListP, ViewP), Q)+import Language.Haskell.TH.Syntax(Lift(lift), Exp(AppE, ConE, LitE), Lit(IntegerL, StringL), Name, Pat(ConP, ListP, LitP, ViewP), Q) #endif import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary, shrink), arbitraryBoundedEnum)-import Test.QuickCheck.Gen(Gen, frequency, listOf, listOf1, oneof)+import Test.QuickCheck.Gen(Gen, elements, frequency, listOf, listOf1, oneof) import Text.Blaze(ToMarkup(toMarkup), text) import Text.Blaze.Internal(Markup)@@ -94,11 +106,101 @@ instance Hashable SelectorSpecificity +instance NFData 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. specificityValue (SelectorSpecificity a b c) = 100*a + 10*b + c +-- | A data type that is used to select children and elements of type with the @:nth-child@, @:nth-last-child@, @:nth-last-of-type@ and @:nth-of-type@.+-- if the 'One' is used as argument, then the pseudo classes are @:first-child@, @:first-of-type@, @:last-child@, and @:last-of-type@.+data Nth+ = Nth {+ linear :: Int -- ^ The linear part of the 'Nth' object: the integral number before the @n@.+ , constant :: Int -- ^ The constant part of the 'Nth' object.+ } deriving (Data, Eq, Generic, Ord, Read, Show)++instance Hashable Nth++instance NFData Nth++-- | Check if the given 'Nth' object contains /no/ items.+nthIsEmpty+ :: Nth -- ^ The given 'Nth' object object to check.+ -> Bool -- ^ 'True' if the given 'Nth' object does /not/ contain any items; 'False' otherwise.+nthIsEmpty (Nth n c) = n <= 0 && c <= 0++-- | Normalize the given 'Nth' object to a normalized one. If and only if the+-- normalized variants are the same of two 'Nth' objects, then these will produce+-- the same list of values. Normalization is idempotent: calling 'normalizeNth'+-- on a normalized 'Nth' will produce the same 'Nth'.+normalizeNth+ :: Nth -- ^ The given 'Nth' item to normalize.+ -> Nth -- ^ The normalized variant of the given 'Nth' object.+normalizeNth nth@(Nth n c)+ | n <= 0 && c + n <= 0 = Nth 0 (max 0 c)+ | n > 0 && c < 0 = let cn = c `mod` n in if cn /= 0 then Nth n cn else Nth n n+ | n > 0 && c == 0 = Nth n n+ | otherwise = nth++-- | Obtain the one-based indices that match the given 'Nth' object. The CSS3 selectors+-- are one-based: the first child has index 1.+nthValues+ :: Nth -- The 'Nth' object that specifies the given range.+ -> [Int] -- ^ A list of one-based indexes that contain the items selected by the 'Nth' object. The list can be infinite.+nthValues (Nth n c)+ | n > 0 && c <= 0 = let {c' = c `mod` n; cn' = c' + n} in (if c' /= 0 then (c':) else id) [cn', cn' + n ..]+ | n > 0 = [c, c+n ..]+ | n < 0 = [ c, c+n .. 1 ]+ | otherwise = [c | c > 0]++-- | Check if the given 'Nth' object contains a given value.+nthContainsValue+ :: Nth -- ^ The given 'Nth' object that specifies a sequence.+ -> Int -- ^ The given index for which we check if it is contained in the given 'Nth' object.+ -> Bool -- ^ This function returns 'True' if the given item is a member of the given 'Nth' sequence; 'False' otherwise.+nthContainsValue (Nth 0 c) i = c == i && i > 0+nthContainsValue (Nth n c) i = i > 0 && (i - c) `div` n >= 0 && (i - c) `mod` n == 0++-- | Obtain the one-based indices that match the given 'Nth' object. The CSS3 selectors+-- are one-based: the first child has index 1. This is an alias of the 'nthValues' function.+nthValues1+ :: Nth -- The 'Nth' object that specifies the given range.+ -> [Int] -- ^ A list of zero-based indexes that contain the items selected by the 'Nth' object. The list can be infinite.+nthValues1 = nthValues++-- | Obtain the zero-based indices that match the given 'Nth' object. One can use this for list/vector processing since+-- the CSS3 selectors start with index 1. The 'nthValues1' can be used for one-based indexes.+nthValues0+ :: Nth -- The 'Nth' object that specifies the given range.+ -> [Int] -- ^ A list of zero-based indexes that contain the items selected by the 'Nth' object. The list can be infinite.+nthValues0 = map (subtract 1) . nthValues++-- | A pattern synonym that is used in CSS to specify a sequence that starts with two and each time increases with two.+pattern Even :: Nth+pattern Even = Nth 2 0++-- | A pattern synonym that is used in CSS to specify a sequence that starts with one and each time increases with two.+pattern Odd :: Nth+pattern Odd = Nth 2 1++-- | An 'Nth' item that spans a collection with only @1@ as value. This is used to transform @:nth-child@ to @:first-child@ for example.+pattern One :: Nth+pattern One = Nth 0 1++-- | Convert the given 'Nth' object to text used by the CSS selector.+nthToText+ :: Nth -- ^ The 'Nth' object for which we determine the textual presentation.+ -> Text -- ^ The textual presentation of the 'Nth' object in a CSS selector.+nthToText Even = "even"+nthToText Odd = "odd"+nthToText (Nth n 0) = snoc (pack (show n)) 'n'+nthToText (Nth 0 b) = pack (show b)+nthToText (Nth n b)+ | b <= 0 = pack (show n ++ 'n' : show b)+ | otherwise = pack (show n ++ 'n' : '+' : show b)+ -- | A class that defines that the given type can be converted to a css selector -- value, and has a certain specificity. class ToCssSelector a where@@ -169,15 +271,18 @@ instance Hashable SelectorGroup +instance NFData 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'.+ Selector PseudoSelectorSequence -- ^ Convert a given 'SelectorSequence' to a 'Selector'.+ | Combined PseudoSelectorSequence SelectorCombinator Selector -- ^ Create a combined selector where we have a 'SelectorSequence' that is combined with a given 'SelectorCombinator' to a 'Selector'. deriving (Data, Eq, Generic, Ord, Show) instance Hashable Selector +instance NFData Selector -- | A type that contains the possible ways to combine 'SelectorSequence's. data SelectorCombinator =@@ -189,6 +294,8 @@ instance Hashable SelectorCombinator +instance NFData SelectorCombinator+ -- | Convert the 'SelectorCombinator' to the equivalent css selector text. A -- space for 'Descendant', a @>@ for 'Child', a @+@ for 'DirectlyPreceded', and -- a @~@ for 'Preceded'@@ -236,6 +343,27 @@ instance Hashable SelectorSequence +instance NFData SelectorSequence++-- | A 'SelectorSequence' with an optional 'PseudoElement' at the end. Each /element/ of a 'Selector' can+-- have /at most/ one 'PseudoElement'.+data PseudoSelectorSequence+ = Sequence SelectorSequence -- ^ A data constructor where there is no optional 'PseudoElement' involved.+ | SelectorSequence :.:: PseudoElement -- ^ A data constructor for a 'SelectorSequence' with a 'PseudoElement'.+ deriving (Data, Eq, Generic, Ord, Show)++instance Hashable PseudoSelectorSequence++instance NFData PseudoSelectorSequence++-- | Add a given 'PseudoElement' to the given 'SelectorSequence' to produce a 'PseudoSelectorSequence'. Since+-- a 'PseudoElement' is an instance of 'IsString', this can thus be used to combine string literals.+(.::)+ :: SelectorSequence -- ^ The given 'SelectorSequence' to which we add the pseudo element.+ -> PseudoElement -- ^ The given 'PseudoElement' to add to the 'SelectorSequence'.+ -> PseudoSelectorSequence -- ^ The corresponding 'PseudoSelectorSequence'.+(.::) = (:.::)+ -- | 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.@@ -244,10 +372,10 @@ addFilters = foldl Filter -- | An infix variant of the 'addFilters' function.-(.:) :: SelectorSequence -- ^ The 'SelectorSequence' to apply the filter on.+(.@) :: SelectorSequence -- ^ The 'SelectorSequence' to apply the filter on. -> [SelectorFilter] -- ^ The list of 'SelectorFilter's to apply on the 'SelectorSequence'. -> SelectorSequence -- ^ A modified 'SelectorSequence' where we applied the list of 'SelectorFilter's.-(.:) = addFilters+(.@) = addFilters -- | Obtain the list of filters that are applied in the given 'SelectorSequence' -- in /reversed/ order.@@ -265,14 +393,34 @@ -- | A type that sums up the different ways to filter a type selector: with an -- id (hash), a class, and an attribute.-data SelectorFilter =- SHash Hash -- ^ A 'Hash' object as filter.+data SelectorFilter+ = SHash Hash -- ^ A 'Hash' object as filter. | SClass Class -- ^ A 'Class' object as filter. | SAttrib Attrib -- ^ An 'Attrib' object as filter.+ | SPseudo PseudoClass -- ^ A 'PseudoClass' object as filter.+ | SNot Negation -- ^ A @:not(…)@ clause that contains a simple selector to negate. deriving (Data, Eq, Generic, Ord, Show) instance Hashable SelectorFilter +instance NFData SelectorFilter++-- | A data type that contains all possible items that can be used in a @:not(…)@ clause.+-- Since a @:not(…)@ cannot be nested in another @:not(…)@, we see an 'SNot' as a special+-- case, and not as a 'PseudoClass'.+data Negation+ = NTypeSelector TypeSelector -- ^ A 'TypeSelector' for the @:not(…)@ clause.+ | NHash Hash -- ^ A 'Hash' for the @:not(…)@ clause.+ | NClass Class -- ^ A 'Class' for the @:not(…)@ clause.+ | NAttrib Attrib -- ^ An 'Attrib' for the @:not(…)@ clause.+ | NPseudo PseudoClass -- ^ A 'PseudoClass' for the @:not(…)@ clause.+ | NPseudoElement PseudoElement -- ^ A 'PseudoElement' for the @:not(…)@ clause.+ deriving (Data, Eq, Generic, Ord, Show)++instance Hashable Negation++instance NFData Negation+ -- | 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.).@@ -283,6 +431,8 @@ instance Hashable Attrib +instance NFData 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.@@ -353,6 +503,12 @@ -> TypeSelector -- ^ A 'TypeSelector' object constructed with the 'Namespace' and 'ElementName'. (.|) = TypeSelector +-- | Filter a given 'SelectorSequence' with a given 'PseudoClass'.+(.:) :: SelectorSequence -- ^ The given 'SelectorSequence' to filter.+ -> PseudoClass -- ^ The given 'PseudoClass' to filter the 'SelectorSequence' further.+ -> SelectorSequence -- ^ A 'SelectorSequence' that is filtered additionally with the given 'PseudoClass'.+(.:) = (. SPseudo) . Filter+ -- | The namespace of a css selector tag. The namespace can be 'NAny' (all -- possible namespaces), or a namespace with a given text (this text can be -- empty).@@ -363,6 +519,8 @@ instance Hashable Namespace +instance NFData 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@@ -377,6 +535,8 @@ instance Hashable ElementName +instance NFData 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 {@@ -386,6 +546,8 @@ instance Hashable TypeSelector +instance NFData TypeSelector+ -- | An attribute name is a name that optionally has a namespace, and the name -- of the attribute. data AttributeName = AttributeName {@@ -395,9 +557,14 @@ instance Hashable AttributeName +instance NFData AttributeName+ -- | We use 'Text' as the type to store an attribute value. type AttributeValue = Text +-- | We use 'Text' to specify the language in the @:lang(…)@ pseudo class.+type Language = Text+ -- | The possible ways to match an attribute with a given value in a css -- selector. data AttributeCombinator =@@ -411,6 +578,87 @@ instance Hashable AttributeCombinator +instance NFData AttributeCombinator++-- | A data type that contains the possible pseudo classes. In a CSS selector+-- the pseudo classes are specified with a single colon, for example @:active@.+-- These filter on the /state/ of the items. A full list of pseudo classes+-- is available <https://www.w3schools.com/css/css_pseudo_classes.asp here>.+data PseudoClass+ = Active -- ^ The @:active@ pseudo class.+ | Checked -- ^ The @:checked@ pseudo class.+ | Default -- ^ The @:default@ pseudo class.+ | Disabled -- ^ The @:disabled@ pseudo class.+ | Empty -- ^ The @:empty@ pseudo class.+ | Enabled -- ^ The @:enabled@ pseudo class.+ | Focus -- ^ The @:focus@ pseudo class.+ | Fullscreen -- ^ The @:fullscreen@ pseudo class.+ | Hover -- ^ The @:hover@ pseudo class.+ | Indeterminate -- ^ The @:indeterminate@ pseudo class.+ | InRange -- ^ The @:in-range@ pseudo class.+ | Invalid -- ^ The @:invalid@ pseudo class.+ | Lang Language -- ^ The @:lang(…)@ pseudo class, the language parameter is at the moment a 'Text' object, but only uppercase, lowercase and hyphens are characters that can be parsed.+ | Link -- ^ The @:link@ pseudo class.+ | NthChild Nth -- ^ The @:nth-child(…)@ pseudo class, if the 'Nth' parameter is 'One', then it is equivalent to @:first-child@.+ | NthLastChild Nth -- ^ The @:nth-last-child(…)@ pseudo class, if the 'Nth' parameter is 'One', then it is equivalent to @:last-child@.+ | NthLastOfType Nth -- ^ The @:nth-last-of-type(…)@ pseudo class, if the 'Nth' parameter is 'One', then it is equivalent to @:last-of-type@.+ | NthOfType Nth -- ^ The @:nth-of-type(…)@ pseudo class, if the 'Nth' parameter is 'One', then it is equivalent to @:first-of-type@.+ | OnlyOfType -- ^ The @:only-of-type@ pseudo class.+ | OnlyChild -- ^ The @:only-child@ pseudo class.+ | Optional -- ^ The @:optional@ pseudo class.+ | OutOfRange -- ^ The @:out-of-range@ pseudo class.+ | ReadOnly -- ^ The @:read-only@ pseudo class.+ | ReadWrite -- ^ The @:rad-write@ pseudo class.+ | Required -- ^ The @:required@ pseudo class.+ | Root -- ^ The @:root@ pseudo class.+ | Target -- ^ The @:target@ pseudo class.+ | Valid -- ^ The @:valid@ pseudo class.+ | Visited -- ^ The @:visited@ pseudo class.+ deriving (Data, Eq, Generic, Ord, Read, Show)++instance Hashable PseudoClass++instance NFData PseudoClass++-- | A pattern synonym for @:nth-child(1)@. If @NthChild (Nth 0 1)@ is used, then+-- this will render as @:first-child@.+pattern FirstChild :: PseudoClass+pattern FirstChild = NthChild One++-- | A pattern synonym for @:nth-of-type(1)@. If @NthOfType (Nth 0 1)@ is used, then+-- this will render as @:first-of-type@.+pattern FirstOfType :: PseudoClass+pattern FirstOfType = NthOfType One++-- | A pattern synonym for @:nth-last-child(1)@. If @NthLastChild (Nth 0 1)@ is used, then+-- this will render as @:last-child@.+pattern LastChild :: PseudoClass+pattern LastChild = NthLastChild One++-- | A pattern synonym for @:nth-last-of-type(1)@. If @NthLastOfType (Nth 0 1)@ is used, then+-- this will render as @:last-of-type@.+pattern LastOfType :: PseudoClass+pattern LastOfType = NthLastOfType One++-- | An enum type that contains the possible /pseudo elements/. A pseudo+-- element is specified by two colon characters (@::@), followed by the name of+-- the pseudo element. The 'After', 'Before', 'FirstLine' and 'FirstLetter'+-- can be written with a single colon for backwards compatibility with+-- CSS 1 and CSS 2.+data PseudoElement+ = After -- ^ The @::after@ pseudo-elements can be used to describe generated content after an element’s content.+ | Before -- ^ The @::before@ pseudo-element can be used to describe generated content before an element’s content.+ | FirstLetter -- ^ The @::first-line@ pseudo-element describes the contents of the first formatted line of an element.+ | FirstLine -- ^ The @::first-letter@ pseudo-element represents the first letter of an element, if it is not preceded by any other content (such as images or inline tables) on its line.+ | Marker -- ^ The @::marker@ pseudo-element selects the markers of list items.+ | Placeholder -- ^ The @::placeholder@ pseudo-element selects form elements with placeholder text, and let you style the placeholder text.+ | Selection -- ^ The @::selection@ pseudo-element matches the portion of an element that is selected by a user.+ deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show)++instance Hashable PseudoElement++instance NFData PseudoElement+ -- | A css class, this is wrapped in a data type. The type only wraps the class -- name, not the dot prefix. newtype Class = Class {@@ -419,6 +667,8 @@ instance Hashable Class +instance NFData 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 {@@ -427,6 +677,8 @@ instance Hashable Hash +instance NFData Hash+ -- | Convert the given 'AttributeCombinator' to its css selector counterpart. attributeCombinatorText :: AttributeCombinator -- ^ The 'AttributeCombinator' for which we obtain the corresponding css selector text. -> AttributeValue -- ^ The css selector text for the given 'AttributeCombinator'.@@ -498,6 +750,59 @@ instance IsString Attrib where fromString = Exist . fromString +instance IsString PseudoClass where+ fromString = go . map toLower+ where go "active" = Active+ go "checked" = Checked+ go "default" = Default+ go "disabled" = Disabled+ go "empty" = Empty+ go "enabled" = Enabled+ go "first-child" = FirstChild+ go "first-of-type" = FirstOfType+ go "focus" = Focus+ go "fullscreen" = Fullscreen+ go "hover" = Hover+ go "indeterminate" = Indeterminate+ go "in-range" = InRange+ go "invalid" = Invalid+ go "last-child" = LastChild+ go "last-of-type" = LastOfType+ go "link" = Link+ -- items with :lang(...) and :...(nth)+ go "only-of-type" = OnlyOfType+ go "only-child" = OnlyChild+ go "optional" = Optional+ go "out-of-range" = OutOfRange+ go "read-only"= ReadOnly+ go "read-write" = ReadWrite+ go "required" = Required+ go "root" = Root+ go "target" = Target+ go "valid" = Valid+ go "visited" = Visited+ go x = error ("The pseudo class \"" ++ x ++ "\" is not a valid pseudo class.")++instance IsString ((->) Nth PseudoClass) where+ fromString = go . map toLower+ where go "nth-child" = NthChild+ go "nth-last-child" = NthLastChild+ go "nth-last-of-type" = NthLastOfType+ go "nth-of-type" = NthLastOfType+ go x = error ("There is no pseudo class \"" ++ x ++ "\" that takes an Nth object as parameter.")++instance IsString PseudoElement where+ fromString = go . map toLower+ where go "after" = After+ go "before" = Before+ go "first-letter" = FirstLetter+ go "first-line" = FirstLine+ go "marker" = Marker+ go "placeholder" = Placeholder+ go "selection" = Selection+ go x = error ("The pseudo element \"" ++ x ++ "\" is not a valid pseudo element.")++ -- IsList instances instance IsList SelectorGroup where type Item SelectorGroup = Selector@@ -509,29 +814,41 @@ _textToPattern t = ViewP (AppE (ConE '(==)) (AppE (ConE 'pack) (LitE (StringL (unpack t))))) (_constantP 'True) _constantP :: Name -> Pat-_constantP = flip ConP []+#if MIN_VERSION_template_haskell(2,18,0)+_constantP = flip (`ConP` []) []+#else+_constantP = (`ConP` [])+#endif +_conP :: Name -> [Pat] -> Pat+#if MIN_VERSION_template_haskell(2,18,0)+_conP = (`ConP` [])+#else+_conP = ConP+#endif++ instance ToCssSelector SelectorGroup where toCssSelector (SelectorGroup g) = intercalate " , " (map toCssSelector (toList g)) toSelectorGroup = id specificity' (SelectorGroup g) = foldMap specificity' g- toPattern (SelectorGroup g) = ConP 'SelectorGroup [go g]- where go (x :| xs) = ConP '(:|) [toPattern x, ListP (map toPattern xs)]+ toPattern (SelectorGroup g) = _conP 'SelectorGroup [go g]+ where go (x :| xs) = _conP '(:|) [toPattern x, ListP (map toPattern xs)] normalize (SelectorGroup g) = SelectorGroup (Data.List.NonEmpty.sort (normalize <$> g)) instance ToCssSelector Class where toCssSelector = cons '.' . encodeIdentifier . unClass toSelectorGroup = toSelectorGroup . SClass specificity' = const (SelectorSpecificity 0 1 0)- toPattern (Class c) = ConP 'Class [_textToPattern c]+ toPattern (Class c) = _conP 'Class [_textToPattern c] instance ToCssSelector Attrib where toCssSelector (Exist name) = "[" <> toCssSelector name <> "]" toCssSelector (Attrib name op val) = "[" <> toCssSelector name <> attributeCombinatorText op <> encodeText '"' val <> "]" toSelectorGroup = toSelectorGroup . SAttrib specificity' = const (SelectorSpecificity 0 1 0)- toPattern (Exist name) = ConP 'Exist [toPattern name]- toPattern (Attrib name op val) = ConP 'Attrib [toPattern name, _constantP (go op), _textToPattern val]+ toPattern (Exist name) = _conP 'Exist [toPattern name]+ toPattern (Attrib name op val) = _conP 'Attrib [toPattern name, _constantP (go op), _textToPattern val] where go Exact = 'Exact go Include = 'Include go DashMatch = 'DashMatch@@ -544,13 +861,13 @@ toCssSelector (AttributeName n e) = toCssSelector n <> "|" <> encodeIdentifier e toSelectorGroup = toSelectorGroup . Exist specificity' = mempty- toPattern (AttributeName n a) = ConP 'AttributeName [toPattern n, _textToPattern a]+ toPattern (AttributeName n a) = _conP 'AttributeName [toPattern n, _textToPattern a] instance ToCssSelector Hash where toCssSelector = cons '#' . encodeIdentifier . unHash toSelectorGroup = toSelectorGroup . SHash specificity' = const (SelectorSpecificity 1 0 0)- toPattern (Hash h) = ConP 'Hash [_textToPattern h]+ toPattern (Hash h) = _conP 'Hash [_textToPattern h] instance ToCssSelector Namespace where toCssSelector NAny = "*"@@ -560,16 +877,16 @@ toPattern NAny = _constantP 'NAny -- used to make patterns more readable toPattern NEmpty = _constantP 'NEmpty- toPattern (Namespace t) = ConP 'Namespace [_textToPattern t]+ toPattern (Namespace t) = _conP 'Namespace [_textToPattern t] instance ToCssSelector SelectorSequence where toCssSelector (SimpleSelector s) = toCssSelector s toCssSelector (Filter s f) = toCssSelector s <> toCssSelector f- toSelectorGroup = toSelectorGroup . Selector+ toSelectorGroup = toSelectorGroup . Sequence specificity' (SimpleSelector s) = specificity' s specificity' (Filter s f) = specificity' s <> specificity' f- toPattern (SimpleSelector s) = ConP 'SimpleSelector [toPattern s]- toPattern (Filter s f) = ConP 'Filter [toPattern s, toPattern f]+ toPattern (SimpleSelector s) = _conP 'SimpleSelector [toPattern s]+ toPattern (Filter s f) = _conP 'Filter [toPattern s, toPattern f] normalize = flip go [] where go (Filter s f) = go s . (normalize f:) go (SimpleSelector s) = addFilters (SimpleSelector (normalize s)) . sort@@ -581,7 +898,7 @@ specificity' (TypeSelector _ e) = specificity' e -- we use Universal, to make the generated pattern more convenient to read. toPattern Universal = _constantP 'Universal- toPattern (TypeSelector n t) = ConP 'TypeSelector [toPattern n, toPattern t]+ toPattern (TypeSelector n t) = _conP 'TypeSelector [toPattern n, toPattern t] instance ToCssSelector ElementName where toCssSelector EAny = "*"@@ -590,19 +907,25 @@ specificity' EAny = mempty specificity' (ElementName _) = SelectorSpecificity 0 0 1 toPattern EAny = _constantP 'EAny- toPattern (ElementName e) = ConP 'ElementName [_textToPattern e]+ toPattern (ElementName e) = _conP 'ElementName [_textToPattern e] instance ToCssSelector SelectorFilter where toCssSelector (SHash h) = toCssSelector h toCssSelector (SClass c) = toCssSelector c toCssSelector (SAttrib a) = toCssSelector a+ toCssSelector (SPseudo p) = toCssSelector p+ toCssSelector (SNot n) = toCssSelector n toSelectorGroup = toSelectorGroup . Filter (SimpleSelector Universal) specificity' (SHash h) = specificity' h specificity' (SClass c) = specificity' c specificity' (SAttrib a) = specificity' a- toPattern (SHash h) = ConP 'SHash [toPattern h]- toPattern (SClass c) = ConP 'SClass [toPattern c]- toPattern (SAttrib a) = ConP 'SAttrib [toPattern a]+ specificity' (SPseudo p) = specificity' p+ specificity' (SNot n) = specificity' n -- Selectors inside the negation pseudo-class are counted like any other, but the negation itself does not count as a pseudo-class.+ toPattern (SHash h) = _conP 'SHash [toPattern h]+ toPattern (SClass c) = _conP 'SClass [toPattern c]+ toPattern (SAttrib a) = _conP 'SAttrib [toPattern a]+ toPattern (SPseudo p) = _conP 'SPseudo [toPattern p]+ toPattern (SNot n) = _conP 'SNot [toPattern n] instance ToCssSelector Selector where toCssSelector (Selector s) = toCssSelector s@@ -610,8 +933,8 @@ toSelectorGroup = toSelectorGroup . SelectorGroup . pure specificity' (Selector s) = specificity' s specificity' (Combined s1 _ s2) = specificity' s1 <> specificity' s2- toPattern (Selector s) = ConP 'Selector [toPattern s]- toPattern (Combined s1 c s2) = ConP 'Combined [toPattern s1, _constantP (go c), toPattern s2]+ toPattern (Selector s) = _conP 'Selector [toPattern s]+ toPattern (Combined s1 c s2) = _conP 'Combined [toPattern s1, _constantP (go c), toPattern s2] where go Descendant = 'Descendant go Child = 'Child go DirectlyPreceded = 'DirectlyPreceded@@ -619,6 +942,138 @@ normalize (Selector s) = Selector (normalize s) normalize (Combined s1 c s2) = Combined (normalize s1) c (normalize s2) +instance ToCssSelector PseudoSelectorSequence where+ toCssSelector (Sequence ss) = toCssSelector ss+ toCssSelector (ss :.:: pe)+ | def == ss = toCssSelector pe+ | otherwise = toCssSelector ss <> toCssSelector pe+ toSelectorGroup = toSelectorGroup . Selector+ specificity' (Sequence ss) = specificity' ss+ specificity' (ss :.:: pe) = specificity' ss <> specificity' pe+ toPattern (Sequence ss) = _conP 'Sequence [toPattern ss]+ toPattern (ss :.:: pe) = _conP '(:.::) [toPattern ss, toPattern pe]+ normalize (Sequence ss) = Sequence (normalize ss)+ normalize (ss :.:: pe) = normalize ss :.:: normalize pe++_nthToPat :: Nth -> Pat+_nthToPat (Nth n b) = _conP 'Nth [f n, f b]+ where f = LitP . IntegerL . fromIntegral++instance ToCssSelector PseudoClass where+ toCssSelector = cons ':' . go+ where go Active = "active"+ go Checked = "checked"+ go Default = "default"+ go Disabled = "disabled"+ go Empty = "empty"+ go Enabled = "enabled"+ go Focus = "focus"+ go Fullscreen = "fullscreen"+ go Hover = "hover"+ go Indeterminate = "indeterminate"+ go InRange = "in-range"+ go Invalid = "invalid"+ go Link = "link"+ go (Lang l) = "lang(" <> l <> ")"+ go FirstChild = "first-child"+ go (NthChild nth) = "nth-child(" <> nthToText nth <> ")"+ go LastChild = "last-child"+ go (NthLastChild nth) = "nth-last-child(" <> nthToText nth <> ")"+ go LastOfType = "last-of-type"+ go (NthLastOfType nth) = "nth-last-of-type(" <> nthToText nth <> ")"+ go FirstOfType = "first-of-type"+ go (NthOfType nth) = "nth-of-type(" <> nthToText nth <> ")"+ go OnlyOfType = "only-of-type"+ go OnlyChild = "only-child"+ go Optional = "optional"+ go OutOfRange = "out-of-range"+ go ReadOnly = "read-only"+ go ReadWrite = "read-write"+ go Required = "required"+ go Root = "root"+ go Target = "target"+ go Valid = "valid"+ go Visited = "visited"++ specificity' = const (SelectorSpecificity 0 1 0)+ toSelectorGroup = toSelectorGroup . SPseudo+ toPattern Active = _constantP 'Active+ toPattern Checked = _constantP 'Checked+ toPattern Default = _constantP 'Default+ toPattern Disabled = _constantP 'Disabled+ toPattern Empty = _constantP 'Empty+ toPattern Enabled = _constantP 'Enabled+ toPattern Focus = _constantP 'Focus+ toPattern Fullscreen = _constantP 'Fullscreen+ toPattern Hover = _constantP 'Hover+ toPattern Indeterminate = _constantP 'Indeterminate+ toPattern InRange = _constantP 'InRange+ toPattern Invalid = _constantP 'Invalid+ toPattern Link = _constantP 'Link+ toPattern (Lang l) = _conP 'Lang [_textToPattern l]+ toPattern (NthChild nth) = _conP 'NthChild [_nthToPat nth]+ toPattern (NthLastChild nth) = _conP 'NthLastChild [_nthToPat nth]+ toPattern (NthLastOfType nth) = _conP 'NthLastOfType [_nthToPat nth]+ toPattern (NthOfType nth) = _conP 'NthOfType [_nthToPat nth]+ toPattern OnlyOfType = _constantP 'OnlyOfType+ toPattern OnlyChild = _constantP 'OnlyChild+ toPattern Optional = _constantP 'Optional+ toPattern OutOfRange = _constantP 'OutOfRange+ toPattern ReadOnly = _constantP 'ReadOnly+ toPattern ReadWrite = _constantP 'ReadWrite+ toPattern Required = _constantP 'Required+ toPattern Root = _constantP 'Root+ toPattern Target = _constantP 'Target+ toPattern Valid = _constantP 'Valid+ toPattern Visited = _constantP 'Visited+ normalize (NthChild nth) = NthChild (normalizeNth nth)+ normalize (NthLastChild nth) = NthLastChild (normalizeNth nth)+ normalize (NthLastOfType nth) = NthLastOfType (normalizeNth nth)+ normalize (NthOfType nth) = NthOfType (normalizeNth nth)+ normalize pc = pc++instance ToCssSelector Negation where+ toCssSelector n = ":not("<> go n <> ")"+ where go (NTypeSelector t) = toCssSelector t+ go (NHash h) = toCssSelector h+ go (NClass c) = toCssSelector c+ go (NAttrib a) = toCssSelector a+ go (NPseudo p) = toCssSelector p+ go (NPseudoElement p) = toCssSelector p+ toSelectorGroup = toSelectorGroup . SNot+ specificity' (NTypeSelector t) = specificity' t+ specificity' (NHash h) = specificity' h+ specificity' (NClass c) = specificity' c+ specificity' (NAttrib a) = specificity' a+ specificity' (NPseudo p) = specificity' p+ specificity' (NPseudoElement p) = specificity' p+ toPattern (NTypeSelector t) = _conP 'NTypeSelector [toPattern t]+ toPattern (NHash h) = _conP 'NHash [toPattern h]+ toPattern (NClass c) = _conP 'NClass [toPattern c]+ toPattern (NAttrib a) = _conP 'NAttrib [toPattern a]+ toPattern (NPseudo p) = _conP 'NPseudo [toPattern p]+ toPattern (NPseudoElement p) = _conP 'NPseudoElement [toPattern p]++instance ToCssSelector PseudoElement where+ toCssSelector = pack . (':' :) . (':' :) . go+ where go After = "after"+ go Before = "before"+ go FirstLetter = "first-letter"+ go FirstLine = "first-line"+ go Marker = "marker"+ go Placeholder = "placeholder"+ go Selection = "selection"+ specificity' = const (SelectorSpecificity 0 0 1)+ toSelectorGroup = toSelectorGroup . (def :.::)+ toPattern = _constantP . go+ where go After = 'After+ go Before = 'Before+ go FirstLetter = 'FirstLetter+ go FirstLine = 'FirstLine+ go Marker = 'Marker+ go Placeholder = 'Placeholder+ go Selection = 'Selection+ -- Custom Eq and Ord instances instance Eq SelectorSpecificity where (==) = on (==) specificityValue@@ -633,6 +1088,9 @@ instance Default Selector where def = Selector def +instance Default PseudoSelectorSequence where+ def = Sequence def+ instance Default SelectorSequence where def = SimpleSelector def @@ -654,6 +1112,10 @@ instance Default AttributeCombinator where def = Exact +-- | The default of the Nth instance is @n@, where all childs are selected.+instance Default Nth where+ def = Nth 1 0+ -- Binary instance _putEnum :: Enum a => a -> Put _putEnum = putWord8 . fromIntegral . fromEnum@@ -661,6 +1123,10 @@ _getEnum :: Enum a => Get a _getEnum = toEnum . fromIntegral <$> getWord8 +instance Binary Nth where+ put (Nth n b) = put n >> put b+ get = Nth <$> get <*> get+ instance Binary SelectorSpecificity where put (SelectorSpecificity a b c) = put a >> put b >> put c get = SelectorSpecificity <$> get <*> get <*> get@@ -673,8 +1139,88 @@ case w of 0 -> Selector <$> get 1 -> Combined <$> get <*> get <*> get- _ -> fail "An error occured while deserializing a Selector object"+ _ -> fail "An error occured while deserializing a Selector object." +instance Binary PseudoSelectorSequence where+ put (Sequence ss) = putWord8 0 >> put ss+ put (ss :.:: pe) = putWord8 1 >> put ss >> put pe+ get = do+ w <- getWord8+ case w of+ 0 -> Sequence <$> get+ 1 -> (:.::) <$> get <*> get+ _ -> fail "An error occured while deserializing a PseudoSelectorSequence."++instance Binary PseudoClass where+ put Active = putWord8 0+ put Checked = putWord8 1+ put Default = putWord8 2+ put Disabled = putWord8 3+ put Empty = putWord8 4+ put Enabled = putWord8 5+ put Focus = putWord8 6+ put Fullscreen = putWord8 7+ put Hover = putWord8 8+ put Indeterminate = putWord8 9+ put InRange = putWord8 10+ put Invalid = putWord8 11+ put (Lang l) = putWord8 12 >> put l+ put Link = putWord8 13+ put (NthChild nth) = putWord8 14 >> put nth+ put (NthLastChild nth) = putWord8 15 >> put nth+ put (NthLastOfType nth) = putWord8 16 >> put nth+ put (NthOfType nth) = putWord8 17 >> put nth+ put OnlyOfType = putWord8 18+ put OnlyChild = putWord8 19+ put Optional = putWord8 20+ put OutOfRange = putWord8 21+ put ReadOnly = putWord8 22+ put ReadWrite = putWord8 23+ put Required = putWord8 24+ put Root = putWord8 25+ put Target = putWord8 26+ put Valid = putWord8 27+ put Visited = putWord8 28++ get = do+ w <- getWord8+ case w of+ 0 -> pure Active+ 1 -> pure Checked+ 2 -> pure Default+ 3 -> pure Disabled+ 4 -> pure Empty+ 5 -> pure Enabled+ 6 -> pure Focus+ 7 -> pure Fullscreen+ 8 -> pure Hover+ 9 -> pure Indeterminate+ 10 -> pure InRange+ 11 -> pure Invalid+ 12 -> Lang <$> get+ 13 -> pure Link+ 14 -> NthChild <$> get+ 15 -> NthLastChild <$> get+ 16 -> NthLastOfType <$> get+ 17 -> NthOfType <$> get+ 18 -> pure OnlyOfType+ 19 -> pure OnlyChild+ 20 -> pure Optional+ 21 -> pure OutOfRange+ 22 -> pure ReadOnly+ 23 -> pure ReadWrite+ 24 -> pure Required+ 25 -> pure Root+ 26 -> pure Target+ 27 -> pure Valid+ 28 -> pure Visited+ _ -> fail "An error occured while deserialzing a PseudoClass object."+++instance Binary PseudoElement where+ put = _putEnum+ get = _getEnum+ instance Binary SelectorCombinator where put = _putEnum get = _getEnum@@ -693,14 +1239,37 @@ put (SHash h) = putWord8 0 >> put h put (SClass c) = putWord8 1 >> put c put (SAttrib a) = putWord8 2 >> put a+ put (SPseudo p) = putWord8 3 >> put p+ put (SNot n) = putWord8 4 >> put n get = do w <- getWord8 case w of 0 -> SHash <$> get 1 -> SClass <$> get 2 -> SAttrib <$> get+ 3 -> SPseudo <$> get+ 4 -> SNot <$> get _ -> fail "An error occurred when deserializing a SelectorFilter object." +instance Binary Negation where+ put (NTypeSelector t) = putWord8 0 >> put t+ put (NHash h) = putWord8 1 >> put h+ put (NClass c) = putWord8 2 >> put c+ put (NAttrib a) = putWord8 3 >> put a+ put (NPseudo p) = putWord8 4 >> put p+ put (NPseudoElement p) = putWord8 5 >> put p+ get = do+ w <- getWord8+ case w of+ 0 -> NTypeSelector <$> get+ 1 -> NHash <$> get+ 2 -> NClass <$> get+ 3 -> NAttrib <$> get+ 4 -> NPseudo <$> get+ 5 -> NPseudoElement <$> get+ _ -> fail "An error occurred when deserializing a Negation object."++ instance Binary Attrib where put (Exist e) = putWord8 0 >> put e put (Attrib an ac av) = putWord8 1 >> put an >> put ac >> put av@@ -755,9 +1324,12 @@ put (SelectorGroup g) = put g get = SelectorGroup <$> get - -- Lift instances+#if MIN_VERSION_template_haskell(2,17,0)+_apply :: Quote m => Name -> [m Exp] -> m Exp+#else _apply :: Name -> [Q Exp] -> Q Exp+#endif _apply = foldl appE . conE instance Lift SelectorGroup where@@ -769,7 +1341,6 @@ liftTyped = unsafeTExpCoerce . lift #endif - instance Lift Selector where #if MIN_VERSION_template_haskell(2,17,0) liftTyped = unsafeCodeCoerce . lift@@ -805,7 +1376,41 @@ liftTyped = unsafeTExpCoerce . lift #endif +instance Lift PseudoSelectorSequence where+#if MIN_VERSION_template_haskell(2,17,0)+ liftTyped = unsafeCodeCoerce . lift+#elif MIN_VERSION_template_haskell(2,16,0)+ liftTyped = unsafeTExpCoerce . lift+#endif +instance Lift PseudoClass where+#if MIN_VERSION_template_haskell(2,17,0)+ liftTyped = unsafeCodeCoerce . lift+#elif MIN_VERSION_template_haskell(2,16,0)+ liftTyped = unsafeTExpCoerce . lift+#endif++instance Lift PseudoElement where+#if MIN_VERSION_template_haskell(2,17,0)+ liftTyped = unsafeCodeCoerce . lift+#elif MIN_VERSION_template_haskell(2,16,0)+ liftTyped = unsafeTExpCoerce . lift+#endif++instance Lift Nth where+#if MIN_VERSION_template_haskell(2,17,0)+ liftTyped = unsafeCodeCoerce . lift+#elif MIN_VERSION_template_haskell(2,16,0)+ liftTyped = unsafeTExpCoerce . lift+#endif++instance Lift Negation where+#if MIN_VERSION_template_haskell(2,17,0)+ liftTyped = unsafeCodeCoerce . lift+#elif MIN_VERSION_template_haskell(2,16,0)+ liftTyped = unsafeTExpCoerce . lift+#endif+ -- ToMarkup instances _cssToMarkup :: ToCssSelector a => a -> Markup _cssToMarkup = text . toCssSelector@@ -819,12 +1424,24 @@ instance ToMarkup SelectorSequence where toMarkup = _cssToMarkup +instance ToMarkup PseudoSelectorSequence where+ toMarkup = _cssToMarkup++instance ToMarkup PseudoClass where+ toMarkup = _cssToMarkup++instance ToMarkup PseudoElement where+ toMarkup = _cssToMarkup+ instance ToMarkup SelectorFilter where toMarkup = _cssToMarkup instance ToMarkup Attrib where toMarkup = _cssToMarkup +instance ToMarkup Negation where+ toMarkup = _cssToMarkup+ -- ToJavaScript and ToJson instances _cssToJavascript :: ToCssSelector a => a -> Javascript #if __GLASGOW_HASKELL__ < 803@@ -845,12 +1462,24 @@ instance ToJavascript SelectorSequence where toJavascript = _cssToJavascript +instance ToJavascript PseudoSelectorSequence where+ toJavascript = _cssToJavascript++instance ToJavascript PseudoClass where+ toJavascript = _cssToJavascript++instance ToJavascript PseudoElement where+ toJavascript = _cssToJavascript+ instance ToJavascript SelectorFilter where toJavascript = _cssToJavascript instance ToJavascript Attrib where toJavascript = _cssToJavascript +instance ToJavascript Negation where+ toJavascript = _cssToJavascript+ instance ToJSON SelectorGroup where toJSON = _cssToJson @@ -863,14 +1492,29 @@ instance ToJSON SelectorFilter where toJSON = _cssToJson +instance ToJSON PseudoSelectorSequence where+ toJSON = _cssToJson++instance ToJSON PseudoClass where+ toJSON = _cssToJson++instance ToJSON PseudoElement where+ toJSON = _cssToJson+ instance ToJSON Attrib where toJSON = _cssToJson +instance ToJSON Negation where+ toJSON = _cssToJson + -- Arbitrary instances _arbitraryIdent :: Gen Text _arbitraryIdent = pack <$> listOf1 arbitrary +_arbitraryLanguages :: [Text]+_arbitraryLanguages = ["af", "af-ZA", "ar", "ar-AE", "ar-BH", "ar-DZ", "ar-EG", "ar-IQ", "ar-JO", "ar-KW", "ar-LB", "ar-LY", "ar-MA", "ar-OM", "ar-QA", "ar-SA", "ar-SY", "ar-TN", "ar-YE", "az", "az-AZ", "az-AZ", "be", "be-BY", "bg", "bg-BG", "bs-BA", "ca", "ca-ES", "cs", "cs-CZ", "cy", "cy-GB", "da", "da-DK", "de", "de-AT", "de-CH", "de-DE", "de-LI", "de-LU", "dv", "dv-MV", "el", "el-GR", "en", "en-AU", "en-BZ", "en-CA", "en-CB", "en-GB", "en-IE", "en-JM", "en-NZ", "en-PH", "en-TT", "en-US", "en-ZA", "en-ZW", "eo", "es", "es-AR", "es-BO", "es-CL", "es-CO", "es-CR", "es-DO", "es-EC", "es-ES", "es-ES", "es-GT", "es-HN", "es-MX", "es-NI", "es-PA", "es-PE", "es-PR", "es-PY", "es-SV", "es-UY", "es-VE", "et", "et-EE", "eu", "eu-ES", "fa", "fa-IR", "fi", "fi-FI", "fo", "fo-FO", "fr", "fr-BE", "fr-CA", "fr-CH", "fr-FR", "fr-LU", "fr-MC", "gl", "gl-ES", "gu", "gu-IN", "he", "he-IL", "hi", "hi-IN", "hr", "hr-BA", "hr-HR", "hu", "hu-HU", "hy", "hy-AM", "id", "id-ID", "is", "is-IS", "it", "it-CH", "it-IT", "ja", "ja-JP", "ka", "ka-GE", "kk", "kk-KZ", "kn", "kn-IN", "ko", "ko-KR", "kok", "kok-IN", "ky", "ky-KG", "lt", "lt-LT", "lv", "lv-LV", "mi", "mi-NZ", "mk", "mk-MK", "mn", "mn-MN", "mr", "mr-IN", "ms", "ms-BN", "ms-MY", "mt", "mt-MT", "nb", "nb-NO", "nl", "nl-BE", "nl-NL", "nn-NO", "ns", "ns-ZA", "pa", "pa-IN", "pl", "pl-PL", "ps", "ps-AR", "pt", "pt-BR", "pt-PT", "qu", "qu-BO", "qu-EC", "qu-PE", "ro", "ro-RO", "ru", "ru-RU", "sa", "sa-IN", "se", "se-FI", "se-FI", "se-FI", "se-NO", "se-NO", "se-NO", "se-SE", "se-SE", "se-SE", "sk", "sk-SK", "sl", "sl-SI", "sq", "sq-AL", "sr-BA", "sr-BA", "sr-SP", "sr-SP", "sv", "sv-FI", "sv-SE", "sw", "sw-KE", "syr", "syr-SY", "ta", "ta-IN", "te", "te-IN", "th", "th-TH", "tl", "tl-PH", "tn", "tn-ZA", "tr", "tr-TR", "tt", "tt-RU", "ts", "uk", "uk-UA", "ur", "ur-PK", "uz", "uz-UZ", "uz-UZ", "vi", "vi-VN", "xh", "xh-ZA", "zh", "zh-CN", "zh-HK", "zh-MO", "zh-SG", "zh-TW", "zu", "zu-ZA"]+ _shrinkText :: Text -> [Text] _shrinkText = liftA2 (zipWith (<>)) inits (tails . T.drop 1) @@ -887,6 +1531,13 @@ arbitrary = Class <$> _arbitraryIdent shrink (Class a) = Class <$> _shrinkIdent a +instance Arbitrary Nth where+ arbitrary = Nth <$> ((1+) . abs <$> arbitrary) <*> arbitrary+ shrink nth+ | nth == nnth = []+ | otherwise = [nnth]+ where nnth = normalizeNth nth+ instance Arbitrary Namespace where arbitrary = frequency [(3, pure NAny), (1, Namespace <$> _arbitraryIdent)] shrink NAny = []@@ -903,9 +1554,14 @@ instance Arbitrary SelectorSequence where arbitrary = addFilters . SimpleSelector <$> arbitrary <*> listOf arbitrary- shrink (SimpleSelector _) = []- shrink (Filter ss sf) = ss : (Filter ss <$> shrink sf)+ shrink (SimpleSelector ss) = SimpleSelector <$> shrink ss+ shrink (Filter ss sf) = ss : ((`Filter` sf) <$> shrink ss) ++ (Filter ss <$> shrink sf) +instance Arbitrary PseudoSelectorSequence where+ arbitrary = frequency [(3, Sequence <$> arbitrary), (1, (:.::) <$> arbitrary <*> arbitrary)]+ shrink (Sequence ss) = Sequence <$> shrink ss+ shrink (ss :.:: pe) = Sequence ss : ((ss :.::) <$> shrink pe) ++ ((:.:: pe) <$> shrink ss)+ instance Arbitrary SelectorCombinator where arbitrary = arbitraryBoundedEnum @@ -913,11 +1569,22 @@ arbitrary = arbitraryBoundedEnum instance Arbitrary SelectorFilter where- arbitrary = oneof [SHash <$> arbitrary, SClass <$> arbitrary, SAttrib <$> arbitrary]+ arbitrary = frequency [(4, SHash <$> arbitrary), (4, SClass <$> arbitrary), (4, SAttrib <$> arbitrary), (4, SPseudo <$> arbitrary), (1, SNot <$> arbitrary)] shrink (SHash x) = SHash <$> shrink x shrink (SClass x) = SClass <$> shrink x shrink (SAttrib x) = SAttrib <$> shrink x+ shrink (SPseudo x) = SPseudo <$> shrink x+ shrink (SNot x) = SNot <$> shrink x +instance Arbitrary Negation where+ arbitrary = oneof [NTypeSelector <$> arbitrary, NHash <$> arbitrary, NClass <$> arbitrary, NAttrib <$> arbitrary, NPseudo <$> arbitrary, NPseudoElement <$> arbitrary]+ shrink (NTypeSelector x) = NTypeSelector <$> shrink x+ shrink (NHash x) = NHash <$> shrink x+ shrink (NClass x) = NClass <$> shrink x+ shrink (NAttrib x) = NAttrib <$> shrink x+ shrink (NPseudo x) = NPseudo <$> shrink x+ shrink (NPseudoElement x) = NPseudoElement <$> shrink x+ instance Arbitrary AttributeName where arbitrary = AttributeName <$> arbitrary <*> _arbitraryIdent shrink (AttributeName x y) = (AttributeName x <$> _shrinkIdent y) ++ ((`AttributeName` y) <$> shrink x)@@ -937,3 +1604,12 @@ arbitrary = frequency [(3, Selector <$> arbitrary), (1, Combined <$> arbitrary <*> arbitrary <*> arbitrary) ] shrink (Selector x) = Selector <$> shrink x shrink (Combined x y z) = z : (Combined x y <$> shrink z) ++ ((\sx -> Combined sx y z) <$> shrink x)++instance Arbitrary PseudoClass where+ arbitrary = oneof ((Lang <$> elements _arbitraryLanguages) : map pure [+ Active, Checked, Default, Disabled, Empty, Enabled, Focus, Fullscreen, Hover, Indeterminate, InRange, Invalid, Link, OnlyOfType, OnlyChild+ , Optional, OutOfRange, ReadOnly, ReadWrite, Required, Root, Target, Valid, Visited+ ] ++ map (<$> arbitrary) [NthChild, NthLastChild, NthLastOfType, NthOfType])++instance Arbitrary PseudoElement where+ arbitrary = arbitraryBoundedEnum
src/Css3/Selector/Lexer.x view
@@ -1,23 +1,49 @@ --vim:ft=haskell {-module Css3.Selector.Lexer(AlexPosn(..), Token(..), TokenLoc(..), alexScanTokens) where+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# LANGUAGE PatternSynonyms #-} -import Data.Decimal(Decimal)+module Css3.Selector.Lexer(+ AlexPosn(AlexPn)+ , Token(+ TIncludes, TEqual, TDashMatch, TPrefixMatch, TSuffixMatch, TSubstringMatch, Ident, String, THash, Decimal+ , Integer, Comma, Plus, Greater, Tilde, Dot, Pipe, Asterisk, Space, BOpen, BClose, PseudoClass, PseudoFunction+ , PseudoElement, TN, TNth, TPM, TInt, TClose, TNot, TLang+ )+ , TokenLoc(TokenLoc)+ , alexScanTokens+ ) where+ import Css3.Selector.Utils(readCssString, readIdentifier)+import Css3.Selector.Core(+ PseudoElement(After, Before, FirstLetter, FirstLine, Marker, Placeholder, Selection)+ , PseudoClass(+ Active, Checked, Default, Disabled, Empty, Enabled, Focus, Fullscreen, Hover, Indeterminate, InRange+ , Invalid, Link, NthChild, NthLastChild, NthLastOfType, NthOfType, OnlyOfType, OnlyChild, Optional+ , OutOfRange, ReadOnly, ReadWrite, Required, Root, Target, Valid, Visited+ )+ , Nth, pattern Even, pattern Odd+ , pattern FirstChild, pattern FirstOfType, pattern LastChild, pattern LastOfType+ )++import Data.Decimal(Decimal)+#if __GLASGOW_HASKELL__ < 803+import Data.Semigroup(Semigroup((<>)))+#endif } -%wrapper "posn"+%wrapper "monadUserState" $nonascii = [^\0-\xff] $w = [\ \t\r\n\f] $nostar = [^\*] $nostars = [^\/\*] $tl = [\~]+$pm = [\-\+] @nl = \r|\n|\r\n|\f @unicode = \\[0-9a-fA-F]{1,6}(\r\n|[ \n\r\t\f])? @escape = @unicode | \\[^\n\r\f0-9a-fA-F]- @wo = $w* @nonaesc = $nonascii | @escape @nmstart = [_a-zA-Z] | @nonaesc@@ -30,52 +56,139 @@ @string2 = \"([^\n\r\f\\\"] | \\@nl | @nonaesc )*\" -- strings with double quotes @string = @string1 | @string2 ++@a = a|A|\\0{0,4}(41|61)(\r\n|[ \t\r\n\f])?+@b = b|B|\\0{0,4}(42|62)(\r\n|[ \t\r\n\f])?+@c = c|C|\\0{0,4}(43|63)(\r\n|[ \t\r\n\f])? @d = d|D|\\0{0,4}(44|64)(\r\n|[ \t\r\n\f])? @e = e|E|\\0{0,4}(45|65)(\r\n|[ \t\r\n\f])?+@f = f|F|\\0{0,4}(46|66)(\r\n|[ \t\r\n\f])?+@g = g|G|\\0{0,4}(47|67)(\r\n|[ \t\r\n\f])?+@h = h|H|\\0{0,4}(48|68)(\r\n|[ \t\r\n\f])?+@i = i|I|\\0{0,4}(49|69)(\r\n|[ \t\r\n\f])?+@j = j|J|\\0{0,4}(4a|6a)(\r\n|[ \t\r\n\f])?+@k = k|K|\\0{0,4}(4b|6b)(\r\n|[ \t\r\n\f])?+@l = l|L|\\0{0,4}(4c|6c)(\r\n|[ \t\r\n\f])?+@m = m|M|\\0{0,4}(4d|6d)(\r\n|[ \t\r\n\f])? @n = n|N|\\0{0,4}(4e|6e)(\r\n|[ \t\r\n\f])?|\\n @o = o|O|\\0{0,4}(4f|6f)(\r\n|[ \t\r\n\f])?|\\o+@p = p|P|\\0{0,4}(50|70)(\r\n|[ \t\r\n\f])?+@q = q|Q|\\0{0,4}(51|71)(\r\n|[ \t\r\n\f])?+@r = r|R|\\0{0,4}(52|72)(\r\n|[ \t\r\n\f])?+@s = s|S|\\0{0,4}(53|73)(\r\n|[ \t\r\n\f])? @t = t|T|\\0{0,4}(54|74)(\r\n|[ \t\r\n\f])?|\\t-@v = v|V|\\0{0,4}(58|78)(\r\n|[ \t\r\n\f])?|\\v+@u = u|U|\\0{0,4}(55|75)(\r\n|[ \t\r\n\f])?+@v = v|V|\\0{0,4}(56|76)(\r\n|[ \t\r\n\f])?|\\v+@w = w|W|\\0{0,4}(57|77)(\r\n|[ \t\r\n\f])?+@x = x|X|\\0{0,4}(58|78)(\r\n|[ \t\r\n\f])?+@y = y|Y|\\0{0,4}(59|79)(\r\n|[ \t\r\n\f])?+@z = z|Z|\\0{0,4}(5a|7a)(\r\n|[ \t\r\n\f])?+@hyphen = [\-]|\\0{0,4}2d++@firsth = @f@i@r@s@t@hyphen+@nthh = @n@t@h@hyphen+@onlyh = @o@n@l@y@hyphen+@child = @c@h@i@l@d+@oftype = @o@f@hyphen@t@y@p@e+@lasth = @l@a@s@t@hyphen+ @cmo = \/\* @cmc = \*\/-+@psc = [:]+@pse = [:][:]+@psb = [:][:]?+@lang = [A-Za-z\-]+ tokens :-- @wo "=" @wo { constoken TEqual }- @wo "~=" @wo { constoken TIncludes }- @wo "|=" @wo { constoken TDashMatch }- @wo "^=" @wo { constoken TPrefixMatch }- @wo "$=" @wo { constoken TSuffixMatch }- @wo "*=" @wo { constoken TSubstringMatch }- @wo "," @wo { constoken Comma }- "." { constoken Dot }- "|" { constoken Pipe }- "*" { constoken Asterisk }- @ident { tokenize (Ident . readIdentifier) }- @string { tokenize (String . readCssString) }- "#" @name { tokenize (THash . readIdentifier . drop 1) }- @float { tokenize (Decimal . read) }- @int { tokenize (Integer . read) }- @wo "+" @wo { constoken Plus }- @wo ">" @wo { constoken Greater }- @wo $tl @wo { constoken Tilde }- "[" @wo { constoken BOpen }- @wo "]" { constoken BClose }- $w @wo { constoken Space }- @cmo $nostar* \*+ ($nostars $nostar* \*+)* @cmc ;-+ <0> {+ @wo "=" @wo { constoken TEqual }+ @wo "~=" @wo { constoken TIncludes }+ @wo "|=" @wo { constoken TDashMatch }+ @wo "^=" @wo { constoken TPrefixMatch }+ @wo "$=" @wo { constoken TSuffixMatch }+ @wo "*=" @wo { constoken TSubstringMatch }+ @wo "," @wo { constoken Comma }+ "." { constoken Dot }+ "|" { constoken Pipe }+ "*" { constoken Asterisk }+ @ident { tokenize (Ident . readIdentifier) }+ @string { tokenize (String . readCssString) }+ "#" @name { tokenize (THash . readIdentifier . drop 1) }+ @float { tokenize (Decimal . read) }+ @int { tokenize (Integer . read) }+ @wo "+" @wo { constoken Plus }+ @wo ">" @wo { constoken Greater }+ @wo $tl @wo { constoken Tilde }+ "[" @wo { constoken BOpen }+ @wo "]" { constoken BClose }+ @psb @a@f@t@e@r { constoken (PseudoElement After) }+ @psb @b@e@f@o@r@e { constoken (PseudoElement Before) }+ @psb @firsth@l@e@t@t@e@r { constoken (PseudoElement FirstLetter) }+ @psb @firsth@l@i@n@e { constoken (PseudoElement FirstLine) }+ @pse @m@a@r@k@e@r { constoken (PseudoElement Marker) }+ @pse @p@l@a@c@e@h@o@l@d@e@r { constoken (PseudoElement Placeholder) }+ @pse @s@e@l@e@c@t@i@o@n { constoken (PseudoElement Selection) }+ @psc @a@c@t@i@v@e { constoken (PseudoClass Active) }+ @psc @c@h@e@c@k@e@d { constoken (PseudoClass Checked) }+ @psc @d@e@f@a@u@l@t { constoken (PseudoClass Default) }+ @psc @d@i@s@a@b@l@e@d { constoken (PseudoClass Disabled) }+ @psc @e@m@p@t@y { constoken (PseudoClass Empty) }+ @psc @e@n@a@b@l@e@d { constoken (PseudoClass Enabled) }+ @psc @firsth@child { constoken (PseudoClass FirstChild) }+ @psc @firsth@oftype { constoken (PseudoClass FirstOfType) }+ @psc @f@o@c@u@s { constoken (PseudoClass Focus) }+ @psc @f@u@l@l@s@c@r@e@e@n { constoken (PseudoClass Fullscreen) }+ @psc @h@o@v@e@r { constoken (PseudoClass Hover) }+ @psc @i@n@d@e@t@e@r@m@i@n@a@t@e { constoken (PseudoClass Indeterminate) }+ @psc @i@n@hyphen@r@a@n@g@e { constoken (PseudoClass InRange) }+ @psc @i@n@v@a@l@i@d { constoken (PseudoClass Invalid) }+ @psc @lasth@child { constoken (PseudoClass LastChild) }+ @psc @lasth@oftype { constoken (PseudoClass LastOfType) }+ @psc @l@i@n@k { constoken (PseudoClass Link) }+ @psc @l@a@n@g "(" { constAndBegin TLang lang_state }+ @psc @nthh@child "(" { constAndBegin (PseudoFunction NthChild) nth_state }+ @psc @nthh@lasth@child "(" { constAndBegin (PseudoFunction NthLastChild) nth_state }+ @psc @nthh@lasth@oftype "(" { constAndBegin (PseudoFunction NthLastOfType) nth_state }+ @psc @nthh@oftype "(" { constAndBegin (PseudoFunction NthOfType) nth_state }+ @psc @n@o@t "(" @wo { constoken TNot }+ @wo ")" { constoken TClose }+ @psc @onlyh@oftype { constoken (PseudoClass OnlyOfType) }+ @psc @onlyh@child { constoken (PseudoClass OnlyChild) }+ @psc @o@p@t@i@o@n@a@l { constoken (PseudoClass Optional) }+ @psc @o@u@t@hyphen@o@f@hyphen@r@a@n@g@e { constoken (PseudoClass OutOfRange) }+ @psc @r@e@a@d@hyphen@o@n@l@y { constoken (PseudoClass ReadOnly) }+ @psc @r@e@a@d@hyphen@w@r@i@t@e { constoken (PseudoClass ReadWrite) }+ @psc @r@e@q@u@i@r@e@d { constoken (PseudoClass Required) }+ @psc @r@o@o@t { constoken (PseudoClass Root) }+ @psc @t@a@r@g@e@t { constoken (PseudoClass Target) }+ @psc @v@a@l@i@d { constoken (PseudoClass Valid) }+ @psc @v@i@s@i@t@e@d { constoken (PseudoClass Visited) }+ $w @wo { constoken Space }+ @cmo $nostar* \*+ ($nostars $nostar* \*+)* @cmc;+ }+ <nth_state> {+ $w @wo { constoken Space }+ @e@v@e@n { constoken (TNth Even) }+ @o@d@d { constoken (TNth Odd) }+ @n { constoken TN }+ "+" { constoken (TPM id) }+ "-" { constoken (TPM negate) }+ @int { tokenize (TInt . read) }+ ")" { constAndBegin TClose state_initial }+ }+ <lang_state> {+ @lang { tokenize String }+ $w @wo { skip }+ ")" { constAndBegin TClose state_initial }+ } {-data TokenLoc = TokenLoc { token :: Token, original :: String, location :: AlexPosn } -tokenize :: (String -> Token) -> AlexPosn -> String -> TokenLoc-tokenize = flip . (>>= TokenLoc)+data TokenLoc = TokenLoc Token String (Maybe AlexPosn) -constoken :: Token -> AlexPosn -> String -> TokenLoc-constoken = tokenize . const+type AlexUserState = () --- The token type:-data Token =- TIncludes+data Token+ = TIncludes | TEqual | TDashMatch | TPrefixMatch@@ -96,5 +209,40 @@ | Space | BOpen | BClose- deriving (Eq,Show)+ | PseudoClass PseudoClass+ | PseudoFunction (Nth -> PseudoClass)+ | PseudoElement PseudoElement+ | TN+ | TNth Nth+ | TPM (Int -> Int)+ | TInt Int+ | TClose+ | TNot+ | TLang++tokenize :: (String -> Token) -> AlexInput -> Int -> Alex TokenLoc+tokenize f (p, _, _, str) len = pure (TokenLoc (f str') str' (Just p))+ where str' = take len str++constoken :: Token -> AlexInput -> Int -> Alex TokenLoc+constoken = tokenize . const++constAndBegin :: Token -> Int -> AlexInput -> Int -> Alex TokenLoc+constAndBegin = andBegin . constoken++state_initial :: Int+state_initial = 0++alexInitUserState :: AlexUserState+alexInitUserState = ()++alexEOF :: Alex TokenLoc+alexEOF = pure (TokenLoc undefined "" Nothing)++alexScanTokens :: String -> Either String [TokenLoc]+alexScanTokens str = runAlex str loop+ where loop :: Alex [TokenLoc]+ loop = alexMonadScan >>= p+ p (TokenLoc _ _ Nothing) = pure []+ p toc = (toc:) <$> loop }
src/Css3/Selector/Parser.y view
@@ -3,10 +3,18 @@ module Css3.Selector.Parser where import Css3.Selector.Core-import Css3.Selector.Lexer(AlexPosn(..), Token(..), TokenLoc(..))+import Css3.Selector.Lexer(+ AlexPosn(AlexPn), TokenLoc(TokenLoc)+ , Token(+ TIncludes, TEqual, TDashMatch, TPrefixMatch, TSuffixMatch, TSubstringMatch, Ident, String, THash, Decimal+ , Integer, Comma, Plus, Greater, Tilde, Dot, Pipe, Asterisk, Space, BOpen, BClose, PseudoClass, PseudoFunction+ , PseudoElement, TN, TNth, TPM, TInt, TClose, TNot, TLang+ )+ ) import Data.List.NonEmpty(NonEmpty((:|)), (<|)) +import Data.Default.Class(def) #if __GLASGOW_HASKELL__ < 803 import Data.Semigroup((<>)) #endif@@ -18,25 +26,35 @@ %error { happyError } %token- ',' { TokenLoc Comma _ _ }- '>' { TokenLoc Greater _ _ }- '+' { TokenLoc Plus _ _ }- '~' { TokenLoc Tilde _ _ }- '.' { TokenLoc Dot _ _ }- ' ' { TokenLoc Space _ _ }- '|' { TokenLoc Pipe _ _ }- '*' { TokenLoc Asterisk _ _ }- '[' { TokenLoc BOpen _ _ }- ']' { TokenLoc BClose _ _ }- '=' { TokenLoc TEqual _ _ }- '^=' { TokenLoc TPrefixMatch _ _ }- '$=' { TokenLoc TSuffixMatch _ _ }- '*=' { TokenLoc TSubstringMatch _ _ }- '|=' { TokenLoc TDashMatch _ _ }- '~=' { TokenLoc TIncludes _ _ }- ident { TokenLoc (Ident $$) _ _ }- string { TokenLoc (String $$) _ _ }- hash { TokenLoc (THash $$) _ _ }+ ',' { TokenLoc Comma _ _ }+ '>' { TokenLoc Greater _ _ }+ '+' { TokenLoc Plus _ _ }+ '~' { TokenLoc Tilde _ _ }+ '.' { TokenLoc Dot _ _ }+ ' ' { TokenLoc Space _ _ }+ '|' { TokenLoc Pipe _ _ }+ '*' { TokenLoc Asterisk _ _ }+ '[' { TokenLoc BOpen _ _ }+ ']' { TokenLoc BClose _ _ }+ '=' { TokenLoc TEqual _ _ }+ '^=' { TokenLoc TPrefixMatch _ _ }+ '$=' { TokenLoc TSuffixMatch _ _ }+ '*=' { TokenLoc TSubstringMatch _ _ }+ '|=' { TokenLoc TDashMatch _ _ }+ '~=' { TokenLoc TIncludes _ _ }+ ident { TokenLoc (Ident $$) _ _ }+ string { TokenLoc (String $$) _ _ }+ hash { TokenLoc (THash $$) _ _ }+ pseude { TokenLoc (PseudoElement $$) _ _ }+ pseudc { TokenLoc (PseudoClass $$) _ _ }+ pseudf { TokenLoc (PseudoFunction $$) _ _ }+ pm { TokenLoc (TPM $$) _ _ }+ 'n' { TokenLoc TN _ _ }+ int { TokenLoc (TInt $$) _ _ }+ nth { TokenLoc (TNth $$) _ _ }+ 'not(' { TokenLoc TNot _ _ }+ 'lang(' { TokenLoc TLang _ _ }+ ')' { TokenLoc TClose _ _ } %% @@ -50,8 +68,8 @@ ; Selector- : SimpleSelectorSequence { Selector $1 }- | SimpleSelectorSequence Combinator Selector { Combined $1 $2 $3 }+ : PseudoSelectorSequence { Selector $1 }+ | PseudoSelectorSequence Combinator Selector { Combined $1 $2 $3 } ; Combinator@@ -61,6 +79,12 @@ | ' ' { Descendant } ; +PseudoSelectorSequence+ : SimpleSelectorSequence { Sequence $1 }+ | SimpleSelectorSequence pseude { $1 :.:: $2 }+ | pseude { def :.:: $1 }+ ;+ SimpleSelectorSequence : Type FilterList { addFilters (SimpleSelector $1) $2 } | SelectorAddition FilterList { addFilters (SimpleSelector Universal) ($1:$2) }@@ -73,12 +97,49 @@ SelectorAddition : hash { SHash (Hash (pack $1)) }+ | pseudc { SPseudo $1 }+ | pseudf OptSpace Nth { SPseudo ($1 $3) } | Class { SClass $1 } | AttribBox { SAttrib $1 }+ | 'not(' Negation ')' { SNot $2 }+ | 'lang(' string ')' { SPseudo (Lang (pack $2)) } ; +Negation+ : hash { NHash (Hash (pack $1)) }+ | Class { NClass $1 }+ | AttribBox { NAttrib $1 }+ | pseudc { NPseudo $1 }+ | pseudf OptSpace Nth { NPseudo ($1 $3) }+ | Type { NTypeSelector $1 }+ | pseude { NPseudoElement $1 }+ | 'lang(' string ')' { NPseudo (Lang (pack $2)) }+ ;++Nth+ : nth OptSpace ')' { $1 }+ | PMOpt IntOpt 'n' OptSpace ')' { Nth ($1 $2) 0 }+ | PMOpt IntOpt 'n' OptSpace pm OptSpace int OptSpace ')' { Nth ($1 $2) ($5 $7) }+ | PMOpt int OptSpace ')' { Nth 0 ($1 $2) }+ ;++PMOpt+ : { id }+ | pm { $1 }+ ;++IntOpt+ : { 1 }+ | int { $1 }+ ;++OptSpace+ : { () }+ | ' ' { () }+ ;+ AttribBox- : '[' Attrib ']' { $2 }+ : '[' Attrib ']' { $2 } ; Attrib@@ -127,9 +188,7 @@ ; {- happyError :: [TokenLoc] -> a-happyError [] = error "Unexpected end of string when parsing a css selector."-happyError (~(TokenLoc _ s ~(AlexPn _ l c)):_) = error ("Can not parse the CSS selector: unpexected token \"" <> s <> "\" at location (" <> show l <> ", " <> show c <> ")")-+happyError (~(TokenLoc t s ~(Just (AlexPn _ l c))):_) = error ("Can not parse the CSS selector: unpexected token \"" <> s <> "\" at location (" <> show l <> ", " <> show c <> ")")+happyError _ = error "Unexpected end of string when parsing a css selector." }
src/Css3/Selector/QuasiQuoters.hs view
@@ -26,7 +26,10 @@ -- | Parse the string to a 'SelectorGroup'. parseCss :: String -- ^ The string to be parsed to a 'SelectorGroup' -> SelectorGroup -- ^ The selectorgroup that is the equivalent of the given 'String'.-parseCss = cssselector . alexScanTokens . filter ('\r' /=)+parseCss st = al (alexScanTokens st')+ where st' = filter ('\r' /=) st+ al (Left er) = error er+ al (Right val) = cssselector val liftDataWithText :: Data a => a -> Q Exp liftDataWithText = dataToExpQ ((((AppE (VarE 'pack) <$>) . lift . unpack) <$>) . cast)
src/Css3/Selector/Utils.hs view
@@ -119,4 +119,4 @@ -> String -- ^ The string to validate, and wrap into the given function. -> a -- ^ The identifier object to return if the identifier is valid. toIdentifier f ident | isValidIdentifier ident = f (pack ident)- | otherwise = error ("The identifier " <> show ident <> " is not a valid identifier.")+ | otherwise = error ("The identifier \"" <> show ident <> "\" is not a valid identifier.")
test/Spec.hs view
@@ -8,7 +8,12 @@ import Data.Hashable(Hashable(hashWithSalt)) import Data.Text(pack, unpack) +import Debug.Trace(trace)+ import Test.Framework (defaultMain, testGroup)+import Test.Framework.Options+import Test.Framework.Runners.Options+ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck @@ -22,71 +27,356 @@ testProperty "Encode-decode identifier" encodeDecodeId ], testGroup "Arbitrary css parsing" [- testProperty "Encode-decode css identity" encodeDecodeCss,- testProperty "Encode-decode css identity: selector group" (encodeDecodeCss' @SelectorGroup),- testProperty "Encode-decode css identity: selector" (encodeDecodeCss' @Selector),- testProperty "Encode-decode css identity: selector sequence" (encodeDecodeCss' @SelectorSequence),- testProperty "Encode-decode css identity: selector filter" (encodeDecodeCss' @SelectorFilter),- testProperty "Encode-decode css identity: namespace" (encodeDecodeCss' @Namespace),- testProperty "Encode-decode css identity: element name" (encodeDecodeCss' @ElementName),- testProperty "Encode-decode css identity: type selector" (encodeDecodeCss' @TypeSelector),- testProperty "Encode-decode css identity: attribute" (encodeDecodeCss' @Attrib),- testProperty "Encode-decode css identity: attribute name" (encodeDecodeCss' @AttributeName),- testProperty "Encode-decode css identity: class" (encodeDecodeCss' @Class),- testProperty "Encode-decode css identity: hash" (encodeDecodeCss' @Hash)+ testProperty "Encode-decode css identity" encodeDecodeCss+ , testProperty "Encode-decode css identity: selector group" (encodeDecodeCss' @SelectorGroup)+ , testProperty "Encode-decode css identity: selector" (encodeDecodeCss' @Selector)+ , testProperty "Encode-decode css identity: selector sequence" (encodeDecodeCss' @SelectorSequence)+ , testProperty "Encode-decode css identity: selector filter" (encodeDecodeCss' @SelectorFilter)+ , testProperty "Encode-decode css identity: namespace" (encodeDecodeCss' @Namespace)+ , testProperty "Encode-decode css identity: element name" (encodeDecodeCss' @ElementName)+ , testProperty "Encode-decode css identity: type selector" (encodeDecodeCss' @TypeSelector)+ , testProperty "Encode-decode css identity: attribute" (encodeDecodeCss' @Attrib)+ , testProperty "Encode-decode css identity: attribute name" (encodeDecodeCss' @AttributeName)+ , testProperty "Encode-decode css identity: class" (encodeDecodeCss' @Class)+ , testProperty "Encode-decode css identity: pseudo class" (encodeDecodeCss' @PseudoClass)+ , testProperty "Encode-decode css identity: pseudo element" (encodeDecodeCss' @PseudoElement)+ , testProperty "Encode-decode css identity: pseudo selector sequence" (encodeDecodeCss' @PseudoSelectorSequence)+ , testProperty "Encode-decode css identity: negation" (encodeDecodeCss' @Negation) ], testGroup "SelectorSequences" [ testProperty "Adding and removing filters" addRemFilters ], testGroup "Normalization" [- testProperty "Normalized variant has the same specificity" normSpec,- testProperty "Normalization is idempotent" normIdem+ testProperty "Normalized variant has the same specificity" normSpec+ , testProperty "Normalization is idempotent" normIdem ], testGroup "Build an expression or pattern" [- testProperty "Check build of pattern 1" buildPattern1,- testProperty "Check build of pattern 2" buildPattern2+ testProperty "Check build of pattern 1" buildPattern1+ , testProperty "Check build of pattern 2" buildPattern2 ], testGroup "Convert to binary and back" [- testProperty "Binary identity: selector group" (binaryEquivalent @SelectorGroup),- testProperty "Binary identity: selector" (binaryEquivalent @Selector),- testProperty "Binary identity: selector sequence" (binaryEquivalent @SelectorSequence),- testProperty "Binary identity: selector filter" (binaryEquivalent @SelectorFilter),- testProperty "Binary identity: namespace" (binaryEquivalent @Namespace),- testProperty "Binary identity: element name" (binaryEquivalent @ElementName),- testProperty "Binary identity: type selector" (binaryEquivalent @TypeSelector),- testProperty "Binary identity: attribute" (binaryEquivalent @Attrib),- testProperty "Binary identity: attribute name" (binaryEquivalent @AttributeName),- testProperty "Binary identity: class" (binaryEquivalent @Class),- testProperty "Binary identity: hash" (binaryEquivalent @Hash)+ testProperty "Binary identity: selector group" (binaryEquivalent @SelectorGroup)+ , testProperty "Binary identity: selector" (binaryEquivalent @Selector)+ , testProperty "Binary identity: selector sequence" (binaryEquivalent @SelectorSequence)+ , testProperty "Binary identity: selector filter" (binaryEquivalent @SelectorFilter)+ , testProperty "Binary identity: namespace" (binaryEquivalent @Namespace)+ , testProperty "Binary identity: element name" (binaryEquivalent @ElementName)+ , testProperty "Binary identity: type selector" (binaryEquivalent @TypeSelector)+ , testProperty "Binary identity: attribute" (binaryEquivalent @Attrib)+ , testProperty "Binary identity: attribute name" (binaryEquivalent @AttributeName)+ , testProperty "Binary identity: class" (binaryEquivalent @Class)+ , testProperty "Binary identity: hash" (binaryEquivalent @Hash)+ , testProperty "Binary identity: pseudo class" (binaryEquivalent @PseudoClass)+ , testProperty "Binary identity: pseudo element" (binaryEquivalent @PseudoElement)+ , testProperty "Binary identity: pseudo selector sequence" (binaryEquivalent @PseudoSelectorSequence)+ , testProperty "Binary identity: nth" (binaryEquivalent @Nth)+ , testProperty "Binary identity: negation" (binaryEquivalent @Negation) ], testGroup "Check binary equality" [- testProperty "Binary uniqness: selector group" (uniqnessEncoding @SelectorGroup),- testProperty "Binary uniqness: selector" (uniqnessEncoding @Selector),- testProperty "Binary uniqness: selector sequence" (uniqnessEncoding @SelectorSequence),- testProperty "Binary uniqness: selector filter" (uniqnessEncoding @SelectorFilter),- testProperty "Binary uniqness: namespace" (uniqnessEncoding @Namespace),- testProperty "Binary uniqness: element name" (uniqnessEncoding @ElementName),- testProperty "Binary uniqness: type selector" (uniqnessEncoding @TypeSelector),- testProperty "Binary uniqness: attribute" (uniqnessEncoding @Attrib),- testProperty "Binary uniqness: attribute name" (uniqnessEncoding @AttributeName),- testProperty "Binary uniqness: class" (uniqnessEncoding @Class),- testProperty "Binary uniqness: hash" (uniqnessEncoding @Hash)+ testProperty "Binary uniqness: selector group" (uniqnessEncoding @SelectorGroup)+ , testProperty "Binary uniqness: selector" (uniqnessEncoding @Selector)+ , testProperty "Binary uniqness: selector sequence" (uniqnessEncoding @SelectorSequence)+ , testProperty "Binary uniqness: selector filter" (uniqnessEncoding @SelectorFilter)+ , testProperty "Binary uniqness: namespace" (uniqnessEncoding @Namespace)+ , testProperty "Binary uniqness: element name" (uniqnessEncoding @ElementName)+ , testProperty "Binary uniqness: type selector" (uniqnessEncoding @TypeSelector)+ , testProperty "Binary uniqness: attribute" (uniqnessEncoding @Attrib)+ , testProperty "Binary uniqness: attribute name" (uniqnessEncoding @AttributeName)+ , testProperty "Binary uniqness: class" (uniqnessEncoding @Class)+ , testProperty "Binary uniqness: hash" (uniqnessEncoding @Hash)+ , testProperty "Binary uniqness: pseudo class" (uniqnessEncoding @PseudoClass)+ , testProperty "Binary uniqness: pseudo element" (uniqnessEncoding @PseudoElement)+ , testProperty "Binary uniqness: pseudo selector sequence" (uniqnessEncoding @PseudoSelectorSequence)+ , testProperty "Binary uniqness: nth" (uniqnessEncoding @Nth)+ , testProperty "Binary uniqness: negation" (uniqnessEncoding @Negation) ], 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)- ]+ 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)+ , testProperty "Different hash implies different items: pseudo class" (hashingDifferent @PseudoClass)+ , testProperty "Different hash implies different items: pseudo element" (hashingDifferent @PseudoElement)+ , testProperty "Different hash implies different items: pseudo selector sequence" (hashingDifferent @PseudoSelectorSequence)+ , testProperty "Different hash implies different items: nth" (hashingDifferent @Nth)+ , testProperty "Different hash implies different items: negation" (hashingDifferent @Negation)+ ],+ testGroup "Nths" [+ testProperty "Produces only (strictly) positive values" positiveNth+ , testProperty "Normalizing produces the same list" normSameNth+ , testProperty "Normalizing is idempotent" normalizeNthIdempotent+ , testProperty "Different normalized Nths have different values" (withMaxSuccess 5000 differentNormalizedNthsAreDifferent)+ , testProperty "nthIsEmpty checks" (withMaxSuccess 5000 checkIfNthIsEmpty)+ , testProperty "nthContainsValue contains all values" nthContainsSameItems+ , testProperty "nth contains same as its normalized counterpart" (withMaxSuccess 5000 normalizeContainsSame)+ ],+ testGroup "Parse examples" (map (\x -> testProperty ("test CSS selector " ++ x) (checkParse x)) validSelectors) ] +-- Based on the w3c testkit: https://test.csswg.org/harness/suite/selectors-3_dev/+validSelectors :: [String]+validSelectors = [+ "body > p"+ , "div ol>li p"+ , "*.pastoral"+ , ".pastoral"+ , "h1.pastoral"+ , "p.pastoral.marine"+ , "h1#chapter1"+ , "#chapter1"+ , "*#z98y"+ , "math + p"+ , "h1.opener + h2"+ , "h1 ~ pre"+ , "*"+ , "div :first-child"+ , "div *:first-child"+ , "body > h2:nth-of-type(n+2):nth-last-of-type(n+2)"+ , "body > h2:not(:first-of-type):not(:last-of-type)"+ , "h1, h2, h3"+ , "h1"+ , "foo|h1"+ , "foo|*"+ , "|h1"+ , "*|h1"+ , "*[hreflang|=en]"+ , "[hreflang|=en]"+ , "*.warning"+ , ".warning"+ , "*#myid"+ , "#myid"+ , "ns|*"+ , "*|*"+ , "|*"+ , "*"+ , "[att]"+ , "[att=val]"+ , "[att~=val]"+ , "[att|=val]"+ , "h1[title]"+ , "span[class=\"example\"]"+ , "span[hello=\"Cleveland\"][goodbye=\"Columbus\"]"+ , "a[rel~=\"copyright\"]"+ , "a[href=\"http://www.w3.org/\"]"+ , "a[hreflang=fr]"+ , "a[hreflang|=\"en\"]"+ , "DIALOGUE[character=romeo]"+ , "DIALOGUE[character=juliet]"+ , "[att^=val]"+ , "[att$=val]"+ , "[att*=val]"+ , "object[type^=\"image/\"]"+ , "a[href$=\".html\"]"+ , "p[title*=\"hello\"]"+ , "[foo|att=val]"+ , "[*|att]"+ , "[|att]"+ , "[att]"+ , "EXAMPLE[radix=decimal]"+ , "EXAMPLE[radix=octal]"+ , "EXAMPLE"+ , "*.pastoral"+ , ".pastoral"+ , "H1.pastoral"+ , "p.pastoral.marine"+ , "h1#chapter1"+ , "#chapter1"+ , "*#z98y"+ , "a.external:visited"+ , "a:link"+ , "a:visited"+ , "a:hover"+ , "a:active"+ , "a:focus"+ , "a:focus:hover"+ , "p.note:target"+ , "*:target"+ , "*:target::before"+ , "html:lang(fr-be)"+ , "html:lang(de)"+ , ":lang(fr-be) > q"+ , ":lang(de) > q"+ , "[lang|=fr]"+ , ":lang(fr)"+ , "[lang|=fr]"+ , "tr:nth-child(2n+1)"+ , "tr:nth-child(odd)"+ , "tr:nth-child(2n+0)"+ , "tr:nth-child(even)"+ , "p:nth-child(4n+1)"+ , "p:nth-child(4n+2)"+ , "p:nth-child(4n+3)"+ , "p:nth-child(4n+4)"+ , ":nth-child(10n-1)"+ , ":nth-child(10n+9)"+ , "foo:nth-child(0n+5)"+ , "foo:nth-child(5)"+ , "p"+ , "p::first-letter"+ , "span"+ , "h1 em"+ , "div * p"+ , "div p *[href]"+ , "body > p"+ , "div ol>li p"+ , "match + p"+ , "h1.opener + h2"+ , "h1 ~ pre"+ , "*"+ , "LI"+ , "UL LI"+ , "UL OL+LI"+ , "H1 + *[REL=up]"+ , "UL OL LI.red"+ , "LI.red.level"+ , "#x34y"+ , "#s12:not(FOO)"+ , "*"+ , "E"+ , "E[foo]"+ , "E[foo=\"bar\"]"+ , "E[foo~=\"bar\"]"+ , "E[foo^=\"bar\"]"+ , "E[foo$=\"bar\"]"+ , "E[foo*=\"bar\"]"+ , "E[foo|=\"en\"]"+ , "E:root"+ , "E:nth-child(n)"+ , "E:nth-last-child(n)"+ , "E:nth-of-type(n)"+ , "E:nth-last-of-type(n)"+ , "E:first-child"+ , "E:last-child"+ , "E:first-of-type"+ , "E:last-of-type"+ , "E:only-child"+ , "E:only-of-type"+ , "E:empty"+ , "E:link"+ , "E:visited"+ , "E:active"+ , "E:hover"+ , "E:focus"+ , "E:target"+ , "E:lang(fr)"+ , "E:enabled"+ , "E:disabled"+ , "E:checked"+ , "E::first-line"+ , "E::first-letter"+ , "E::before"+ , "E::after"+ , "E.warning"+ , "E#myid"+ , "E:not(s)"+ , "E F"+ , "E > F"+ , "E + F"+ , "E ~ F"+ , ".class"+ , ".class1.class2"+ , ".class1 .class2"+ , "#id"+ , "*"+ , "element"+ , "element.class"+ , "element,element"+ , "element element"+ , "element>element"+ , "element+element"+ , "element1~element2"+ , "[attribute]"+ , "[attribute=value]"+ , "[attribute~=value]"+ , "[attribute|=value]"+ , "[attribute^=value]"+ , "[attribute$=value]"+ , "[attribute*=value]"+ , ":active"+ , "::after"+ , "::before"+ , ":checked"+ , ":default"+ , ":disabled"+ , ":empty"+ , ":enabled"+ , ":first-child"+ , "::first-letter"+ , "::first-line"+ , ":first-of-type"+ , ":focus"+ , ":fullscreen"+ , ":hover"+ , ":in-range"+ , ":indeterminate"+ , ":invalid"+ , ":lang(language)"+ , ":last-child"+ , ":last-of-type"+ , ":link"+ , "::marker"+ , ":not(selector)"+ , ":nth-child(n)"+ , ":nth-last-child(n)"+ , ":nth-last-of-type(n)"+ , ":nth-of-type(n)"+ , ":only-of-type"+ , ":only-child"+ , ":optional"+ , ":out-of-range"+ , "::placeholder"+ , ":read-only"+ , ":read-write"+ , ":required"+ , ":root"+ , "::selection"+ , ":target"+ , ":valid"+ , ":visited"+ ]++checkParse :: String -> Bool+checkParse x = y == y+ where y = parseCss x++nthContainsSameItems :: Nth -> Bool+nthContainsSameItems nth = all (nthContainsValue nth) (take 5000 (nthValues nth))++normalizeContainsSame :: Nth -> Bool+normalizeContainsSame nth = all (\x -> nthContainsValue nth x == nthContainsValue nnth x) [0 .. 2000]+ where nnth = normalizeNth nth++equivalentNths :: [(Nth, Nth)]+equivalentNths = [+ (Nth 2 1, Odd)+ , (Nth 2 0, Even)+ , (Nth 10 (-1), Nth 10 9)+ ]++checkIfNthIsEmpty :: Nth -> Bool+checkIfNthIsEmpty nth = nthIsEmpty nth == null (nthValues nth)++positiveNth :: Nth -> Bool+positiveNth = all (0 <) . take 5000 . nthValues++normSameNth :: Nth -> Bool+normSameNth n = take 5000 (nthValues n) == take 5000 (nthValues (normalizeNth n))++normalizeNthIdempotent :: Nth -> Bool+normalizeNthIdempotent x = nx == normalizeNth nx where nx = normalizeNth x++differentNormalizedNthsAreDifferent :: Nth -> Nth -> Property+differentNormalizedNthsAreDifferent n1 n2 = within 1000000 (nn1 == nn2 || nthValues nn1 /= nthValues nn2)+ where nn1 = normalizeNth n1+ nn2 = normalizeNth n2+ encodeDecode :: Char -> String -> Bool encodeDecode c b = readCssString (encodeString c b) == b @@ -96,16 +386,16 @@ encodeDecodeCss :: SelectorGroup -> Bool encodeDecodeCss sg = sg == (parseCss . unpack . toCssSelector) sg -binaryEquivalent :: (Binary a, Eq a, ToCssSelector a) => a -> Bool+binaryEquivalent :: (Binary a, Eq 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 :: (Binary a, Eq a) => a -> a -> Bool uniqnessEncoding ca cb = (encode ca == encode cb) == (ca == cb) -encodeDecodeCss' :: ToCssSelector a => a -> Bool+encodeDecodeCss' :: (Show a, ToCssSelector a) => a -> Bool encodeDecodeCss' sg = (parseCss . unpack . toCssSelector . toSelectorGroup) sg == toSelectorGroup sg buildPattern1 :: SelectorGroup -> Bool