packages feed

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 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