{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, OverloadedStrings, PatternSynonyms, TemplateHaskellQuotes, TypeFamilies #-}

{-|
Module      : Css3.Selector.Core
Description : A module where we define the tree of types to represent and maniplate a css selector.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

A module that defines the tree of types to represent and manipulate a css selector. These data types are members of several typeclasses to make these more useful.
-}
module Css3.Selector.Core (
    -- * ToCssSelector typeclass
    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(SHash, SClass, SAttrib, SPseudo, SNot), filters, filters', addFilters, (.@)
    -- * Namespaces
    , Namespace(..), pattern NEmpty
    -- * Type selectors
    , ElementName(..), TypeSelector(..), pattern Universal, (.|)
    -- * Attributes
    , Attrib(..), AttributeCombinator(..), AttributeName(..), AttributeValue
    , (.=), (.~=), (.|=), (.^=), (.$=), (.*=)
    , attrib, attributeCombinatorText
    -- * Classes
    , 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
    , encode, decode, compressEncode, compressEncodeWith, decompressDecode
  ) where

-- based on https://www.w3.org/TR/2018/REC-selectors-3-20181106/#w3cselgrammar

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.Class(Default(def))
import Data.Function(on)
import Data.Hashable(Hashable)
import Data.List(sort, unfoldr)
import Data.List.NonEmpty(NonEmpty((:|)))
import qualified Data.List.NonEmpty
import Data.Ord(comparing)
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup(Semigroup((<>)))
#endif
import Data.String(IsString(fromString))
import qualified Data.Text as T
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), 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(IntegerL, StringL), Name, Pat(ConP, ListP, LitP, ViewP), Q, unsafeTExpCoerce)
#else
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, elements, frequency, listOf, listOf1, oneof)

import Text.Blaze(ToMarkup(toMarkup), text)
import Text.Blaze.Internal(Markup)
import Text.Julius(Javascript, ToJavascript(toJavascript))

-- | A datastructure that specifies the selectivity of a css selector. The
-- specificity is calculated based on three integers: @a@, @b@ and @c@.
--
-- The specificity is calculated with @100*a+10*b+c@ where @a@, @b@ and @c@
-- count certain elements of the css selector.
data SelectorSpecificity
    = SelectorSpecificity Int Int Int -- ^ Create a 'SelectorSpecificity' object with a given value for @a@, @b@, and @c@.
    deriving (Typeable SelectorSpecificity
SelectorSpecificity -> DataType
SelectorSpecificity -> Constr
(forall b. Data b => b -> b)
-> SelectorSpecificity -> SelectorSpecificity
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SelectorSpecificity -> u
forall u.
(forall d. Data d => d -> u) -> SelectorSpecificity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSpecificity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorSpecificity
-> c SelectorSpecificity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorSpecificity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSpecificity)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorSpecificity -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorSpecificity -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> SelectorSpecificity -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SelectorSpecificity -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
gmapT :: (forall b. Data b => b -> b)
-> SelectorSpecificity -> SelectorSpecificity
$cgmapT :: (forall b. Data b => b -> b)
-> SelectorSpecificity -> SelectorSpecificity
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSpecificity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSpecificity)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorSpecificity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorSpecificity)
dataTypeOf :: SelectorSpecificity -> DataType
$cdataTypeOf :: SelectorSpecificity -> DataType
toConstr :: SelectorSpecificity -> Constr
$ctoConstr :: SelectorSpecificity -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSpecificity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSpecificity
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorSpecificity
-> c SelectorSpecificity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorSpecificity
-> c SelectorSpecificity
Data, forall x. Rep SelectorSpecificity x -> SelectorSpecificity
forall x. SelectorSpecificity -> Rep SelectorSpecificity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectorSpecificity x -> SelectorSpecificity
$cfrom :: forall x. SelectorSpecificity -> Rep SelectorSpecificity x
Generic, Int -> SelectorSpecificity -> ShowS
[SelectorSpecificity] -> ShowS
SelectorSpecificity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectorSpecificity] -> ShowS
$cshowList :: [SelectorSpecificity] -> ShowS
show :: SelectorSpecificity -> String
$cshow :: SelectorSpecificity -> String
showsPrec :: Int -> SelectorSpecificity -> ShowS
$cshowsPrec :: Int -> SelectorSpecificity -> ShowS
Show)

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 -> Int
specificityValue (SelectorSpecificity Int
a Int
b Int
c) = Int
100forall a. Num a => a -> a -> a
*Int
a forall a. Num a => a -> a -> a
+ Int
10forall a. Num a => a -> a -> a
*Int
b forall a. Num a => a -> a -> a
+ Int
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 {
    Nth -> Int
linear :: Int  -- ^ The linear part of the 'Nth' object: the integral number before the @n@.
  , Nth -> Int
constant :: Int  -- ^ The constant part of the 'Nth' object.
  } deriving (Typeable Nth
Nth -> DataType
Nth -> Constr
(forall b. Data b => b -> b) -> Nth -> Nth
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Nth -> u
forall u. (forall d. Data d => d -> u) -> Nth -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Nth -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Nth -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Nth -> m Nth
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Nth -> m Nth
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Nth
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Nth -> c Nth
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Nth)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Nth)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Nth -> m Nth
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Nth -> m Nth
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Nth -> m Nth
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Nth -> m Nth
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Nth -> m Nth
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Nth -> m Nth
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Nth -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Nth -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Nth -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Nth -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Nth -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Nth -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Nth -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Nth -> r
gmapT :: (forall b. Data b => b -> b) -> Nth -> Nth
$cgmapT :: (forall b. Data b => b -> b) -> Nth -> Nth
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Nth)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Nth)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Nth)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Nth)
dataTypeOf :: Nth -> DataType
$cdataTypeOf :: Nth -> DataType
toConstr :: Nth -> Constr
$ctoConstr :: Nth -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Nth
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Nth
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Nth -> c Nth
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Nth -> c Nth
Data, Nth -> Nth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nth -> Nth -> Bool
$c/= :: Nth -> Nth -> Bool
== :: Nth -> Nth -> Bool
$c== :: Nth -> Nth -> Bool
Eq, forall x. Rep Nth x -> Nth
forall x. Nth -> Rep Nth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Nth x -> Nth
$cfrom :: forall x. Nth -> Rep Nth x
Generic, Eq Nth
Nth -> Nth -> Bool
Nth -> Nth -> Ordering
Nth -> Nth -> Nth
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Nth -> Nth -> Nth
$cmin :: Nth -> Nth -> Nth
max :: Nth -> Nth -> Nth
$cmax :: Nth -> Nth -> Nth
>= :: Nth -> Nth -> Bool
$c>= :: Nth -> Nth -> Bool
> :: Nth -> Nth -> Bool
$c> :: Nth -> Nth -> Bool
<= :: Nth -> Nth -> Bool
$c<= :: Nth -> Nth -> Bool
< :: Nth -> Nth -> Bool
$c< :: Nth -> Nth -> Bool
compare :: Nth -> Nth -> Ordering
$ccompare :: Nth -> Nth -> Ordering
Ord, ReadPrec [Nth]
ReadPrec Nth
Int -> ReadS Nth
ReadS [Nth]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Nth]
$creadListPrec :: ReadPrec [Nth]
readPrec :: ReadPrec Nth
$creadPrec :: ReadPrec Nth
readList :: ReadS [Nth]
$creadList :: ReadS [Nth]
readsPrec :: Int -> ReadS Nth
$creadsPrec :: Int -> ReadS Nth
Read, Int -> Nth -> ShowS
[Nth] -> ShowS
Nth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nth] -> ShowS
$cshowList :: [Nth] -> ShowS
show :: Nth -> String
$cshow :: Nth -> String
showsPrec :: Int -> Nth -> ShowS
$cshowsPrec :: Int -> Nth -> ShowS
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 -> Bool
nthIsEmpty (Nth Int
n Int
c) = Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
&& Int
c forall a. Ord a => a -> a -> Bool
<= Int
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
normalizeNth nth :: Nth
nth@(Nth Int
n Int
c)
  | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
&& Int
c forall a. Num a => a -> a -> a
+ Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> Int -> Nth
Nth Int
0 (forall a. Ord a => a -> a -> a
max Int
0 Int
c)
  | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
c forall a. Ord a => a -> a -> Bool
< Int
0 = let cn :: Int
cn = Int
c forall a. Integral a => a -> a -> a
`mod` Int
n in if Int
cn forall a. Eq a => a -> a -> Bool
/= Int
0 then Int -> Int -> Nth
Nth Int
n Int
cn else Int -> Int -> Nth
Nth Int
n Int
n
  | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
c forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Int -> Nth
Nth Int
n Int
n
  | Bool
otherwise = Nth
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 -> [Int]
nthValues (Nth Int
n Int
c)
  | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
c forall a. Ord a => a -> a -> Bool
<= Int
0 = let {c' :: Int
c' = Int
c forall a. Integral a => a -> a -> a
`mod` Int
n; cn' :: Int
cn' = Int
c' forall a. Num a => a -> a -> a
+ Int
n} in (if Int
c' forall a. Eq a => a -> a -> Bool
/= Int
0 then (Int
c'forall a. a -> [a] -> [a]
:) else forall a. a -> a
id) [Int
cn', Int
cn' forall a. Num a => a -> a -> a
+ Int
n ..]
  | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 = [Int
c, Int
cforall a. Num a => a -> a -> a
+Int
n ..]
  | Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = [ Int
c, Int
cforall a. Num a => a -> a -> a
+Int
n .. Int
1 ]
  | Bool
otherwise = [Int
c | Int
c forall a. Ord a => a -> a -> Bool
> Int
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 -> Int -> Bool
nthContainsValue (Nth Int
0 Int
c) Int
i = Int
c forall a. Eq a => a -> a -> Bool
== Int
i Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
> Int
0
nthContainsValue (Nth Int
n Int
c) Int
i = Int
i forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& (Int
i forall a. Num a => a -> a -> a
- Int
c) forall a. Integral a => a -> a -> a
`div` Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& (Int
i forall a. Num a => a -> a -> a
- Int
c) forall a. Integral a => a -> a -> a
`mod` Int
n forall a. Eq a => a -> a -> Bool
== Int
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 :: Nth -> [Int]
nthValues1 = Nth -> [Int]
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 :: Nth -> [Int]
nthValues0 = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
subtract Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nth -> [Int]
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 $bEven :: Nth
$mEven :: forall {r}. Nth -> ((# #) -> r) -> ((# #) -> r) -> r
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 $bOdd :: Nth
$mOdd :: forall {r}. Nth -> ((# #) -> r) -> ((# #) -> r) -> r
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 $bOne :: Nth
$mOne :: forall {r}. Nth -> ((# #) -> r) -> ((# #) -> r) -> r
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 :: Nth -> Text
nthToText Nth
Even = Text
"even"
nthToText Nth
Odd = Text
"odd"
nthToText (Nth Int
n Int
0) = Text -> Char -> Text
snoc (String -> Text
pack (forall a. Show a => a -> String
show Int
n)) Char
'n'
nthToText (Nth Int
0 Int
b) = String -> Text
pack (forall a. Show a => a -> String
show Int
b)
nthToText (Nth Int
n Int
b)
  | Int
b forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Text
pack (forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ Char
'n' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
b)
  | Bool
otherwise = String -> Text
pack (forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ Char
'n' forall a. a -> [a] -> [a]
: Char
'+' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
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
    -- | Convert the given element to a 'Text' object that contains the css
    -- selector.
    toCssSelector :: a -- ^ The given object for which we calculate the css selector.
        -> Text -- ^ The css selector text for the given object.

    -- | Lift the given 'ToCssSelector' type object to a 'SelectorGroup', which
    -- is the "root type" of the css selector hierarchy.
    toSelectorGroup :: a -- ^ The item to lift to a 'SelectorGroup'
        -> SelectorGroup -- ^ The value of a 'SelectorGroup' of which the object is the selective part.

    -- | Calculate the specificity of the css selector by returing a
    -- 'SelectorSpecificity' object.
    specificity' :: a -- ^ The item for which we calculate the specificity level.
        -> SelectorSpecificity -- ^ The specificity level of the given item.
    -- Convert the given 'ToCssSelector' item to a 'Pat' pattern, such that we
    -- can use it in functions.
    toPattern :: a -- ^ The item to convert to a 'Pat'.
        -> Pat -- ^ The pattern that is generated that will match only items equal to the given object.
    -- Convert the given 'ToCssSelector' item to an item in a more normalized
    -- form. A normalization is /idempotent/: applying this multiple times will
    -- have the same effect as applying it once.
    normalize :: a -- ^ The item to normalize.
        -> a -- ^ A normalized variant of the given item. This will filter the same objects, and have the same specificity.
    normalize = forall a. a -> a
id
    {-# MINIMAL toCssSelector, toSelectorGroup, specificity', toPattern #-}

-- | Convert the given item to a compressed 'ByteString'. This can be used to write to and read from a file for example.
-- The econding format is not an official format: it is constructed based on the structure of the Haskell types. That
-- stream is then passed through a gzip implementation.
compressEncode :: (Binary a, ToCssSelector a)
  => a -- ^ The object to turn into a compressed 'ByteString'.
  -> ByteString -- ^ A compressed binary representation of the given object.
compressEncode :: forall a. (Binary a, ToCssSelector a) => a -> ByteString
compressEncode = ByteString -> ByteString
compress forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Binary a => a -> ByteString
encode

-- | Convert the given item to a compressed 'ByteString'. This can be used to write to and read from a file for example.
-- The econding format is not an official format: it is constructed based on the structure of the Haskell types. That
-- stream is then passed through a gzip implementation.
compressEncodeWith :: (Binary a, ToCssSelector a)
  => CompressParams -- ^ The parameters that determine how to compress the 'ByteString'.
  -> a -- ^ The object to turn into a compressed 'ByteString'.
  -> ByteString -- ^ A compressed binary representation of the given object.
compressEncodeWith :: forall a.
(Binary a, ToCssSelector a) =>
CompressParams -> a -> ByteString
compressEncodeWith CompressParams
level = CompressParams -> ByteString -> ByteString
compressWith CompressParams
level forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Binary a => a -> ByteString
encode

-- | Convert the given item to a compressed 'ByteString'. This can be used to write to and read from a file for example.
-- The econding format is not an official format: it is constructed based on the structure of the Haskell types. That
-- stream is then passed through a gzip implementation.
decompressDecode :: (Binary a, ToCssSelector a)
  => ByteString -- ^ A compressed binary representation of a 'ToCssSelector' type.
  -> a -- ^ The corresponding decompressed and decoded logic.
decompressDecode :: forall a. (Binary a, ToCssSelector a) => ByteString -> a
decompressDecode = forall a. Binary a => ByteString -> a
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decompress


-- | Calculate the specificity of a 'ToCssSelector' type object. This is done by
-- calculating the 'SelectorSpecificity' object, and then calculating the value
-- of that object.
specificity :: ToCssSelector a => a -- ^ The object for which we evaluate the specificity.
    -> Int -- ^ The specificity level as an 'Int' value.
specificity :: forall a. ToCssSelector a => a -> Int
specificity = SelectorSpecificity -> Int
specificityValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCssSelector a => a -> SelectorSpecificity
specificity'

-- | The root type of a css selector. This is a comma-separated list of
-- selectors.
newtype SelectorGroup = SelectorGroup {
    SelectorGroup -> NonEmpty Selector
unSelectorGroup :: NonEmpty Selector -- ^ Unwrap the given 'NonEmpty' list of 'Selector's from the 'SelectorGroup' object.
  } deriving (Typeable SelectorGroup
SelectorGroup -> DataType
SelectorGroup -> Constr
(forall b. Data b => b -> b) -> SelectorGroup -> SelectorGroup
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SelectorGroup -> u
forall u. (forall d. Data d => d -> u) -> SelectorGroup -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorGroup
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorGroup -> c SelectorGroup
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorGroup)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorGroup)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SelectorGroup -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SelectorGroup -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorGroup -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorGroup -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
gmapT :: (forall b. Data b => b -> b) -> SelectorGroup -> SelectorGroup
$cgmapT :: (forall b. Data b => b -> b) -> SelectorGroup -> SelectorGroup
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorGroup)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorGroup)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorGroup)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorGroup)
dataTypeOf :: SelectorGroup -> DataType
$cdataTypeOf :: SelectorGroup -> DataType
toConstr :: SelectorGroup -> Constr
$ctoConstr :: SelectorGroup -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorGroup
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorGroup
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorGroup -> c SelectorGroup
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorGroup -> c SelectorGroup
Data, SelectorGroup -> SelectorGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectorGroup -> SelectorGroup -> Bool
$c/= :: SelectorGroup -> SelectorGroup -> Bool
== :: SelectorGroup -> SelectorGroup -> Bool
$c== :: SelectorGroup -> SelectorGroup -> Bool
Eq, forall x. Rep SelectorGroup x -> SelectorGroup
forall x. SelectorGroup -> Rep SelectorGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectorGroup x -> SelectorGroup
$cfrom :: forall x. SelectorGroup -> Rep SelectorGroup x
Generic, Eq SelectorGroup
SelectorGroup -> SelectorGroup -> Bool
SelectorGroup -> SelectorGroup -> Ordering
SelectorGroup -> SelectorGroup -> SelectorGroup
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SelectorGroup -> SelectorGroup -> SelectorGroup
$cmin :: SelectorGroup -> SelectorGroup -> SelectorGroup
max :: SelectorGroup -> SelectorGroup -> SelectorGroup
$cmax :: SelectorGroup -> SelectorGroup -> SelectorGroup
>= :: SelectorGroup -> SelectorGroup -> Bool
$c>= :: SelectorGroup -> SelectorGroup -> Bool
> :: SelectorGroup -> SelectorGroup -> Bool
$c> :: SelectorGroup -> SelectorGroup -> Bool
<= :: SelectorGroup -> SelectorGroup -> Bool
$c<= :: SelectorGroup -> SelectorGroup -> Bool
< :: SelectorGroup -> SelectorGroup -> Bool
$c< :: SelectorGroup -> SelectorGroup -> Bool
compare :: SelectorGroup -> SelectorGroup -> Ordering
$ccompare :: SelectorGroup -> SelectorGroup -> Ordering
Ord, Int -> SelectorGroup -> ShowS
[SelectorGroup] -> ShowS
SelectorGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectorGroup] -> ShowS
$cshowList :: [SelectorGroup] -> ShowS
show :: SelectorGroup -> String
$cshow :: SelectorGroup -> String
showsPrec :: Int -> SelectorGroup -> ShowS
$cshowsPrec :: Int -> SelectorGroup -> ShowS
Show)

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 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 (Typeable Selector
Selector -> DataType
Selector -> Constr
(forall b. Data b => b -> b) -> Selector -> Selector
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Selector -> u
forall u. (forall d. Data d => d -> u) -> Selector -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Selector
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Selector -> c Selector
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Selector)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Selector)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Selector -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Selector -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Selector -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Selector -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
gmapT :: (forall b. Data b => b -> b) -> Selector -> Selector
$cgmapT :: (forall b. Data b => b -> b) -> Selector -> Selector
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Selector)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Selector)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Selector)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Selector)
dataTypeOf :: Selector -> DataType
$cdataTypeOf :: Selector -> DataType
toConstr :: Selector -> Constr
$ctoConstr :: Selector -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Selector
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Selector
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Selector -> c Selector
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Selector -> c Selector
Data, Selector -> Selector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c== :: Selector -> Selector -> Bool
Eq, forall x. Rep Selector x -> Selector
forall x. Selector -> Rep Selector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Selector x -> Selector
$cfrom :: forall x. Selector -> Rep Selector x
Generic, Eq Selector
Selector -> Selector -> Bool
Selector -> Selector -> Ordering
Selector -> Selector -> Selector
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Selector -> Selector -> Selector
$cmin :: Selector -> Selector -> Selector
max :: Selector -> Selector -> Selector
$cmax :: Selector -> Selector -> Selector
>= :: Selector -> Selector -> Bool
$c>= :: Selector -> Selector -> Bool
> :: Selector -> Selector -> Bool
$c> :: Selector -> Selector -> Bool
<= :: Selector -> Selector -> Bool
$c<= :: Selector -> Selector -> Bool
< :: Selector -> Selector -> Bool
$c< :: Selector -> Selector -> Bool
compare :: Selector -> Selector -> Ordering
$ccompare :: Selector -> Selector -> Ordering
Ord, Int -> Selector -> ShowS
[Selector] -> ShowS
Selector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selector] -> ShowS
$cshowList :: [Selector] -> ShowS
show :: Selector -> String
$cshow :: Selector -> String
showsPrec :: Int -> Selector -> ShowS
$cshowsPrec :: Int -> Selector -> ShowS
Show)

instance Hashable Selector

instance NFData Selector

-- | A type that contains the possible ways to combine 'SelectorSequence's.
data SelectorCombinator =
      Descendant -- ^ The second tag is a descendant of the first one, denoted in css with a space.
    | Child -- ^ The second tag is the (direct) child of the first one, denoted with a @>@ in css.
    | DirectlyPreceded -- ^ The second tag is directly preceded by the first one, denoted with a @+@ in css.
    | Preceded -- ^ The second tag is preceded by the first one, denoted with a @~@ in css.
    deriving (SelectorCombinator
forall a. a -> a -> Bounded a
maxBound :: SelectorCombinator
$cmaxBound :: SelectorCombinator
minBound :: SelectorCombinator
$cminBound :: SelectorCombinator
Bounded, Typeable SelectorCombinator
SelectorCombinator -> DataType
SelectorCombinator -> Constr
(forall b. Data b => b -> b)
-> SelectorCombinator -> SelectorCombinator
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SelectorCombinator -> u
forall u. (forall d. Data d => d -> u) -> SelectorCombinator -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorCombinator -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorCombinator -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorCombinator -> m SelectorCombinator
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorCombinator -> m SelectorCombinator
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorCombinator
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorCombinator
-> c SelectorCombinator
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorCombinator)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorCombinator)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorCombinator -> m SelectorCombinator
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorCombinator -> m SelectorCombinator
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorCombinator -> m SelectorCombinator
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorCombinator -> m SelectorCombinator
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorCombinator -> m SelectorCombinator
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorCombinator -> m SelectorCombinator
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorCombinator -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorCombinator -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorCombinator -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorCombinator -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorCombinator -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorCombinator -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorCombinator -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorCombinator -> r
gmapT :: (forall b. Data b => b -> b)
-> SelectorCombinator -> SelectorCombinator
$cgmapT :: (forall b. Data b => b -> b)
-> SelectorCombinator -> SelectorCombinator
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorCombinator)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorCombinator)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorCombinator)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorCombinator)
dataTypeOf :: SelectorCombinator -> DataType
$cdataTypeOf :: SelectorCombinator -> DataType
toConstr :: SelectorCombinator -> Constr
$ctoConstr :: SelectorCombinator -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorCombinator
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorCombinator
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorCombinator
-> c SelectorCombinator
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorCombinator
-> c SelectorCombinator
Data, Int -> SelectorCombinator
SelectorCombinator -> Int
SelectorCombinator -> [SelectorCombinator]
SelectorCombinator -> SelectorCombinator
SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
SelectorCombinator
-> SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SelectorCombinator
-> SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
$cenumFromThenTo :: SelectorCombinator
-> SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
enumFromTo :: SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
$cenumFromTo :: SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
enumFromThen :: SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
$cenumFromThen :: SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
enumFrom :: SelectorCombinator -> [SelectorCombinator]
$cenumFrom :: SelectorCombinator -> [SelectorCombinator]
fromEnum :: SelectorCombinator -> Int
$cfromEnum :: SelectorCombinator -> Int
toEnum :: Int -> SelectorCombinator
$ctoEnum :: Int -> SelectorCombinator
pred :: SelectorCombinator -> SelectorCombinator
$cpred :: SelectorCombinator -> SelectorCombinator
succ :: SelectorCombinator -> SelectorCombinator
$csucc :: SelectorCombinator -> SelectorCombinator
Enum, SelectorCombinator -> SelectorCombinator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectorCombinator -> SelectorCombinator -> Bool
$c/= :: SelectorCombinator -> SelectorCombinator -> Bool
== :: SelectorCombinator -> SelectorCombinator -> Bool
$c== :: SelectorCombinator -> SelectorCombinator -> Bool
Eq, forall x. Rep SelectorCombinator x -> SelectorCombinator
forall x. SelectorCombinator -> Rep SelectorCombinator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectorCombinator x -> SelectorCombinator
$cfrom :: forall x. SelectorCombinator -> Rep SelectorCombinator x
Generic, Eq SelectorCombinator
SelectorCombinator -> SelectorCombinator -> Bool
SelectorCombinator -> SelectorCombinator -> Ordering
SelectorCombinator -> SelectorCombinator -> SelectorCombinator
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SelectorCombinator -> SelectorCombinator -> SelectorCombinator
$cmin :: SelectorCombinator -> SelectorCombinator -> SelectorCombinator
max :: SelectorCombinator -> SelectorCombinator -> SelectorCombinator
$cmax :: SelectorCombinator -> SelectorCombinator -> SelectorCombinator
>= :: SelectorCombinator -> SelectorCombinator -> Bool
$c>= :: SelectorCombinator -> SelectorCombinator -> Bool
> :: SelectorCombinator -> SelectorCombinator -> Bool
$c> :: SelectorCombinator -> SelectorCombinator -> Bool
<= :: SelectorCombinator -> SelectorCombinator -> Bool
$c<= :: SelectorCombinator -> SelectorCombinator -> Bool
< :: SelectorCombinator -> SelectorCombinator -> Bool
$c< :: SelectorCombinator -> SelectorCombinator -> Bool
compare :: SelectorCombinator -> SelectorCombinator -> Ordering
$ccompare :: SelectorCombinator -> SelectorCombinator -> Ordering
Ord, ReadPrec [SelectorCombinator]
ReadPrec SelectorCombinator
Int -> ReadS SelectorCombinator
ReadS [SelectorCombinator]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SelectorCombinator]
$creadListPrec :: ReadPrec [SelectorCombinator]
readPrec :: ReadPrec SelectorCombinator
$creadPrec :: ReadPrec SelectorCombinator
readList :: ReadS [SelectorCombinator]
$creadList :: ReadS [SelectorCombinator]
readsPrec :: Int -> ReadS SelectorCombinator
$creadsPrec :: Int -> ReadS SelectorCombinator
Read, Int -> SelectorCombinator -> ShowS
[SelectorCombinator] -> ShowS
SelectorCombinator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectorCombinator] -> ShowS
$cshowList :: [SelectorCombinator] -> ShowS
show :: SelectorCombinator -> String
$cshow :: SelectorCombinator -> String
showsPrec :: Int -> SelectorCombinator -> ShowS
$cshowsPrec :: Int -> SelectorCombinator -> ShowS
Show)

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'
combinatorText :: SelectorCombinator -- ^ The given 'SelectorCombinator' to retrieve the css token for.
    -> Text -- ^ The css selector token that is used for the given 'SelectorCombinator'.
combinatorText :: SelectorCombinator -> Text
combinatorText SelectorCombinator
Descendant = Text
" "
combinatorText SelectorCombinator
Child = Text
" > "
combinatorText SelectorCombinator
DirectlyPreceded = Text
" + "
combinatorText SelectorCombinator
Preceded = Text
" ~ "

-- | Combines two 'Selector's with the given 'SelectorCombinator'.
combine :: SelectorCombinator -- ^ The 'SelectorCombinator' that is applied between the two 'Selector's.
    -> Selector -- ^ The left 'Selector'.
    -> Selector -- ^ The right 'Selector'.
    -> Selector -- ^ A 'Selector' that is a combination of the left 'Selector' and the right 'Selector' with the given 'SelectorCombinator'.
combine :: SelectorCombinator -> Selector -> Selector -> Selector
combine SelectorCombinator
c0 Selector
x0 Selector
ys = Selector -> Selector
go Selector
x0
    where go :: Selector -> Selector
go (Selector PseudoSelectorSequence
x) = PseudoSelectorSequence
-> SelectorCombinator -> Selector -> Selector
Combined PseudoSelectorSequence
x SelectorCombinator
c0 Selector
ys
          go (Combined PseudoSelectorSequence
s1 SelectorCombinator
c Selector
s2) = PseudoSelectorSequence
-> SelectorCombinator -> Selector -> Selector
Combined PseudoSelectorSequence
s1 SelectorCombinator
c (Selector -> Selector
go Selector
s2)

-- | Combines two 'Selector's with the 'Child' combinator.
(.>) :: Selector -- ^ The left 'Selector'.
    -> Selector -- ^ The right 'Selector'.
    -> Selector -- ^ A selector that is the combination of the left 'Selector' and the right 'Selector' through 'Child'.
.> :: Selector -> Selector -> Selector
(.>) = SelectorCombinator -> Selector -> Selector -> Selector
combine SelectorCombinator
Child

-- | Combines two 'Selector's with the 'DirectlyPreceded' combinator.
(.+) :: Selector -- ^ The left 'Selector'.
    -> Selector -- ^ The right 'Selector'.
    -> Selector -- ^ A selector that is the combination of the left 'Selector' and the right 'Selector' through 'DirectlyPreceded'.
.+ :: Selector -> Selector -> Selector
(.+) = SelectorCombinator -> Selector -> Selector -> Selector
combine SelectorCombinator
DirectlyPreceded

-- | Combines two 'Selector's with the 'Preceded' combinator.
(.~) :: Selector -- ^ The left 'Selector'.
    -> Selector -- ^ The right 'Selector'.
    -> Selector -- ^ A selector that is the combination of the left 'Selector' and the right 'Selector' through 'Preceded'.
.~ :: Selector -> Selector -> Selector
(.~) = SelectorCombinator -> Selector -> Selector -> Selector
combine SelectorCombinator
Preceded

-- | A 'SelectorSequence' is a 'TypeSelector' (that can be 'Universal') followed
-- by zero, one or more 'SelectorFilter's these filter the selector further, for
-- example with a 'Hash', a 'Class', or an 'Attrib'.
data SelectorSequence =
      SimpleSelector TypeSelector -- ^ Convert a 'TypeSelector' into a 'SimpleSelector'.
    | Filter SelectorSequence SelectorFilter -- ^ Apply an additional 'SelectorFilter' to the 'SelectorSequence'.
    deriving (Typeable SelectorSequence
SelectorSequence -> DataType
SelectorSequence -> Constr
(forall b. Data b => b -> b)
-> SelectorSequence -> SelectorSequence
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SelectorSequence -> u
forall u. (forall d. Data d => d -> u) -> SelectorSequence -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSequence -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSequence -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorSequence -> m SelectorSequence
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSequence -> m SelectorSequence
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSequence
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorSequence -> c SelectorSequence
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorSequence)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSequence)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSequence -> m SelectorSequence
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSequence -> m SelectorSequence
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSequence -> m SelectorSequence
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSequence -> m SelectorSequence
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorSequence -> m SelectorSequence
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorSequence -> m SelectorSequence
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorSequence -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorSequence -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorSequence -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorSequence -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSequence -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSequence -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSequence -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSequence -> r
gmapT :: (forall b. Data b => b -> b)
-> SelectorSequence -> SelectorSequence
$cgmapT :: (forall b. Data b => b -> b)
-> SelectorSequence -> SelectorSequence
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSequence)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSequence)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorSequence)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorSequence)
dataTypeOf :: SelectorSequence -> DataType
$cdataTypeOf :: SelectorSequence -> DataType
toConstr :: SelectorSequence -> Constr
$ctoConstr :: SelectorSequence -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSequence
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSequence
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorSequence -> c SelectorSequence
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorSequence -> c SelectorSequence
Data, SelectorSequence -> SelectorSequence -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectorSequence -> SelectorSequence -> Bool
$c/= :: SelectorSequence -> SelectorSequence -> Bool
== :: SelectorSequence -> SelectorSequence -> Bool
$c== :: SelectorSequence -> SelectorSequence -> Bool
Eq, forall x. Rep SelectorSequence x -> SelectorSequence
forall x. SelectorSequence -> Rep SelectorSequence x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectorSequence x -> SelectorSequence
$cfrom :: forall x. SelectorSequence -> Rep SelectorSequence x
Generic, Eq SelectorSequence
SelectorSequence -> SelectorSequence -> Bool
SelectorSequence -> SelectorSequence -> Ordering
SelectorSequence -> SelectorSequence -> SelectorSequence
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SelectorSequence -> SelectorSequence -> SelectorSequence
$cmin :: SelectorSequence -> SelectorSequence -> SelectorSequence
max :: SelectorSequence -> SelectorSequence -> SelectorSequence
$cmax :: SelectorSequence -> SelectorSequence -> SelectorSequence
>= :: SelectorSequence -> SelectorSequence -> Bool
$c>= :: SelectorSequence -> SelectorSequence -> Bool
> :: SelectorSequence -> SelectorSequence -> Bool
$c> :: SelectorSequence -> SelectorSequence -> Bool
<= :: SelectorSequence -> SelectorSequence -> Bool
$c<= :: SelectorSequence -> SelectorSequence -> Bool
< :: SelectorSequence -> SelectorSequence -> Bool
$c< :: SelectorSequence -> SelectorSequence -> Bool
compare :: SelectorSequence -> SelectorSequence -> Ordering
$ccompare :: SelectorSequence -> SelectorSequence -> Ordering
Ord, Int -> SelectorSequence -> ShowS
[SelectorSequence] -> ShowS
SelectorSequence -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectorSequence] -> ShowS
$cshowList :: [SelectorSequence] -> ShowS
show :: SelectorSequence -> String
$cshow :: SelectorSequence -> String
showsPrec :: Int -> SelectorSequence -> ShowS
$cshowsPrec :: Int -> SelectorSequence -> ShowS
Show)

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 (Typeable PseudoSelectorSequence
PseudoSelectorSequence -> DataType
PseudoSelectorSequence -> Constr
(forall b. Data b => b -> b)
-> PseudoSelectorSequence -> PseudoSelectorSequence
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PseudoSelectorSequence -> u
forall u.
(forall d. Data d => d -> u) -> PseudoSelectorSequence -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> PseudoSelectorSequence
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> PseudoSelectorSequence
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PseudoSelectorSequence -> m PseudoSelectorSequence
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PseudoSelectorSequence -> m PseudoSelectorSequence
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoSelectorSequence
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PseudoSelectorSequence
-> c PseudoSelectorSequence
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoSelectorSequence)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoSelectorSequence)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PseudoSelectorSequence -> m PseudoSelectorSequence
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PseudoSelectorSequence -> m PseudoSelectorSequence
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PseudoSelectorSequence -> m PseudoSelectorSequence
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PseudoSelectorSequence -> m PseudoSelectorSequence
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PseudoSelectorSequence -> m PseudoSelectorSequence
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PseudoSelectorSequence -> m PseudoSelectorSequence
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PseudoSelectorSequence -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PseudoSelectorSequence -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> PseudoSelectorSequence -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> PseudoSelectorSequence -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> PseudoSelectorSequence
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> PseudoSelectorSequence
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> PseudoSelectorSequence
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> PseudoSelectorSequence
-> r
gmapT :: (forall b. Data b => b -> b)
-> PseudoSelectorSequence -> PseudoSelectorSequence
$cgmapT :: (forall b. Data b => b -> b)
-> PseudoSelectorSequence -> PseudoSelectorSequence
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoSelectorSequence)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoSelectorSequence)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoSelectorSequence)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoSelectorSequence)
dataTypeOf :: PseudoSelectorSequence -> DataType
$cdataTypeOf :: PseudoSelectorSequence -> DataType
toConstr :: PseudoSelectorSequence -> Constr
$ctoConstr :: PseudoSelectorSequence -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoSelectorSequence
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoSelectorSequence
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PseudoSelectorSequence
-> c PseudoSelectorSequence
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PseudoSelectorSequence
-> c PseudoSelectorSequence
Data, PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
$c/= :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
== :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
$c== :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
Eq, forall x. Rep PseudoSelectorSequence x -> PseudoSelectorSequence
forall x. PseudoSelectorSequence -> Rep PseudoSelectorSequence x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PseudoSelectorSequence x -> PseudoSelectorSequence
$cfrom :: forall x. PseudoSelectorSequence -> Rep PseudoSelectorSequence x
Generic, Eq PseudoSelectorSequence
PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
PseudoSelectorSequence -> PseudoSelectorSequence -> Ordering
PseudoSelectorSequence
-> PseudoSelectorSequence -> PseudoSelectorSequence
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PseudoSelectorSequence
-> PseudoSelectorSequence -> PseudoSelectorSequence
$cmin :: PseudoSelectorSequence
-> PseudoSelectorSequence -> PseudoSelectorSequence
max :: PseudoSelectorSequence
-> PseudoSelectorSequence -> PseudoSelectorSequence
$cmax :: PseudoSelectorSequence
-> PseudoSelectorSequence -> PseudoSelectorSequence
>= :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
$c>= :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
> :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
$c> :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
<= :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
$c<= :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
< :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
$c< :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
compare :: PseudoSelectorSequence -> PseudoSelectorSequence -> Ordering
$ccompare :: PseudoSelectorSequence -> PseudoSelectorSequence -> Ordering
Ord, Int -> PseudoSelectorSequence -> ShowS
[PseudoSelectorSequence] -> ShowS
PseudoSelectorSequence -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PseudoSelectorSequence] -> ShowS
$cshowList :: [PseudoSelectorSequence] -> ShowS
show :: PseudoSelectorSequence -> String
$cshow :: PseudoSelectorSequence -> String
showsPrec :: Int -> PseudoSelectorSequence -> ShowS
$cshowsPrec :: Int -> PseudoSelectorSequence -> ShowS
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'.
.:: :: SelectorSequence -> PseudoElement -> PseudoSelectorSequence
(.::) = SelectorSequence -> PseudoElement -> 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.
    -> [SelectorFilter] -- ^ The list of 'SelectorFilter's to apply on the 'SelectorSequence'.
    -> SelectorSequence -- ^ A modified 'SelectorSequence' where we applied the list of 'SelectorFilter's.
addFilters :: SelectorSequence -> [SelectorFilter] -> SelectorSequence
addFilters = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl SelectorSequence -> SelectorFilter -> SelectorSequence
Filter

-- | An infix variant of the 'addFilters' function.
(.@) :: 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.
.@ :: SelectorSequence -> [SelectorFilter] -> SelectorSequence
(.@) = SelectorSequence -> [SelectorFilter] -> SelectorSequence
addFilters

-- | Obtain the list of filters that are applied in the given 'SelectorSequence'
-- in /reversed/ order.
filters' :: SelectorSequence -- ^ The given 'SelectorSequence' to analyze.
    -> [SelectorFilter] -- ^ The given list of 'SelectorFilter's applied in /reversed/ order, this can be empty.
filters' :: SelectorSequence -> [SelectorFilter]
filters' = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr SelectorSequence -> Maybe (SelectorFilter, SelectorSequence)
go
    where go :: SelectorSequence -> Maybe (SelectorFilter, SelectorSequence)
go (Filter SelectorSequence
s SelectorFilter
f) = forall a. a -> Maybe a
Just (SelectorFilter
f, SelectorSequence
s)
          go (SimpleSelector TypeSelector
_) = forall a. Maybe a
Nothing

-- | Obtain the list of filters that are applied in the given
-- 'SelectorSequence'.
filters :: SelectorSequence -- ^ The given 'SelectorSequence' to analyze.
    -> [SelectorFilter] -- ^ The given list of 'SelectorFilter's applied, this can be empty.
filters :: SelectorSequence -> [SelectorFilter]
filters = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorSequence -> [SelectorFilter]
filters'

-- | 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.
    | 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 (Typeable SelectorFilter
SelectorFilter -> DataType
SelectorFilter -> Constr
(forall b. Data b => b -> b) -> SelectorFilter -> SelectorFilter
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SelectorFilter -> u
forall u. (forall d. Data d => d -> u) -> SelectorFilter -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorFilter -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorFilter -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorFilter -> m SelectorFilter
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorFilter -> m SelectorFilter
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorFilter
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorFilter -> c SelectorFilter
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorFilter)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorFilter)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorFilter -> m SelectorFilter
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorFilter -> m SelectorFilter
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorFilter -> m SelectorFilter
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorFilter -> m SelectorFilter
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorFilter -> m SelectorFilter
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorFilter -> m SelectorFilter
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorFilter -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorFilter -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorFilter -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorFilter -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorFilter -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorFilter -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorFilter -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorFilter -> r
gmapT :: (forall b. Data b => b -> b) -> SelectorFilter -> SelectorFilter
$cgmapT :: (forall b. Data b => b -> b) -> SelectorFilter -> SelectorFilter
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorFilter)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorFilter)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorFilter)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorFilter)
dataTypeOf :: SelectorFilter -> DataType
$cdataTypeOf :: SelectorFilter -> DataType
toConstr :: SelectorFilter -> Constr
$ctoConstr :: SelectorFilter -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorFilter
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorFilter
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorFilter -> c SelectorFilter
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorFilter -> c SelectorFilter
Data, SelectorFilter -> SelectorFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectorFilter -> SelectorFilter -> Bool
$c/= :: SelectorFilter -> SelectorFilter -> Bool
== :: SelectorFilter -> SelectorFilter -> Bool
$c== :: SelectorFilter -> SelectorFilter -> Bool
Eq, forall x. Rep SelectorFilter x -> SelectorFilter
forall x. SelectorFilter -> Rep SelectorFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectorFilter x -> SelectorFilter
$cfrom :: forall x. SelectorFilter -> Rep SelectorFilter x
Generic, Eq SelectorFilter
SelectorFilter -> SelectorFilter -> Bool
SelectorFilter -> SelectorFilter -> Ordering
SelectorFilter -> SelectorFilter -> SelectorFilter
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SelectorFilter -> SelectorFilter -> SelectorFilter
$cmin :: SelectorFilter -> SelectorFilter -> SelectorFilter
max :: SelectorFilter -> SelectorFilter -> SelectorFilter
$cmax :: SelectorFilter -> SelectorFilter -> SelectorFilter
>= :: SelectorFilter -> SelectorFilter -> Bool
$c>= :: SelectorFilter -> SelectorFilter -> Bool
> :: SelectorFilter -> SelectorFilter -> Bool
$c> :: SelectorFilter -> SelectorFilter -> Bool
<= :: SelectorFilter -> SelectorFilter -> Bool
$c<= :: SelectorFilter -> SelectorFilter -> Bool
< :: SelectorFilter -> SelectorFilter -> Bool
$c< :: SelectorFilter -> SelectorFilter -> Bool
compare :: SelectorFilter -> SelectorFilter -> Ordering
$ccompare :: SelectorFilter -> SelectorFilter -> Ordering
Ord, Int -> SelectorFilter -> ShowS
[SelectorFilter] -> ShowS
SelectorFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectorFilter] -> ShowS
$cshowList :: [SelectorFilter] -> ShowS
show :: SelectorFilter -> String
$cshow :: SelectorFilter -> String
showsPrec :: Int -> SelectorFilter -> ShowS
$cshowsPrec :: Int -> SelectorFilter -> ShowS
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 (Typeable Negation
Negation -> DataType
Negation -> Constr
(forall b. Data b => b -> b) -> Negation -> Negation
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Negation -> u
forall u. (forall d. Data d => d -> u) -> Negation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Negation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Negation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Negation -> m Negation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Negation -> m Negation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Negation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Negation -> c Negation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Negation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Negation)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Negation -> m Negation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Negation -> m Negation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Negation -> m Negation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Negation -> m Negation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Negation -> m Negation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Negation -> m Negation
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Negation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Negation -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Negation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Negation -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Negation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Negation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Negation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Negation -> r
gmapT :: (forall b. Data b => b -> b) -> Negation -> Negation
$cgmapT :: (forall b. Data b => b -> b) -> Negation -> Negation
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Negation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Negation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Negation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Negation)
dataTypeOf :: Negation -> DataType
$cdataTypeOf :: Negation -> DataType
toConstr :: Negation -> Constr
$ctoConstr :: Negation -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Negation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Negation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Negation -> c Negation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Negation -> c Negation
Data, Negation -> Negation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Negation -> Negation -> Bool
$c/= :: Negation -> Negation -> Bool
== :: Negation -> Negation -> Bool
$c== :: Negation -> Negation -> Bool
Eq, forall x. Rep Negation x -> Negation
forall x. Negation -> Rep Negation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Negation x -> Negation
$cfrom :: forall x. Negation -> Rep Negation x
Generic, Eq Negation
Negation -> Negation -> Bool
Negation -> Negation -> Ordering
Negation -> Negation -> Negation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Negation -> Negation -> Negation
$cmin :: Negation -> Negation -> Negation
max :: Negation -> Negation -> Negation
$cmax :: Negation -> Negation -> Negation
>= :: Negation -> Negation -> Bool
$c>= :: Negation -> Negation -> Bool
> :: Negation -> Negation -> Bool
$c> :: Negation -> Negation -> Bool
<= :: Negation -> Negation -> Bool
$c<= :: Negation -> Negation -> Bool
< :: Negation -> Negation -> Bool
$c< :: Negation -> Negation -> Bool
compare :: Negation -> Negation -> Ordering
$ccompare :: Negation -> Negation -> Ordering
Ord, Int -> Negation -> ShowS
[Negation] -> ShowS
Negation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Negation] -> ShowS
$cshowList :: [Negation] -> ShowS
show :: Negation -> String
$cshow :: Negation -> String
showsPrec :: Int -> Negation -> ShowS
$cshowsPrec :: Int -> Negation -> ShowS
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.).
data Attrib =
      Exist AttributeName -- ^ A constraint that the given 'AttributeName' should exist.
    | Attrib AttributeName AttributeCombinator AttributeValue -- ^ A constraint about the value associated with the given 'AttributeName'.
    deriving (Typeable Attrib
Attrib -> DataType
Attrib -> Constr
(forall b. Data b => b -> b) -> Attrib -> Attrib
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Attrib -> u
forall u. (forall d. Data d => d -> u) -> Attrib -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Attrib -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Attrib -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Attrib -> m Attrib
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attrib -> m Attrib
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attrib
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attrib -> c Attrib
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attrib)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attrib)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attrib -> m Attrib
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attrib -> m Attrib
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attrib -> m Attrib
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attrib -> m Attrib
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Attrib -> m Attrib
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Attrib -> m Attrib
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Attrib -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Attrib -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Attrib -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Attrib -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Attrib -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Attrib -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Attrib -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Attrib -> r
gmapT :: (forall b. Data b => b -> b) -> Attrib -> Attrib
$cgmapT :: (forall b. Data b => b -> b) -> Attrib -> Attrib
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attrib)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attrib)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attrib)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attrib)
dataTypeOf :: Attrib -> DataType
$cdataTypeOf :: Attrib -> DataType
toConstr :: Attrib -> Constr
$ctoConstr :: Attrib -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attrib
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attrib
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attrib -> c Attrib
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attrib -> c Attrib
Data, Attrib -> Attrib -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attrib -> Attrib -> Bool
$c/= :: Attrib -> Attrib -> Bool
== :: Attrib -> Attrib -> Bool
$c== :: Attrib -> Attrib -> Bool
Eq, forall x. Rep Attrib x -> Attrib
forall x. Attrib -> Rep Attrib x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attrib x -> Attrib
$cfrom :: forall x. Attrib -> Rep Attrib x
Generic, Eq Attrib
Attrib -> Attrib -> Bool
Attrib -> Attrib -> Ordering
Attrib -> Attrib -> Attrib
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Attrib -> Attrib -> Attrib
$cmin :: Attrib -> Attrib -> Attrib
max :: Attrib -> Attrib -> Attrib
$cmax :: Attrib -> Attrib -> Attrib
>= :: Attrib -> Attrib -> Bool
$c>= :: Attrib -> Attrib -> Bool
> :: Attrib -> Attrib -> Bool
$c> :: Attrib -> Attrib -> Bool
<= :: Attrib -> Attrib -> Bool
$c<= :: Attrib -> Attrib -> Bool
< :: Attrib -> Attrib -> Bool
$c< :: Attrib -> Attrib -> Bool
compare :: Attrib -> Attrib -> Ordering
$ccompare :: Attrib -> Attrib -> Ordering
Ord, Int -> Attrib -> ShowS
[Attrib] -> ShowS
Attrib -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attrib] -> ShowS
$cshowList :: [Attrib] -> ShowS
show :: Attrib -> String
$cshow :: Attrib -> String
showsPrec :: Int -> Attrib -> ShowS
$cshowsPrec :: Int -> Attrib -> ShowS
Show)

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.
    -> AttributeName -- ^ The name of an attribute to filter.
    -> AttributeValue -- ^ The value of the attribute to filter.
    -> Attrib -- ^ The result is an 'Attrib' object that will filter the given 'AttributeName' with the given 'AttributeCombinator'.
attrib :: AttributeCombinator -> AttributeName -> Text -> Attrib
attrib = forall a b c. (a -> b -> c) -> b -> a -> c
flip AttributeName -> AttributeCombinator -> Text -> Attrib
Attrib

-- | Create an 'Attrib' where the given 'AttributeName' is constrainted to be
-- exactly the given value.
(.=) :: AttributeName -- ^ The name of the attribute to constraint.
    -> AttributeValue -- ^ The value that constraints the attribute.
    -> Attrib -- ^ The 'Attrib' object we construct with the given name and value.
.= :: AttributeName -> Text -> Attrib
(.=) = AttributeCombinator -> AttributeName -> Text -> Attrib
attrib AttributeCombinator
Exact

-- | Create an 'Attrib' where the given 'AttributeName' is constrainted such
-- that the attribute is a whitespace seperated list of items, and the value is
-- one of these items.
(.~=) :: AttributeName -- ^ The name of the attribute to constraint.
    -> AttributeValue -- ^ The value that constraints the attribute.
    -> Attrib -- ^ The 'Attrib' object we construct with the given name and value.
.~= :: AttributeName -> Text -> Attrib
(.~=) = AttributeCombinator -> AttributeName -> Text -> Attrib
attrib AttributeCombinator
Include

-- | Create an 'Attrib' where the given 'AttributeName' is constrainted such
-- that the attribute is a dash seperated list of items, and the value is
-- the first of these items.
(.|=) :: AttributeName -- ^ The name of the attribute to constraint.
    -> AttributeValue -- ^ The value that constraints the attribute.
    -> Attrib -- ^ The 'Attrib' object we construct with the given name and value.
.|= :: AttributeName -> Text -> Attrib
(.|=) = AttributeCombinator -> AttributeName -> Text -> Attrib
attrib AttributeCombinator
DashMatch

-- | Create an 'Attrib' where the given 'AttributeName' is constrainted such
-- that the attribute has as prefix the given 'AttributeValue'.
(.^=) :: AttributeName -- ^ The name of the attribute to constraint.
    -> AttributeValue -- ^ The value that constraints the attribute.
    -> Attrib -- ^ The 'Attrib' object we construct with the given name and value.
.^= :: AttributeName -> Text -> Attrib
(.^=) = AttributeCombinator -> AttributeName -> Text -> Attrib
attrib AttributeCombinator
PrefixMatch

-- | Create an 'Attrib' where the given 'AttributeName' is constrainted such
-- that the attribute has as suffix the given 'AttributeValue'.
(.$=) :: AttributeName -- ^ The name of the attribute to constraint.
    -> AttributeValue -- ^ The value that constraints the attribute.
    -> Attrib -- ^ The 'Attrib' object we construct with the given name and value.
.$= :: AttributeName -> Text -> Attrib
(.$=) = AttributeCombinator -> AttributeName -> Text -> Attrib
attrib AttributeCombinator
SuffixMatch

-- | Create an 'Attrib' where the given 'AttributeName' is constrainted such
-- that the attribute has as substring the given 'AttributeValue'.
(.*=) :: AttributeName -- ^ The name of the attribute to constraint.
    -> AttributeValue -- ^ The value that constraints the attribute.
    -> Attrib -- ^ The 'Attrib' object we construct with the given name and value.
.*= :: AttributeName -> Text -> Attrib
(.*=) = AttributeCombinator -> AttributeName -> Text -> Attrib
attrib AttributeCombinator
SubstringMatch

-- | Filter a given 'SelectorSequence' with a given 'Hash'.
(.#) :: SelectorSequence -- ^ The given 'SelectorSequence' to filter.
    -> Hash -- ^ The given 'Hash' to filter the 'SelectorSequence' further.
    -> SelectorSequence -- ^ A 'SelectorSequence' that is filtered additionally with the given 'Hash'.
.# :: SelectorSequence -> Hash -> SelectorSequence
(.#) = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> SelectorFilter
SHash) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorSequence -> SelectorFilter -> SelectorSequence
Filter

-- | Filter a given 'SelectorSequence' with a given 'Class'.
(...) :: SelectorSequence -- ^ The given 'SelectorSequence to filter.
    -> Class -- ^ The given 'Class' to filter the 'SelectorSequence' further.
    -> SelectorSequence -- ^ A 'SelectorSequence' that is filtered additionally with the given 'Class'.
... :: SelectorSequence -> Class -> SelectorSequence
(...) = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> SelectorFilter
SClass) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorSequence -> SelectorFilter -> SelectorSequence
Filter

-- | Construct a 'TypeSelector' with a given 'Namespace' and 'ElementName'.
(.|) :: Namespace -- ^ The 'Namespace' for the 'TypeSelector'.
    -> ElementName -- ^ The 'ElementName' for the 'TypeSelector'.
    -> TypeSelector -- ^ A 'TypeSelector' object constructed with the 'Namespace' and 'ElementName'.
.| :: Namespace -> ElementName -> TypeSelector
(.|) = Namespace -> ElementName -> TypeSelector
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'.
.: :: SelectorSequence -> PseudoClass -> SelectorSequence
(.:) = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. PseudoClass -> SelectorFilter
SPseudo) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorSequence -> SelectorFilter -> SelectorSequence
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).
data Namespace =
      NAny -- ^ A typeselector part that specifies that we accept all namespaces, in css denoted with @*@.
    | Namespace Text -- ^ A typselector part that specifies that we accept a certain namespace name.
    deriving (Typeable Namespace
Namespace -> DataType
Namespace -> Constr
(forall b. Data b => b -> b) -> Namespace -> Namespace
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Namespace -> u
forall u. (forall d. Data d => d -> u) -> Namespace -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Namespace -> m Namespace
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Namespace -> m Namespace
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Namespace
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Namespace -> c Namespace
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Namespace)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Namespace)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Namespace -> m Namespace
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Namespace -> m Namespace
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Namespace -> m Namespace
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Namespace -> m Namespace
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Namespace -> m Namespace
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Namespace -> m Namespace
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Namespace -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Namespace -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Namespace -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Namespace -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace -> r
gmapT :: (forall b. Data b => b -> b) -> Namespace -> Namespace
$cgmapT :: (forall b. Data b => b -> b) -> Namespace -> Namespace
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Namespace)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Namespace)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Namespace)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Namespace)
dataTypeOf :: Namespace -> DataType
$cdataTypeOf :: Namespace -> DataType
toConstr :: Namespace -> Constr
$ctoConstr :: Namespace -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Namespace
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Namespace
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Namespace -> c Namespace
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Namespace -> c Namespace
Data, Namespace -> Namespace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c== :: Namespace -> Namespace -> Bool
Eq, forall x. Rep Namespace x -> Namespace
forall x. Namespace -> Rep Namespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Namespace x -> Namespace
$cfrom :: forall x. Namespace -> Rep Namespace x
Generic, Eq Namespace
Namespace -> Namespace -> Bool
Namespace -> Namespace -> Ordering
Namespace -> Namespace -> Namespace
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmax :: Namespace -> Namespace -> Namespace
>= :: Namespace -> Namespace -> Bool
$c>= :: Namespace -> Namespace -> Bool
> :: Namespace -> Namespace -> Bool
$c> :: Namespace -> Namespace -> Bool
<= :: Namespace -> Namespace -> Bool
$c<= :: Namespace -> Namespace -> Bool
< :: Namespace -> Namespace -> Bool
$c< :: Namespace -> Namespace -> Bool
compare :: Namespace -> Namespace -> Ordering
$ccompare :: Namespace -> Namespace -> Ordering
Ord, Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Namespace] -> ShowS
$cshowList :: [Namespace] -> ShowS
show :: Namespace -> String
$cshow :: Namespace -> String
showsPrec :: Int -> Namespace -> ShowS
$cshowsPrec :: Int -> Namespace -> ShowS
Show)

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
pattern $bNEmpty :: Namespace
$mNEmpty :: forall {r}. Namespace -> ((# #) -> r) -> ((# #) -> r) -> r
NEmpty = Namespace ""

-- | The element name of a css selector tag. The element name can be 'EAny' (all
-- possible tag names), or an element name with a given text.
data ElementName =
      EAny -- ^ A typeselector part that specifies that we accept all element names, in css denoted with @*@.
    | ElementName Text -- ^ A typeselector part that specifies that we accept a certain element name.
    deriving (Typeable ElementName
ElementName -> DataType
ElementName -> Constr
(forall b. Data b => b -> b) -> ElementName -> ElementName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ElementName -> u
forall u. (forall d. Data d => d -> u) -> ElementName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ElementName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ElementName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ElementName -> m ElementName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ElementName -> m ElementName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ElementName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ElementName -> c ElementName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ElementName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ElementName)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ElementName -> m ElementName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ElementName -> m ElementName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ElementName -> m ElementName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ElementName -> m ElementName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ElementName -> m ElementName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ElementName -> m ElementName
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ElementName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ElementName -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ElementName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ElementName -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ElementName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ElementName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ElementName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ElementName -> r
gmapT :: (forall b. Data b => b -> b) -> ElementName -> ElementName
$cgmapT :: (forall b. Data b => b -> b) -> ElementName -> ElementName
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ElementName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ElementName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ElementName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ElementName)
dataTypeOf :: ElementName -> DataType
$cdataTypeOf :: ElementName -> DataType
toConstr :: ElementName -> Constr
$ctoConstr :: ElementName -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ElementName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ElementName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ElementName -> c ElementName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ElementName -> c ElementName
Data, ElementName -> ElementName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementName -> ElementName -> Bool
$c/= :: ElementName -> ElementName -> Bool
== :: ElementName -> ElementName -> Bool
$c== :: ElementName -> ElementName -> Bool
Eq, forall x. Rep ElementName x -> ElementName
forall x. ElementName -> Rep ElementName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ElementName x -> ElementName
$cfrom :: forall x. ElementName -> Rep ElementName x
Generic, Eq ElementName
ElementName -> ElementName -> Bool
ElementName -> ElementName -> Ordering
ElementName -> ElementName -> ElementName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ElementName -> ElementName -> ElementName
$cmin :: ElementName -> ElementName -> ElementName
max :: ElementName -> ElementName -> ElementName
$cmax :: ElementName -> ElementName -> ElementName
>= :: ElementName -> ElementName -> Bool
$c>= :: ElementName -> ElementName -> Bool
> :: ElementName -> ElementName -> Bool
$c> :: ElementName -> ElementName -> Bool
<= :: ElementName -> ElementName -> Bool
$c<= :: ElementName -> ElementName -> Bool
< :: ElementName -> ElementName -> Bool
$c< :: ElementName -> ElementName -> Bool
compare :: ElementName -> ElementName -> Ordering
$ccompare :: ElementName -> ElementName -> Ordering
Ord, Int -> ElementName -> ShowS
[ElementName] -> ShowS
ElementName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElementName] -> ShowS
$cshowList :: [ElementName] -> ShowS
show :: ElementName -> String
$cshow :: ElementName -> String
showsPrec :: Int -> ElementName -> ShowS
$cshowsPrec :: Int -> ElementName -> ShowS
Show)

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 {
    TypeSelector -> Namespace
selectorNamespace :: Namespace, -- ^ The selector for the namespace.
    TypeSelector -> ElementName
elementName :: ElementName -- ^ The selector for the element name.
  } deriving (Typeable TypeSelector
TypeSelector -> DataType
TypeSelector -> Constr
(forall b. Data b => b -> b) -> TypeSelector -> TypeSelector
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TypeSelector -> u
forall u. (forall d. Data d => d -> u) -> TypeSelector -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSelector -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSelector -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeSelector -> m TypeSelector
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSelector -> m TypeSelector
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSelector
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSelector -> c TypeSelector
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeSelector)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeSelector)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSelector -> m TypeSelector
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSelector -> m TypeSelector
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSelector -> m TypeSelector
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSelector -> m TypeSelector
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeSelector -> m TypeSelector
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeSelector -> m TypeSelector
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeSelector -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeSelector -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeSelector -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeSelector -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSelector -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSelector -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSelector -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSelector -> r
gmapT :: (forall b. Data b => b -> b) -> TypeSelector -> TypeSelector
$cgmapT :: (forall b. Data b => b -> b) -> TypeSelector -> TypeSelector
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeSelector)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeSelector)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeSelector)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeSelector)
dataTypeOf :: TypeSelector -> DataType
$cdataTypeOf :: TypeSelector -> DataType
toConstr :: TypeSelector -> Constr
$ctoConstr :: TypeSelector -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSelector
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSelector
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSelector -> c TypeSelector
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSelector -> c TypeSelector
Data, TypeSelector -> TypeSelector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSelector -> TypeSelector -> Bool
$c/= :: TypeSelector -> TypeSelector -> Bool
== :: TypeSelector -> TypeSelector -> Bool
$c== :: TypeSelector -> TypeSelector -> Bool
Eq, forall x. Rep TypeSelector x -> TypeSelector
forall x. TypeSelector -> Rep TypeSelector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeSelector x -> TypeSelector
$cfrom :: forall x. TypeSelector -> Rep TypeSelector x
Generic, Eq TypeSelector
TypeSelector -> TypeSelector -> Bool
TypeSelector -> TypeSelector -> Ordering
TypeSelector -> TypeSelector -> TypeSelector
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeSelector -> TypeSelector -> TypeSelector
$cmin :: TypeSelector -> TypeSelector -> TypeSelector
max :: TypeSelector -> TypeSelector -> TypeSelector
$cmax :: TypeSelector -> TypeSelector -> TypeSelector
>= :: TypeSelector -> TypeSelector -> Bool
$c>= :: TypeSelector -> TypeSelector -> Bool
> :: TypeSelector -> TypeSelector -> Bool
$c> :: TypeSelector -> TypeSelector -> Bool
<= :: TypeSelector -> TypeSelector -> Bool
$c<= :: TypeSelector -> TypeSelector -> Bool
< :: TypeSelector -> TypeSelector -> Bool
$c< :: TypeSelector -> TypeSelector -> Bool
compare :: TypeSelector -> TypeSelector -> Ordering
$ccompare :: TypeSelector -> TypeSelector -> Ordering
Ord, Int -> TypeSelector -> ShowS
[TypeSelector] -> ShowS
TypeSelector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeSelector] -> ShowS
$cshowList :: [TypeSelector] -> ShowS
show :: TypeSelector -> String
$cshow :: TypeSelector -> String
showsPrec :: Int -> TypeSelector -> ShowS
$cshowsPrec :: Int -> TypeSelector -> ShowS
Show)

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 {
    AttributeName -> Namespace
attributeNamespace :: Namespace, -- ^ The namespace to which the attribute name belongs. This can be 'NAny' as well.
    AttributeName -> Text
attributeName :: Text  -- ^ The name of the attribute over which we make a claim.
  } deriving (Typeable AttributeName
AttributeName -> DataType
AttributeName -> Constr
(forall b. Data b => b -> b) -> AttributeName -> AttributeName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AttributeName -> u
forall u. (forall d. Data d => d -> u) -> AttributeName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AttributeName -> m AttributeName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AttributeName -> m AttributeName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeName -> c AttributeName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeName)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AttributeName -> m AttributeName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AttributeName -> m AttributeName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AttributeName -> m AttributeName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AttributeName -> m AttributeName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AttributeName -> m AttributeName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AttributeName -> m AttributeName
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AttributeName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AttributeName -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> AttributeName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AttributeName -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeName -> r
gmapT :: (forall b. Data b => b -> b) -> AttributeName -> AttributeName
$cgmapT :: (forall b. Data b => b -> b) -> AttributeName -> AttributeName
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeName)
dataTypeOf :: AttributeName -> DataType
$cdataTypeOf :: AttributeName -> DataType
toConstr :: AttributeName -> Constr
$ctoConstr :: AttributeName -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeName -> c AttributeName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeName -> c AttributeName
Data, AttributeName -> AttributeName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeName -> AttributeName -> Bool
$c/= :: AttributeName -> AttributeName -> Bool
== :: AttributeName -> AttributeName -> Bool
$c== :: AttributeName -> AttributeName -> Bool
Eq, forall x. Rep AttributeName x -> AttributeName
forall x. AttributeName -> Rep AttributeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeName x -> AttributeName
$cfrom :: forall x. AttributeName -> Rep AttributeName x
Generic, Eq AttributeName
AttributeName -> AttributeName -> Bool
AttributeName -> AttributeName -> Ordering
AttributeName -> AttributeName -> AttributeName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AttributeName -> AttributeName -> AttributeName
$cmin :: AttributeName -> AttributeName -> AttributeName
max :: AttributeName -> AttributeName -> AttributeName
$cmax :: AttributeName -> AttributeName -> AttributeName
>= :: AttributeName -> AttributeName -> Bool
$c>= :: AttributeName -> AttributeName -> Bool
> :: AttributeName -> AttributeName -> Bool
$c> :: AttributeName -> AttributeName -> Bool
<= :: AttributeName -> AttributeName -> Bool
$c<= :: AttributeName -> AttributeName -> Bool
< :: AttributeName -> AttributeName -> Bool
$c< :: AttributeName -> AttributeName -> Bool
compare :: AttributeName -> AttributeName -> Ordering
$ccompare :: AttributeName -> AttributeName -> Ordering
Ord, Int -> AttributeName -> ShowS
[AttributeName] -> ShowS
AttributeName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeName] -> ShowS
$cshowList :: [AttributeName] -> ShowS
show :: AttributeName -> String
$cshow :: AttributeName -> String
showsPrec :: Int -> AttributeName -> ShowS
$cshowsPrec :: Int -> AttributeName -> ShowS
Show)

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 =
      Exact -- ^ The attribute has exactly the value of the value, denoted with @=@ in css.
    | Include -- ^ The attribute has a whitespace separated list of items, one of these items is the value, denoted with @~=@ in css.
    | DashMatch -- ^ The attribute has a hyphen separated list of items, the first item is the value, denoted with @|=@ in css.
    | PrefixMatch -- ^ The value is a prefix of the value in the attribute, denoted with @^=@ in css.
    | SuffixMatch -- ^ The value is a suffix of the value in the attribute, denoted with @$=@ in css.
    | SubstringMatch -- ^The value is a substring of the value in the attribute, denoted with @*=@ in css.
    deriving (AttributeCombinator
forall a. a -> a -> Bounded a
maxBound :: AttributeCombinator
$cmaxBound :: AttributeCombinator
minBound :: AttributeCombinator
$cminBound :: AttributeCombinator
Bounded, Typeable AttributeCombinator
AttributeCombinator -> DataType
AttributeCombinator -> Constr
(forall b. Data b => b -> b)
-> AttributeCombinator -> AttributeCombinator
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AttributeCombinator -> u
forall u.
(forall d. Data d => d -> u) -> AttributeCombinator -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeCombinator
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AttributeCombinator
-> c AttributeCombinator
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeCombinator)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeCombinator)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AttributeCombinator -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AttributeCombinator -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> AttributeCombinator -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AttributeCombinator -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
gmapT :: (forall b. Data b => b -> b)
-> AttributeCombinator -> AttributeCombinator
$cgmapT :: (forall b. Data b => b -> b)
-> AttributeCombinator -> AttributeCombinator
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeCombinator)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeCombinator)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeCombinator)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeCombinator)
dataTypeOf :: AttributeCombinator -> DataType
$cdataTypeOf :: AttributeCombinator -> DataType
toConstr :: AttributeCombinator -> Constr
$ctoConstr :: AttributeCombinator -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeCombinator
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeCombinator
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AttributeCombinator
-> c AttributeCombinator
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AttributeCombinator
-> c AttributeCombinator
Data, Int -> AttributeCombinator
AttributeCombinator -> Int
AttributeCombinator -> [AttributeCombinator]
AttributeCombinator -> AttributeCombinator
AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
AttributeCombinator
-> AttributeCombinator
-> AttributeCombinator
-> [AttributeCombinator]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AttributeCombinator
-> AttributeCombinator
-> AttributeCombinator
-> [AttributeCombinator]
$cenumFromThenTo :: AttributeCombinator
-> AttributeCombinator
-> AttributeCombinator
-> [AttributeCombinator]
enumFromTo :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
$cenumFromTo :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
enumFromThen :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
$cenumFromThen :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
enumFrom :: AttributeCombinator -> [AttributeCombinator]
$cenumFrom :: AttributeCombinator -> [AttributeCombinator]
fromEnum :: AttributeCombinator -> Int
$cfromEnum :: AttributeCombinator -> Int
toEnum :: Int -> AttributeCombinator
$ctoEnum :: Int -> AttributeCombinator
pred :: AttributeCombinator -> AttributeCombinator
$cpred :: AttributeCombinator -> AttributeCombinator
succ :: AttributeCombinator -> AttributeCombinator
$csucc :: AttributeCombinator -> AttributeCombinator
Enum, AttributeCombinator -> AttributeCombinator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeCombinator -> AttributeCombinator -> Bool
$c/= :: AttributeCombinator -> AttributeCombinator -> Bool
== :: AttributeCombinator -> AttributeCombinator -> Bool
$c== :: AttributeCombinator -> AttributeCombinator -> Bool
Eq, forall x. Rep AttributeCombinator x -> AttributeCombinator
forall x. AttributeCombinator -> Rep AttributeCombinator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeCombinator x -> AttributeCombinator
$cfrom :: forall x. AttributeCombinator -> Rep AttributeCombinator x
Generic, Eq AttributeCombinator
AttributeCombinator -> AttributeCombinator -> Bool
AttributeCombinator -> AttributeCombinator -> Ordering
AttributeCombinator -> AttributeCombinator -> AttributeCombinator
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
$cmin :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
max :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
$cmax :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
>= :: AttributeCombinator -> AttributeCombinator -> Bool
$c>= :: AttributeCombinator -> AttributeCombinator -> Bool
> :: AttributeCombinator -> AttributeCombinator -> Bool
$c> :: AttributeCombinator -> AttributeCombinator -> Bool
<= :: AttributeCombinator -> AttributeCombinator -> Bool
$c<= :: AttributeCombinator -> AttributeCombinator -> Bool
< :: AttributeCombinator -> AttributeCombinator -> Bool
$c< :: AttributeCombinator -> AttributeCombinator -> Bool
compare :: AttributeCombinator -> AttributeCombinator -> Ordering
$ccompare :: AttributeCombinator -> AttributeCombinator -> Ordering
Ord, ReadPrec [AttributeCombinator]
ReadPrec AttributeCombinator
Int -> ReadS AttributeCombinator
ReadS [AttributeCombinator]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttributeCombinator]
$creadListPrec :: ReadPrec [AttributeCombinator]
readPrec :: ReadPrec AttributeCombinator
$creadPrec :: ReadPrec AttributeCombinator
readList :: ReadS [AttributeCombinator]
$creadList :: ReadS [AttributeCombinator]
readsPrec :: Int -> ReadS AttributeCombinator
$creadsPrec :: Int -> ReadS AttributeCombinator
Read, Int -> AttributeCombinator -> ShowS
[AttributeCombinator] -> ShowS
AttributeCombinator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeCombinator] -> ShowS
$cshowList :: [AttributeCombinator] -> ShowS
show :: AttributeCombinator -> String
$cshow :: AttributeCombinator -> String
showsPrec :: Int -> AttributeCombinator -> ShowS
$cshowsPrec :: Int -> AttributeCombinator -> ShowS
Show)

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 (Typeable PseudoClass
PseudoClass -> DataType
PseudoClass -> Constr
(forall b. Data b => b -> b) -> PseudoClass -> PseudoClass
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PseudoClass -> u
forall u. (forall d. Data d => d -> u) -> PseudoClass -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoClass -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoClass -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PseudoClass -> m PseudoClass
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoClass -> m PseudoClass
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoClass
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PseudoClass -> c PseudoClass
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoClass)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoClass)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoClass -> m PseudoClass
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoClass -> m PseudoClass
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoClass -> m PseudoClass
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoClass -> m PseudoClass
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PseudoClass -> m PseudoClass
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PseudoClass -> m PseudoClass
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PseudoClass -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PseudoClass -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PseudoClass -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PseudoClass -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoClass -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoClass -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoClass -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoClass -> r
gmapT :: (forall b. Data b => b -> b) -> PseudoClass -> PseudoClass
$cgmapT :: (forall b. Data b => b -> b) -> PseudoClass -> PseudoClass
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoClass)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoClass)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoClass)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoClass)
dataTypeOf :: PseudoClass -> DataType
$cdataTypeOf :: PseudoClass -> DataType
toConstr :: PseudoClass -> Constr
$ctoConstr :: PseudoClass -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoClass
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoClass
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PseudoClass -> c PseudoClass
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PseudoClass -> c PseudoClass
Data, PseudoClass -> PseudoClass -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PseudoClass -> PseudoClass -> Bool
$c/= :: PseudoClass -> PseudoClass -> Bool
== :: PseudoClass -> PseudoClass -> Bool
$c== :: PseudoClass -> PseudoClass -> Bool
Eq, forall x. Rep PseudoClass x -> PseudoClass
forall x. PseudoClass -> Rep PseudoClass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PseudoClass x -> PseudoClass
$cfrom :: forall x. PseudoClass -> Rep PseudoClass x
Generic, Eq PseudoClass
PseudoClass -> PseudoClass -> Bool
PseudoClass -> PseudoClass -> Ordering
PseudoClass -> PseudoClass -> PseudoClass
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PseudoClass -> PseudoClass -> PseudoClass
$cmin :: PseudoClass -> PseudoClass -> PseudoClass
max :: PseudoClass -> PseudoClass -> PseudoClass
$cmax :: PseudoClass -> PseudoClass -> PseudoClass
>= :: PseudoClass -> PseudoClass -> Bool
$c>= :: PseudoClass -> PseudoClass -> Bool
> :: PseudoClass -> PseudoClass -> Bool
$c> :: PseudoClass -> PseudoClass -> Bool
<= :: PseudoClass -> PseudoClass -> Bool
$c<= :: PseudoClass -> PseudoClass -> Bool
< :: PseudoClass -> PseudoClass -> Bool
$c< :: PseudoClass -> PseudoClass -> Bool
compare :: PseudoClass -> PseudoClass -> Ordering
$ccompare :: PseudoClass -> PseudoClass -> Ordering
Ord, ReadPrec [PseudoClass]
ReadPrec PseudoClass
Int -> ReadS PseudoClass
ReadS [PseudoClass]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PseudoClass]
$creadListPrec :: ReadPrec [PseudoClass]
readPrec :: ReadPrec PseudoClass
$creadPrec :: ReadPrec PseudoClass
readList :: ReadS [PseudoClass]
$creadList :: ReadS [PseudoClass]
readsPrec :: Int -> ReadS PseudoClass
$creadsPrec :: Int -> ReadS PseudoClass
Read, Int -> PseudoClass -> ShowS
[PseudoClass] -> ShowS
PseudoClass -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PseudoClass] -> ShowS
$cshowList :: [PseudoClass] -> ShowS
show :: PseudoClass -> String
$cshow :: PseudoClass -> String
showsPrec :: Int -> PseudoClass -> ShowS
$cshowsPrec :: Int -> PseudoClass -> ShowS
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 $bFirstChild :: PseudoClass
$mFirstChild :: forall {r}. PseudoClass -> ((# #) -> r) -> ((# #) -> r) -> r
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 $bFirstOfType :: PseudoClass
$mFirstOfType :: forall {r}. PseudoClass -> ((# #) -> r) -> ((# #) -> r) -> r
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 $bLastChild :: PseudoClass
$mLastChild :: forall {r}. PseudoClass -> ((# #) -> r) -> ((# #) -> r) -> r
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 $bLastOfType :: PseudoClass
$mLastOfType :: forall {r}. PseudoClass -> ((# #) -> r) -> ((# #) -> r) -> r
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 (PseudoElement
forall a. a -> a -> Bounded a
maxBound :: PseudoElement
$cmaxBound :: PseudoElement
minBound :: PseudoElement
$cminBound :: PseudoElement
Bounded, Typeable PseudoElement
PseudoElement -> DataType
PseudoElement -> Constr
(forall b. Data b => b -> b) -> PseudoElement -> PseudoElement
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PseudoElement -> u
forall u. (forall d. Data d => d -> u) -> PseudoElement -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoElement -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoElement -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PseudoElement -> m PseudoElement
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoElement -> m PseudoElement
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoElement
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PseudoElement -> c PseudoElement
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoElement)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoElement)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoElement -> m PseudoElement
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoElement -> m PseudoElement
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoElement -> m PseudoElement
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoElement -> m PseudoElement
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PseudoElement -> m PseudoElement
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PseudoElement -> m PseudoElement
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PseudoElement -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PseudoElement -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PseudoElement -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PseudoElement -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoElement -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoElement -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoElement -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoElement -> r
gmapT :: (forall b. Data b => b -> b) -> PseudoElement -> PseudoElement
$cgmapT :: (forall b. Data b => b -> b) -> PseudoElement -> PseudoElement
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoElement)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoElement)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoElement)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoElement)
dataTypeOf :: PseudoElement -> DataType
$cdataTypeOf :: PseudoElement -> DataType
toConstr :: PseudoElement -> Constr
$ctoConstr :: PseudoElement -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoElement
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoElement
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PseudoElement -> c PseudoElement
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PseudoElement -> c PseudoElement
Data, Int -> PseudoElement
PseudoElement -> Int
PseudoElement -> [PseudoElement]
PseudoElement -> PseudoElement
PseudoElement -> PseudoElement -> [PseudoElement]
PseudoElement -> PseudoElement -> PseudoElement -> [PseudoElement]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PseudoElement -> PseudoElement -> PseudoElement -> [PseudoElement]
$cenumFromThenTo :: PseudoElement -> PseudoElement -> PseudoElement -> [PseudoElement]
enumFromTo :: PseudoElement -> PseudoElement -> [PseudoElement]
$cenumFromTo :: PseudoElement -> PseudoElement -> [PseudoElement]
enumFromThen :: PseudoElement -> PseudoElement -> [PseudoElement]
$cenumFromThen :: PseudoElement -> PseudoElement -> [PseudoElement]
enumFrom :: PseudoElement -> [PseudoElement]
$cenumFrom :: PseudoElement -> [PseudoElement]
fromEnum :: PseudoElement -> Int
$cfromEnum :: PseudoElement -> Int
toEnum :: Int -> PseudoElement
$ctoEnum :: Int -> PseudoElement
pred :: PseudoElement -> PseudoElement
$cpred :: PseudoElement -> PseudoElement
succ :: PseudoElement -> PseudoElement
$csucc :: PseudoElement -> PseudoElement
Enum, PseudoElement -> PseudoElement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PseudoElement -> PseudoElement -> Bool
$c/= :: PseudoElement -> PseudoElement -> Bool
== :: PseudoElement -> PseudoElement -> Bool
$c== :: PseudoElement -> PseudoElement -> Bool
Eq, forall x. Rep PseudoElement x -> PseudoElement
forall x. PseudoElement -> Rep PseudoElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PseudoElement x -> PseudoElement
$cfrom :: forall x. PseudoElement -> Rep PseudoElement x
Generic, Eq PseudoElement
PseudoElement -> PseudoElement -> Bool
PseudoElement -> PseudoElement -> Ordering
PseudoElement -> PseudoElement -> PseudoElement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PseudoElement -> PseudoElement -> PseudoElement
$cmin :: PseudoElement -> PseudoElement -> PseudoElement
max :: PseudoElement -> PseudoElement -> PseudoElement
$cmax :: PseudoElement -> PseudoElement -> PseudoElement
>= :: PseudoElement -> PseudoElement -> Bool
$c>= :: PseudoElement -> PseudoElement -> Bool
> :: PseudoElement -> PseudoElement -> Bool
$c> :: PseudoElement -> PseudoElement -> Bool
<= :: PseudoElement -> PseudoElement -> Bool
$c<= :: PseudoElement -> PseudoElement -> Bool
< :: PseudoElement -> PseudoElement -> Bool
$c< :: PseudoElement -> PseudoElement -> Bool
compare :: PseudoElement -> PseudoElement -> Ordering
$ccompare :: PseudoElement -> PseudoElement -> Ordering
Ord, ReadPrec [PseudoElement]
ReadPrec PseudoElement
Int -> ReadS PseudoElement
ReadS [PseudoElement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PseudoElement]
$creadListPrec :: ReadPrec [PseudoElement]
readPrec :: ReadPrec PseudoElement
$creadPrec :: ReadPrec PseudoElement
readList :: ReadS [PseudoElement]
$creadList :: ReadS [PseudoElement]
readsPrec :: Int -> ReadS PseudoElement
$creadsPrec :: Int -> ReadS PseudoElement
Read, Int -> PseudoElement -> ShowS
[PseudoElement] -> ShowS
PseudoElement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PseudoElement] -> ShowS
$cshowList :: [PseudoElement] -> ShowS
show :: PseudoElement -> String
$cshow :: PseudoElement -> String
showsPrec :: Int -> PseudoElement -> ShowS
$cshowsPrec :: Int -> PseudoElement -> ShowS
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 {
    Class -> Text
unClass :: Text -- ^ Obtain the name from the class.
  } deriving (Typeable Class
Class -> DataType
Class -> Constr
(forall b. Data b => b -> b) -> Class -> Class
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Class -> u
forall u. (forall d. Data d => d -> u) -> Class -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Class -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Class -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Class -> m Class
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Class -> m Class
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Class
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Class -> c Class
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Class)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Class)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Class -> m Class
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Class -> m Class
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Class -> m Class
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Class -> m Class
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Class -> m Class
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Class -> m Class
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Class -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Class -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Class -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Class -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Class -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Class -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Class -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Class -> r
gmapT :: (forall b. Data b => b -> b) -> Class -> Class
$cgmapT :: (forall b. Data b => b -> b) -> Class -> Class
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Class)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Class)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Class)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Class)
dataTypeOf :: Class -> DataType
$cdataTypeOf :: Class -> DataType
toConstr :: Class -> Constr
$ctoConstr :: Class -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Class
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Class
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Class -> c Class
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Class -> c Class
Data, Class -> Class -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Class -> Class -> Bool
$c/= :: Class -> Class -> Bool
== :: Class -> Class -> Bool
$c== :: Class -> Class -> Bool
Eq, forall x. Rep Class x -> Class
forall x. Class -> Rep Class x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Class x -> Class
$cfrom :: forall x. Class -> Rep Class x
Generic, Eq Class
Class -> Class -> Bool
Class -> Class -> Ordering
Class -> Class -> Class
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Class -> Class -> Class
$cmin :: Class -> Class -> Class
max :: Class -> Class -> Class
$cmax :: Class -> Class -> Class
>= :: Class -> Class -> Bool
$c>= :: Class -> Class -> Bool
> :: Class -> Class -> Bool
$c> :: Class -> Class -> Bool
<= :: Class -> Class -> Bool
$c<= :: Class -> Class -> Bool
< :: Class -> Class -> Bool
$c< :: Class -> Class -> Bool
compare :: Class -> Class -> Ordering
$ccompare :: Class -> Class -> Ordering
Ord, Int -> Class -> ShowS
[Class] -> ShowS
Class -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Class] -> ShowS
$cshowList :: [Class] -> ShowS
show :: Class -> String
$cshow :: Class -> String
showsPrec :: Int -> Class -> ShowS
$cshowsPrec :: Int -> Class -> ShowS
Show)

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 {
    Hash -> Text
unHash :: Text -- ^ Obtain the name from the hash.
  } deriving (Typeable Hash
Hash -> DataType
Hash -> Constr
(forall b. Data b => b -> b) -> Hash -> Hash
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Hash -> u
forall u. (forall d. Data d => d -> u) -> Hash -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hash -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hash -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Hash -> m Hash
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hash -> m Hash
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Hash
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hash -> c Hash
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Hash)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Hash)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hash -> m Hash
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hash -> m Hash
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hash -> m Hash
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hash -> m Hash
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Hash -> m Hash
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Hash -> m Hash
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Hash -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Hash -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Hash -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Hash -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hash -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hash -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hash -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hash -> r
gmapT :: (forall b. Data b => b -> b) -> Hash -> Hash
$cgmapT :: (forall b. Data b => b -> b) -> Hash -> Hash
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Hash)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Hash)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Hash)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Hash)
dataTypeOf :: Hash -> DataType
$cdataTypeOf :: Hash -> DataType
toConstr :: Hash -> Constr
$ctoConstr :: Hash -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Hash
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Hash
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hash -> c Hash
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hash -> c Hash
Data, Hash -> Hash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hash -> Hash -> Bool
$c/= :: Hash -> Hash -> Bool
== :: Hash -> Hash -> Bool
$c== :: Hash -> Hash -> Bool
Eq, forall x. Rep Hash x -> Hash
forall x. Hash -> Rep Hash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hash x -> Hash
$cfrom :: forall x. Hash -> Rep Hash x
Generic, Eq Hash
Hash -> Hash -> Bool
Hash -> Hash -> Ordering
Hash -> Hash -> Hash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hash -> Hash -> Hash
$cmin :: Hash -> Hash -> Hash
max :: Hash -> Hash -> Hash
$cmax :: Hash -> Hash -> Hash
>= :: Hash -> Hash -> Bool
$c>= :: Hash -> Hash -> Bool
> :: Hash -> Hash -> Bool
$c> :: Hash -> Hash -> Bool
<= :: Hash -> Hash -> Bool
$c<= :: Hash -> Hash -> Bool
< :: Hash -> Hash -> Bool
$c< :: Hash -> Hash -> Bool
compare :: Hash -> Hash -> Ordering
$ccompare :: Hash -> Hash -> Ordering
Ord, Int -> Hash -> ShowS
[Hash] -> ShowS
Hash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hash] -> ShowS
$cshowList :: [Hash] -> ShowS
show :: Hash -> String
$cshow :: Hash -> String
showsPrec :: Int -> Hash -> ShowS
$cshowsPrec :: Int -> Hash -> ShowS
Show)

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'.
attributeCombinatorText :: AttributeCombinator -> Text
attributeCombinatorText AttributeCombinator
Exact = Text
"="
attributeCombinatorText AttributeCombinator
Include = Text
"~="
attributeCombinatorText AttributeCombinator
DashMatch = Text
"|="
attributeCombinatorText AttributeCombinator
PrefixMatch = Text
"^="
attributeCombinatorText AttributeCombinator
SuffixMatch = Text
"$="
attributeCombinatorText AttributeCombinator
SubstringMatch = Text
"*="

-- | The universal type selector: a selector that matches all types in all
--   namespaces (including the empty namespace). This pattern is bidirectional
--   and thus can be used in expressions as well.
pattern Universal :: TypeSelector
pattern $bUniversal :: TypeSelector
$mUniversal :: forall {r}. TypeSelector -> ((# #) -> r) -> ((# #) -> r) -> r
Universal = TypeSelector NAny EAny

-- Semigroup and Monoid instances
instance Semigroup SelectorSpecificity where
    SelectorSpecificity Int
a1 Int
b1 Int
c1 <> :: SelectorSpecificity -> SelectorSpecificity -> SelectorSpecificity
<> SelectorSpecificity Int
a2 Int
b2 Int
c2 = Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity (Int
a1forall a. Num a => a -> a -> a
+Int
a2) (Int
b1forall a. Num a => a -> a -> a
+Int
b2) (Int
c1forall a. Num a => a -> a -> a
+Int
c2)

instance Semigroup SelectorGroup where
    SelectorGroup NonEmpty Selector
g1 <> :: SelectorGroup -> SelectorGroup -> SelectorGroup
<> SelectorGroup NonEmpty Selector
g2 = NonEmpty Selector -> SelectorGroup
SelectorGroup (NonEmpty Selector
g1 forall a. Semigroup a => a -> a -> a
<> NonEmpty Selector
g2)

instance Semigroup Selector where
    <> :: Selector -> Selector -> Selector
(<>) = SelectorCombinator -> Selector -> Selector -> Selector
combine forall a. Default a => a
def

instance Semigroup Namespace where
    <> :: Namespace -> Namespace -> Namespace
(<>) Namespace
NAny = forall a. a -> a
id
    (<>) Namespace
x = forall a b. a -> b -> a
const Namespace
x

instance Semigroup ElementName where
    <> :: ElementName -> ElementName -> ElementName
(<>) ElementName
EAny = forall a. a -> a
id
    (<>) ElementName
x = forall a b. a -> b -> a
const ElementName
x

instance Monoid SelectorSpecificity where
    mempty :: SelectorSpecificity
mempty = Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity Int
0 Int
0 Int
0
#if __GLASGOW_HASKELL__ < 803
    mappend = (<>)
#endif

instance Monoid Namespace where
    mempty :: Namespace
mempty = Namespace
NAny
#if __GLASGOW_HASKELL__ < 803
    mappend = (<>)
#endif

instance Monoid ElementName where
    mempty :: ElementName
mempty = ElementName
EAny
#if __GLASGOW_HASKELL__ < 803
    mappend = (<>)
#endif

-- IsString instances
instance IsString Class where
    fromString :: String -> Class
fromString = forall a. (Text -> a) -> String -> a
toIdentifier Text -> Class
Class

instance IsString Hash where
    fromString :: String -> Hash
fromString = forall a. (Text -> a) -> String -> a
toIdentifier Text -> Hash
Hash

instance IsString Namespace where
    fromString :: String -> Namespace
fromString = forall a. (Text -> a) -> String -> a
toIdentifier Text -> Namespace
Namespace

instance IsString ElementName where
    fromString :: String -> ElementName
fromString = forall a. (Text -> a) -> String -> a
toIdentifier Text -> ElementName
ElementName

instance IsString AttributeName where
    fromString :: String -> AttributeName
fromString = forall a. (Text -> a) -> String -> a
toIdentifier (Namespace -> Text -> AttributeName
AttributeName Namespace
NAny)

instance IsString Attrib where
    fromString :: String -> Attrib
fromString = AttributeName -> Attrib
Exist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

instance IsString PseudoClass where
    fromString :: String -> PseudoClass
fromString = String -> PseudoClass
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
      where go :: String -> PseudoClass
go String
"active" = PseudoClass
Active
            go String
"checked" = PseudoClass
Checked
            go String
"default" = PseudoClass
Default
            go String
"disabled" = PseudoClass
Disabled
            go String
"empty" = PseudoClass
Empty
            go String
"enabled" = PseudoClass
Enabled
            go String
"first-child" = PseudoClass
FirstChild
            go String
"first-of-type" = PseudoClass
FirstOfType
            go String
"focus" = PseudoClass
Focus
            go String
"fullscreen" = PseudoClass
Fullscreen
            go String
"hover" = PseudoClass
Hover
            go String
"indeterminate" = PseudoClass
Indeterminate
            go String
"in-range" = PseudoClass
InRange
            go String
"invalid" = PseudoClass
Invalid
            go String
"last-child" = PseudoClass
LastChild
            go String
"last-of-type" = PseudoClass
LastOfType
            go String
"link" = PseudoClass
Link
            --  items with :lang(...) and :...(nth)
            go String
"only-of-type" = PseudoClass
OnlyOfType
            go String
"only-child" = PseudoClass
OnlyChild
            go String
"optional" = PseudoClass
Optional
            go String
"out-of-range" = PseudoClass
OutOfRange
            go String
"read-only"= PseudoClass
ReadOnly
            go String
"read-write" = PseudoClass
ReadWrite
            go String
"required" = PseudoClass
Required
            go String
"root" = PseudoClass
Root
            go String
"target" = PseudoClass
Target
            go String
"valid" = PseudoClass
Valid
            go String
"visited" = PseudoClass
Visited
            go String
x = forall a. HasCallStack => String -> a
error (String
"The pseudo class \"" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"\" is not a valid pseudo class.")

instance IsString ((->) Nth PseudoClass) where
  fromString :: String -> Nth -> PseudoClass
fromString = String -> Nth -> PseudoClass
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
    where go :: String -> Nth -> PseudoClass
go String
"nth-child" = Nth -> PseudoClass
NthChild
          go String
"nth-last-child" = Nth -> PseudoClass
NthLastChild
          go String
"nth-last-of-type" = Nth -> PseudoClass
NthLastOfType
          go String
"nth-of-type" = Nth -> PseudoClass
NthLastOfType
          go String
x = forall a. HasCallStack => String -> a
error (String
"There is no pseudo class \"" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"\" that takes an Nth object as parameter.")

instance IsString PseudoElement where
    fromString :: String -> PseudoElement
fromString = String -> PseudoElement
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
      where go :: String -> PseudoElement
go String
"after" = PseudoElement
After
            go String
"before" = PseudoElement
Before
            go String
"first-letter" = PseudoElement
FirstLetter
            go String
"first-line" = PseudoElement
FirstLine
            go String
"marker" = PseudoElement
Marker
            go String
"placeholder" = PseudoElement
Placeholder
            go String
"selection" = PseudoElement
Selection
            go String
x = forall a. HasCallStack => String -> a
error (String
"The pseudo element \"" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"\" is not a valid pseudo element.")


-- IsList instances
instance IsList SelectorGroup where
    type Item SelectorGroup = Selector
    fromList :: [Item SelectorGroup] -> SelectorGroup
fromList = NonEmpty Selector -> SelectorGroup
SelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList
    toList :: SelectorGroup -> [Item SelectorGroup]
toList (SelectorGroup NonEmpty Selector
ss) = forall l. IsList l => l -> [Item l]
toList NonEmpty Selector
ss

-- ToCssSelector instances
_textToPattern :: Text -> Pat
_textToPattern :: Text -> Pat
_textToPattern Text
t = Exp -> Pat -> Pat
ViewP (Exp -> Exp -> Exp
AppE (Name -> Exp
ConE '(==)) (Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'pack) (Lit -> Exp
LitE (String -> Lit
StringL (Text -> String
unpack Text
t))))) (Name -> Pat
_constantP 'True)

_constantP :: Name -> Pat
#if MIN_VERSION_template_haskell(2,18,0)
_constantP :: Name -> Pat
_constantP = forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> [Type] -> [Pat] -> Pat
`ConP` []) []
#else
_constantP = (`ConP` [])
#endif

_conP :: Name -> [Pat] -> Pat
#if MIN_VERSION_template_haskell(2,18,0)
_conP :: Name -> [Pat] -> Pat
_conP = (Name -> [Type] -> [Pat] -> Pat
`ConP` [])
#else
_conP = ConP
#endif


instance ToCssSelector SelectorGroup where
    toCssSelector :: SelectorGroup -> Text
toCssSelector (SelectorGroup NonEmpty Selector
g) = Text -> [Text] -> Text
intercalate Text
" , " (forall a b. (a -> b) -> [a] -> [b]
map forall a. ToCssSelector a => a -> Text
toCssSelector (forall l. IsList l => l -> [Item l]
toList NonEmpty Selector
g))
    toSelectorGroup :: SelectorGroup -> SelectorGroup
toSelectorGroup = forall a. a -> a
id
    specificity' :: SelectorGroup -> SelectorSpecificity
specificity' (SelectorGroup NonEmpty Selector
g) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' NonEmpty Selector
g
    toPattern :: SelectorGroup -> Pat
toPattern (SelectorGroup NonEmpty Selector
g) = Name -> [Pat] -> Pat
_conP 'SelectorGroup [forall {a}. ToCssSelector a => NonEmpty a -> Pat
go NonEmpty Selector
g]
        where go :: NonEmpty a -> Pat
go (a
x :| [a]
xs) = Name -> [Pat] -> Pat
_conP '(:|) [forall a. ToCssSelector a => a -> Pat
toPattern a
x, [Pat] -> Pat
ListP (forall a b. (a -> b) -> [a] -> [b]
map forall a. ToCssSelector a => a -> Pat
toPattern [a]
xs)]
    normalize :: SelectorGroup -> SelectorGroup
normalize (SelectorGroup NonEmpty Selector
g) = NonEmpty Selector -> SelectorGroup
SelectorGroup (forall a. Ord a => NonEmpty a -> NonEmpty a
Data.List.NonEmpty.sort (forall a. ToCssSelector a => a -> a
normalize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Selector
g))

instance ToCssSelector Class where
    toCssSelector :: Class -> Text
toCssSelector = Char -> Text -> Text
cons Char
'.' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
encodeIdentifier forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Text
unClass
    toSelectorGroup :: Class -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> SelectorFilter
SClass
    specificity' :: Class -> SelectorSpecificity
specificity' = forall a b. a -> b -> a
const (Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity Int
0 Int
1 Int
0)
    toPattern :: Class -> Pat
toPattern (Class Text
c) = Name -> [Pat] -> Pat
_conP 'Class [Text -> Pat
_textToPattern Text
c]

instance ToCssSelector Attrib where
    toCssSelector :: Attrib -> Text
toCssSelector (Exist AttributeName
name) = Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. ToCssSelector a => a -> Text
toCssSelector AttributeName
name forall a. Semigroup a => a -> a -> a
<> Text
"]"
    toCssSelector (Attrib AttributeName
name AttributeCombinator
op Text
val) = Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. ToCssSelector a => a -> Text
toCssSelector AttributeName
name forall a. Semigroup a => a -> a -> a
<> AttributeCombinator -> Text
attributeCombinatorText AttributeCombinator
op forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
encodeText Char
'"' Text
val forall a. Semigroup a => a -> a -> a
<> Text
"]"
    toSelectorGroup :: Attrib -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attrib -> SelectorFilter
SAttrib
    specificity' :: Attrib -> SelectorSpecificity
specificity' = forall a b. a -> b -> a
const (Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity Int
0 Int
1 Int
0)
    toPattern :: Attrib -> Pat
toPattern (Exist AttributeName
name) = Name -> [Pat] -> Pat
_conP 'Exist [forall a. ToCssSelector a => a -> Pat
toPattern AttributeName
name]
    toPattern (Attrib AttributeName
name AttributeCombinator
op Text
val) = Name -> [Pat] -> Pat
_conP 'Attrib [forall a. ToCssSelector a => a -> Pat
toPattern AttributeName
name, Name -> Pat
_constantP (AttributeCombinator -> Name
go AttributeCombinator
op), Text -> Pat
_textToPattern Text
val]
        where go :: AttributeCombinator -> Name
go AttributeCombinator
Exact = 'Exact
              go AttributeCombinator
Include = 'Include
              go AttributeCombinator
DashMatch = 'DashMatch
              go AttributeCombinator
PrefixMatch = 'PrefixMatch
              go AttributeCombinator
SuffixMatch = 'SuffixMatch
              go AttributeCombinator
SubstringMatch = 'SubstringMatch

instance ToCssSelector AttributeName where
    toCssSelector :: AttributeName -> Text
toCssSelector (AttributeName Namespace
NAny Text
e) = Text -> Text
encodeIdentifier Text
e
    toCssSelector (AttributeName Namespace
n Text
e) = forall a. ToCssSelector a => a -> Text
toCssSelector Namespace
n forall a. Semigroup a => a -> a -> a
<> Text
"|" forall a. Semigroup a => a -> a -> a
<> Text -> Text
encodeIdentifier Text
e
    toSelectorGroup :: AttributeName -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeName -> Attrib
Exist
    specificity' :: AttributeName -> SelectorSpecificity
specificity' = forall a. Monoid a => a
mempty
    toPattern :: AttributeName -> Pat
toPattern (AttributeName Namespace
n Text
a) = Name -> [Pat] -> Pat
_conP 'AttributeName [forall a. ToCssSelector a => a -> Pat
toPattern Namespace
n, Text -> Pat
_textToPattern Text
a]

instance ToCssSelector Hash where
    toCssSelector :: Hash -> Text
toCssSelector = Char -> Text -> Text
cons Char
'#' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
encodeIdentifier forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Text
unHash
    toSelectorGroup :: Hash -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> SelectorFilter
SHash
    specificity' :: Hash -> SelectorSpecificity
specificity' = forall a b. a -> b -> a
const (Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity Int
1 Int
0 Int
0)
    toPattern :: Hash -> Pat
toPattern (Hash Text
h) = Name -> [Pat] -> Pat
_conP 'Hash [Text -> Pat
_textToPattern Text
h]

instance ToCssSelector Namespace where
    toCssSelector :: Namespace -> Text
toCssSelector Namespace
NAny = Text
"*"
    toCssSelector (Namespace Text
t) = Text -> Text
encodeIdentifier Text
t
    toSelectorGroup :: Namespace -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Namespace -> ElementName -> TypeSelector
TypeSelector ElementName
EAny
    specificity' :: Namespace -> SelectorSpecificity
specificity' = forall a. Monoid a => a
mempty
    toPattern :: Namespace -> Pat
toPattern Namespace
NAny = Name -> Pat
_constantP 'NAny
    -- used to make patterns more readable
    toPattern Namespace
NEmpty = Name -> Pat
_constantP 'NEmpty
    toPattern (Namespace Text
t) = Name -> [Pat] -> Pat
_conP 'Namespace [Text -> Pat
_textToPattern Text
t]

instance ToCssSelector SelectorSequence where
    toCssSelector :: SelectorSequence -> Text
toCssSelector (SimpleSelector TypeSelector
s) = forall a. ToCssSelector a => a -> Text
toCssSelector TypeSelector
s
    toCssSelector (Filter SelectorSequence
s SelectorFilter
f) = forall a. ToCssSelector a => a -> Text
toCssSelector SelectorSequence
s forall a. Semigroup a => a -> a -> a
<> forall a. ToCssSelector a => a -> Text
toCssSelector SelectorFilter
f
    toSelectorGroup :: SelectorSequence -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorSequence -> PseudoSelectorSequence
Sequence
    specificity' :: SelectorSequence -> SelectorSpecificity
specificity' (SimpleSelector TypeSelector
s) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' TypeSelector
s
    specificity' (Filter SelectorSequence
s SelectorFilter
f) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' SelectorSequence
s forall a. Semigroup a => a -> a -> a
<> forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' SelectorFilter
f
    toPattern :: SelectorSequence -> Pat
toPattern (SimpleSelector TypeSelector
s) = Name -> [Pat] -> Pat
_conP 'SimpleSelector [forall a. ToCssSelector a => a -> Pat
toPattern TypeSelector
s]
    toPattern (Filter SelectorSequence
s SelectorFilter
f) = Name -> [Pat] -> Pat
_conP 'Filter [forall a. ToCssSelector a => a -> Pat
toPattern SelectorSequence
s, forall a. ToCssSelector a => a -> Pat
toPattern SelectorFilter
f]
    normalize :: SelectorSequence -> SelectorSequence
normalize = forall a b c. (a -> b -> c) -> b -> a -> c
flip SelectorSequence -> [SelectorFilter] -> SelectorSequence
go []
        where go :: SelectorSequence -> [SelectorFilter] -> SelectorSequence
go (Filter SelectorSequence
s SelectorFilter
f) = SelectorSequence -> [SelectorFilter] -> SelectorSequence
go SelectorSequence
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. ToCssSelector a => a -> a
normalize SelectorFilter
fforall a. a -> [a] -> [a]
:)
              go (SimpleSelector TypeSelector
s) = SelectorSequence -> [SelectorFilter] -> SelectorSequence
addFilters (TypeSelector -> SelectorSequence
SimpleSelector (forall a. ToCssSelector a => a -> a
normalize TypeSelector
s)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort

instance ToCssSelector TypeSelector where
    toCssSelector :: TypeSelector -> Text
toCssSelector (TypeSelector Namespace
NAny ElementName
e) = forall a. ToCssSelector a => a -> Text
toCssSelector ElementName
e
    toCssSelector (TypeSelector Namespace
n ElementName
e) = forall a. ToCssSelector a => a -> Text
toCssSelector Namespace
n forall a. Semigroup a => a -> a -> a
<> Text
"|" forall a. Semigroup a => a -> a -> a
<> forall a. ToCssSelector a => a -> Text
toCssSelector ElementName
e
    toSelectorGroup :: TypeSelector -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeSelector -> SelectorSequence
SimpleSelector
    specificity' :: TypeSelector -> SelectorSpecificity
specificity' (TypeSelector Namespace
_ ElementName
e) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' ElementName
e
    -- we use Universal, to make the generated pattern more convenient to read.
    toPattern :: TypeSelector -> Pat
toPattern TypeSelector
Universal = Name -> Pat
_constantP 'Universal
    toPattern (TypeSelector Namespace
n ElementName
t) = Name -> [Pat] -> Pat
_conP 'TypeSelector [forall a. ToCssSelector a => a -> Pat
toPattern Namespace
n, forall a. ToCssSelector a => a -> Pat
toPattern ElementName
t]

instance ToCssSelector ElementName where
    toCssSelector :: ElementName -> Text
toCssSelector ElementName
EAny = Text
"*"
    toCssSelector (ElementName Text
e) = Text -> Text
encodeIdentifier Text
e
    toSelectorGroup :: ElementName -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. Namespace -> ElementName -> TypeSelector
TypeSelector Namespace
NAny
    specificity' :: ElementName -> SelectorSpecificity
specificity' ElementName
EAny = forall a. Monoid a => a
mempty
    specificity' (ElementName Text
_) = Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity Int
0 Int
0 Int
1
    toPattern :: ElementName -> Pat
toPattern ElementName
EAny = Name -> Pat
_constantP 'EAny
    toPattern (ElementName Text
e) = Name -> [Pat] -> Pat
_conP 'ElementName [Text -> Pat
_textToPattern Text
e]

instance ToCssSelector SelectorFilter where
    toCssSelector :: SelectorFilter -> Text
toCssSelector (SHash Hash
h) = forall a. ToCssSelector a => a -> Text
toCssSelector Hash
h
    toCssSelector (SClass Class
c) = forall a. ToCssSelector a => a -> Text
toCssSelector Class
c
    toCssSelector (SAttrib Attrib
a) = forall a. ToCssSelector a => a -> Text
toCssSelector Attrib
a
    toCssSelector (SPseudo PseudoClass
p) = forall a. ToCssSelector a => a -> Text
toCssSelector PseudoClass
p
    toCssSelector (SNot Negation
n) = forall a. ToCssSelector a => a -> Text
toCssSelector Negation
n
    toSelectorGroup :: SelectorFilter -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorSequence -> SelectorFilter -> SelectorSequence
Filter (TypeSelector -> SelectorSequence
SimpleSelector TypeSelector
Universal)
    specificity' :: SelectorFilter -> SelectorSpecificity
specificity' (SHash Hash
h) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Hash
h
    specificity' (SClass Class
c) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Class
c
    specificity' (SAttrib Attrib
a) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Attrib
a
    specificity' (SPseudo PseudoClass
p) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' PseudoClass
p
    specificity' (SNot Negation
n) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Negation
n  -- Selectors inside the negation pseudo-class are counted like any other, but the negation itself does not count as a pseudo-class.
    toPattern :: SelectorFilter -> Pat
toPattern (SHash Hash
h) = Name -> [Pat] -> Pat
_conP 'SHash [forall a. ToCssSelector a => a -> Pat
toPattern Hash
h]
    toPattern (SClass Class
c) = Name -> [Pat] -> Pat
_conP 'SClass [forall a. ToCssSelector a => a -> Pat
toPattern Class
c]
    toPattern (SAttrib Attrib
a) = Name -> [Pat] -> Pat
_conP 'SAttrib [forall a. ToCssSelector a => a -> Pat
toPattern Attrib
a]
    toPattern (SPseudo PseudoClass
p) = Name -> [Pat] -> Pat
_conP 'SPseudo [forall a. ToCssSelector a => a -> Pat
toPattern PseudoClass
p]
    toPattern (SNot Negation
n) = Name -> [Pat] -> Pat
_conP 'SNot [forall a. ToCssSelector a => a -> Pat
toPattern Negation
n]

instance ToCssSelector Selector where
    toCssSelector :: Selector -> Text
toCssSelector (Selector PseudoSelectorSequence
s) = forall a. ToCssSelector a => a -> Text
toCssSelector PseudoSelectorSequence
s
    toCssSelector (Combined PseudoSelectorSequence
s1 SelectorCombinator
c Selector
s2) = forall a. ToCssSelector a => a -> Text
toCssSelector PseudoSelectorSequence
s1 forall a. Semigroup a => a -> a -> a
<> SelectorCombinator -> Text
combinatorText SelectorCombinator
c forall a. Semigroup a => a -> a -> a
<> forall a. ToCssSelector a => a -> Text
toCssSelector Selector
s2
    toSelectorGroup :: Selector -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Selector -> SelectorGroup
SelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    specificity' :: Selector -> SelectorSpecificity
specificity' (Selector PseudoSelectorSequence
s) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' PseudoSelectorSequence
s
    specificity' (Combined PseudoSelectorSequence
s1 SelectorCombinator
_ Selector
s2) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' PseudoSelectorSequence
s1 forall a. Semigroup a => a -> a -> a
<> forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Selector
s2
    toPattern :: Selector -> Pat
toPattern (Selector PseudoSelectorSequence
s) = Name -> [Pat] -> Pat
_conP 'Selector [forall a. ToCssSelector a => a -> Pat
toPattern PseudoSelectorSequence
s]
    toPattern (Combined PseudoSelectorSequence
s1 SelectorCombinator
c Selector
s2) = Name -> [Pat] -> Pat
_conP 'Combined [forall a. ToCssSelector a => a -> Pat
toPattern PseudoSelectorSequence
s1, Name -> Pat
_constantP (SelectorCombinator -> Name
go SelectorCombinator
c), forall a. ToCssSelector a => a -> Pat
toPattern Selector
s2]
        where go :: SelectorCombinator -> Name
go SelectorCombinator
Descendant = 'Descendant
              go SelectorCombinator
Child = 'Child
              go SelectorCombinator
DirectlyPreceded = 'DirectlyPreceded
              go SelectorCombinator
Preceded = 'Preceded
    normalize :: Selector -> Selector
normalize (Selector PseudoSelectorSequence
s) = PseudoSelectorSequence -> Selector
Selector (forall a. ToCssSelector a => a -> a
normalize PseudoSelectorSequence
s)
    normalize (Combined PseudoSelectorSequence
s1 SelectorCombinator
c Selector
s2) = PseudoSelectorSequence
-> SelectorCombinator -> Selector -> Selector
Combined (forall a. ToCssSelector a => a -> a
normalize PseudoSelectorSequence
s1) SelectorCombinator
c (forall a. ToCssSelector a => a -> a
normalize Selector
s2)

instance ToCssSelector PseudoSelectorSequence where
    toCssSelector :: PseudoSelectorSequence -> Text
toCssSelector (Sequence SelectorSequence
ss) = forall a. ToCssSelector a => a -> Text
toCssSelector SelectorSequence
ss
    toCssSelector (SelectorSequence
ss :.:: PseudoElement
pe)
      | forall a. Default a => a
def forall a. Eq a => a -> a -> Bool
== SelectorSequence
ss = forall a. ToCssSelector a => a -> Text
toCssSelector PseudoElement
pe
      | Bool
otherwise = forall a. ToCssSelector a => a -> Text
toCssSelector SelectorSequence
ss forall a. Semigroup a => a -> a -> a
<> forall a. ToCssSelector a => a -> Text
toCssSelector PseudoElement
pe
    toSelectorGroup :: PseudoSelectorSequence -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. PseudoSelectorSequence -> Selector
Selector
    specificity' :: PseudoSelectorSequence -> SelectorSpecificity
specificity' (Sequence SelectorSequence
ss) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' SelectorSequence
ss
    specificity' (SelectorSequence
ss :.:: PseudoElement
pe) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' SelectorSequence
ss forall a. Semigroup a => a -> a -> a
<> forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' PseudoElement
pe
    toPattern :: PseudoSelectorSequence -> Pat
toPattern (Sequence SelectorSequence
ss) = Name -> [Pat] -> Pat
_conP 'Sequence [forall a. ToCssSelector a => a -> Pat
toPattern SelectorSequence
ss]
    toPattern (SelectorSequence
ss :.:: PseudoElement
pe) = Name -> [Pat] -> Pat
_conP '(:.::) [forall a. ToCssSelector a => a -> Pat
toPattern SelectorSequence
ss, forall a. ToCssSelector a => a -> Pat
toPattern PseudoElement
pe]
    normalize :: PseudoSelectorSequence -> PseudoSelectorSequence
normalize (Sequence SelectorSequence
ss) = SelectorSequence -> PseudoSelectorSequence
Sequence (forall a. ToCssSelector a => a -> a
normalize SelectorSequence
ss)
    normalize (SelectorSequence
ss :.:: PseudoElement
pe) = forall a. ToCssSelector a => a -> a
normalize SelectorSequence
ss SelectorSequence -> PseudoElement -> PseudoSelectorSequence
:.:: forall a. ToCssSelector a => a -> a
normalize PseudoElement
pe

_nthToPat :: Nth -> Pat
_nthToPat :: Nth -> Pat
_nthToPat (Nth Int
n Int
b) = Name -> [Pat] -> Pat
_conP 'Nth [Int -> Pat
f Int
n, Int -> Pat
f Int
b]
    where f :: Int -> Pat
f = Lit -> Pat
LitP forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
IntegerL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToCssSelector PseudoClass where
    toCssSelector :: PseudoClass -> Text
toCssSelector = Char -> Text -> Text
cons Char
':' forall b c a. (b -> c) -> (a -> b) -> a -> c
. PseudoClass -> Text
go
      where go :: PseudoClass -> Text
go PseudoClass
Active = Text
"active"
            go PseudoClass
Checked = Text
"checked"
            go PseudoClass
Default = Text
"default"
            go PseudoClass
Disabled = Text
"disabled"
            go PseudoClass
Empty = Text
"empty"
            go PseudoClass
Enabled = Text
"enabled"
            go PseudoClass
Focus = Text
"focus"
            go PseudoClass
Fullscreen = Text
"fullscreen"
            go PseudoClass
Hover = Text
"hover"
            go PseudoClass
Indeterminate = Text
"indeterminate"
            go PseudoClass
InRange = Text
"in-range"
            go PseudoClass
Invalid = Text
"invalid"
            go PseudoClass
Link = Text
"link"
            go (Lang Text
l) = Text
"lang(" forall a. Semigroup a => a -> a -> a
<> Text
l forall a. Semigroup a => a -> a -> a
<> Text
")"
            go PseudoClass
FirstChild = Text
"first-child"
            go (NthChild Nth
nth) = Text
"nth-child(" forall a. Semigroup a => a -> a -> a
<> Nth -> Text
nthToText Nth
nth forall a. Semigroup a => a -> a -> a
<> Text
")"
            go PseudoClass
LastChild = Text
"last-child"
            go (NthLastChild Nth
nth) = Text
"nth-last-child(" forall a. Semigroup a => a -> a -> a
<> Nth -> Text
nthToText Nth
nth forall a. Semigroup a => a -> a -> a
<> Text
")"
            go PseudoClass
LastOfType = Text
"last-of-type"
            go (NthLastOfType Nth
nth) = Text
"nth-last-of-type(" forall a. Semigroup a => a -> a -> a
<> Nth -> Text
nthToText Nth
nth forall a. Semigroup a => a -> a -> a
<> Text
")"
            go PseudoClass
FirstOfType = Text
"first-of-type"
            go (NthOfType Nth
nth) = Text
"nth-of-type(" forall a. Semigroup a => a -> a -> a
<> Nth -> Text
nthToText Nth
nth forall a. Semigroup a => a -> a -> a
<> Text
")"
            go PseudoClass
OnlyOfType = Text
"only-of-type"
            go PseudoClass
OnlyChild = Text
"only-child"
            go PseudoClass
Optional = Text
"optional"
            go PseudoClass
OutOfRange = Text
"out-of-range"
            go PseudoClass
ReadOnly = Text
"read-only"
            go PseudoClass
ReadWrite = Text
"read-write"
            go PseudoClass
Required = Text
"required"
            go PseudoClass
Root = Text
"root"
            go PseudoClass
Target = Text
"target"
            go PseudoClass
Valid = Text
"valid"
            go PseudoClass
Visited = Text
"visited"

    specificity' :: PseudoClass -> SelectorSpecificity
specificity' = forall a b. a -> b -> a
const (Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity Int
0 Int
1 Int
0)
    toSelectorGroup :: PseudoClass -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. PseudoClass -> SelectorFilter
SPseudo
    toPattern :: PseudoClass -> Pat
toPattern PseudoClass
Active = Name -> Pat
_constantP 'Active
    toPattern PseudoClass
Checked = Name -> Pat
_constantP 'Checked
    toPattern PseudoClass
Default = Name -> Pat
_constantP 'Default
    toPattern PseudoClass
Disabled = Name -> Pat
_constantP 'Disabled
    toPattern PseudoClass
Empty = Name -> Pat
_constantP 'Empty
    toPattern PseudoClass
Enabled = Name -> Pat
_constantP 'Enabled
    toPattern PseudoClass
Focus = Name -> Pat
_constantP 'Focus
    toPattern PseudoClass
Fullscreen = Name -> Pat
_constantP 'Fullscreen
    toPattern PseudoClass
Hover = Name -> Pat
_constantP 'Hover
    toPattern PseudoClass
Indeterminate = Name -> Pat
_constantP 'Indeterminate
    toPattern PseudoClass
InRange = Name -> Pat
_constantP 'InRange
    toPattern PseudoClass
Invalid = Name -> Pat
_constantP 'Invalid
    toPattern PseudoClass
Link = Name -> Pat
_constantP 'Link
    toPattern (Lang Text
l) = Name -> [Pat] -> Pat
_conP 'Lang [Text -> Pat
_textToPattern Text
l]
    toPattern (NthChild Nth
nth) = Name -> [Pat] -> Pat
_conP 'NthChild [Nth -> Pat
_nthToPat Nth
nth]
    toPattern (NthLastChild Nth
nth) = Name -> [Pat] -> Pat
_conP 'NthLastChild [Nth -> Pat
_nthToPat Nth
nth]
    toPattern (NthLastOfType Nth
nth) = Name -> [Pat] -> Pat
_conP 'NthLastOfType [Nth -> Pat
_nthToPat Nth
nth]
    toPattern (NthOfType Nth
nth) = Name -> [Pat] -> Pat
_conP 'NthOfType [Nth -> Pat
_nthToPat Nth
nth]
    toPattern PseudoClass
OnlyOfType = Name -> Pat
_constantP 'OnlyOfType
    toPattern PseudoClass
OnlyChild = Name -> Pat
_constantP 'OnlyChild
    toPattern PseudoClass
Optional = Name -> Pat
_constantP 'Optional
    toPattern PseudoClass
OutOfRange = Name -> Pat
_constantP 'OutOfRange
    toPattern PseudoClass
ReadOnly = Name -> Pat
_constantP 'ReadOnly
    toPattern PseudoClass
ReadWrite = Name -> Pat
_constantP 'ReadWrite
    toPattern PseudoClass
Required = Name -> Pat
_constantP 'Required
    toPattern PseudoClass
Root = Name -> Pat
_constantP 'Root
    toPattern PseudoClass
Target = Name -> Pat
_constantP 'Target
    toPattern PseudoClass
Valid = Name -> Pat
_constantP 'Valid
    toPattern PseudoClass
Visited = Name -> Pat
_constantP 'Visited
    normalize :: PseudoClass -> PseudoClass
normalize (NthChild Nth
nth) = Nth -> PseudoClass
NthChild (Nth -> Nth
normalizeNth Nth
nth)
    normalize (NthLastChild Nth
nth) = Nth -> PseudoClass
NthLastChild (Nth -> Nth
normalizeNth Nth
nth)
    normalize (NthLastOfType Nth
nth) = Nth -> PseudoClass
NthLastOfType (Nth -> Nth
normalizeNth Nth
nth)
    normalize (NthOfType Nth
nth) = Nth -> PseudoClass
NthOfType (Nth -> Nth
normalizeNth Nth
nth)
    normalize PseudoClass
pc = PseudoClass
pc

instance ToCssSelector Negation where
    toCssSelector :: Negation -> Text
toCssSelector Negation
n = Text
":not("forall a. Semigroup a => a -> a -> a
<> Negation -> Text
go Negation
n forall a. Semigroup a => a -> a -> a
<> Text
")"
      where go :: Negation -> Text
go (NTypeSelector TypeSelector
t) = forall a. ToCssSelector a => a -> Text
toCssSelector TypeSelector
t
            go (NHash Hash
h) = forall a. ToCssSelector a => a -> Text
toCssSelector Hash
h
            go (NClass Class
c) = forall a. ToCssSelector a => a -> Text
toCssSelector Class
c
            go (NAttrib Attrib
a) = forall a. ToCssSelector a => a -> Text
toCssSelector Attrib
a
            go (NPseudo PseudoClass
p) = forall a. ToCssSelector a => a -> Text
toCssSelector PseudoClass
p
            go (NPseudoElement PseudoElement
p) = forall a. ToCssSelector a => a -> Text
toCssSelector PseudoElement
p
    toSelectorGroup :: Negation -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. Negation -> SelectorFilter
SNot
    specificity' :: Negation -> SelectorSpecificity
specificity' (NTypeSelector TypeSelector
t) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' TypeSelector
t
    specificity' (NHash Hash
h) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Hash
h
    specificity' (NClass Class
c) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Class
c
    specificity' (NAttrib Attrib
a) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Attrib
a
    specificity' (NPseudo PseudoClass
p) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' PseudoClass
p
    specificity' (NPseudoElement PseudoElement
p) = forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' PseudoElement
p
    toPattern :: Negation -> Pat
toPattern (NTypeSelector TypeSelector
t) = Name -> [Pat] -> Pat
_conP 'NTypeSelector [forall a. ToCssSelector a => a -> Pat
toPattern TypeSelector
t]
    toPattern (NHash Hash
h) = Name -> [Pat] -> Pat
_conP 'NHash [forall a. ToCssSelector a => a -> Pat
toPattern Hash
h]
    toPattern (NClass Class
c) = Name -> [Pat] -> Pat
_conP 'NClass [forall a. ToCssSelector a => a -> Pat
toPattern Class
c]
    toPattern (NAttrib Attrib
a) = Name -> [Pat] -> Pat
_conP 'NAttrib [forall a. ToCssSelector a => a -> Pat
toPattern Attrib
a]
    toPattern (NPseudo PseudoClass
p) = Name -> [Pat] -> Pat
_conP 'NPseudo [forall a. ToCssSelector a => a -> Pat
toPattern PseudoClass
p]
    toPattern (NPseudoElement PseudoElement
p) = Name -> [Pat] -> Pat
_conP 'NPseudoElement [forall a. ToCssSelector a => a -> Pat
toPattern PseudoElement
p]

instance ToCssSelector PseudoElement where
    toCssSelector :: PseudoElement -> Text
toCssSelector = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
':' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
':' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. IsString a => PseudoElement -> a
go
      where go :: PseudoElement -> a
go PseudoElement
After = a
"after"
            go PseudoElement
Before = a
"before"
            go PseudoElement
FirstLetter = a
"first-letter"
            go PseudoElement
FirstLine = a
"first-line"
            go PseudoElement
Marker = a
"marker"
            go PseudoElement
Placeholder = a
"placeholder"
            go PseudoElement
Selection = a
"selection"
    specificity' :: PseudoElement -> SelectorSpecificity
specificity' = forall a b. a -> b -> a
const (Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity Int
0 Int
0 Int
1)
    toSelectorGroup :: PseudoElement -> SelectorGroup
toSelectorGroup = forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Default a => a
def SelectorSequence -> PseudoElement -> PseudoSelectorSequence
:.::)
    toPattern :: PseudoElement -> Pat
toPattern = Name -> Pat
_constantP forall b c a. (b -> c) -> (a -> b) -> a -> c
. PseudoElement -> Name
go
      where go :: PseudoElement -> Name
go PseudoElement
After = 'After
            go PseudoElement
Before = 'Before
            go PseudoElement
FirstLetter = 'FirstLetter
            go PseudoElement
FirstLine = 'FirstLine
            go PseudoElement
Marker = 'Marker
            go PseudoElement
Placeholder = 'Placeholder
            go PseudoElement
Selection = 'Selection

-- Custom Eq and Ord instances
instance Eq SelectorSpecificity where
    == :: SelectorSpecificity -> SelectorSpecificity -> Bool
(==) = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) SelectorSpecificity -> Int
specificityValue

instance Ord SelectorSpecificity where
    compare :: SelectorSpecificity -> SelectorSpecificity -> Ordering
compare = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing SelectorSpecificity -> Int
specificityValue

-- Default instances
instance Default SelectorGroup where
    def :: SelectorGroup
def = NonEmpty Selector -> SelectorGroup
SelectorGroup (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Default a => a
def)

instance Default Selector where
    def :: Selector
def = PseudoSelectorSequence -> Selector
Selector forall a. Default a => a
def

instance Default PseudoSelectorSequence where
    def :: PseudoSelectorSequence
def = SelectorSequence -> PseudoSelectorSequence
Sequence forall a. Default a => a
def

instance Default SelectorSequence where
    def :: SelectorSequence
def = TypeSelector -> SelectorSequence
SimpleSelector forall a. Default a => a
def

instance Default TypeSelector where
    def :: TypeSelector
def = TypeSelector
Universal

instance Default SelectorSpecificity where
    def :: SelectorSpecificity
def = forall a. Monoid a => a
mempty

instance Default Namespace where
    def :: Namespace
def = Namespace
NAny

instance Default ElementName where
    def :: ElementName
def = ElementName
EAny

instance Default SelectorCombinator where
    def :: SelectorCombinator
def = SelectorCombinator
Descendant

instance Default AttributeCombinator where
    def :: AttributeCombinator
def = AttributeCombinator
Exact

-- | The default of the Nth instance is @n@, where all childs are selected.
instance Default Nth where
    def :: Nth
def = Int -> Int -> Nth
Nth Int
1 Int
0

-- Binary instance
_putEnum :: Enum a => a -> Put
_putEnum :: forall a. Enum a => a -> Put
_putEnum = Word8 -> Put
putWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

_getEnum :: Enum a => Get a
_getEnum :: forall a. Enum a => Get a
_getEnum = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

instance Binary Nth where
  put :: Nth -> Put
put (Nth Int
n Int
b) = forall t. Binary t => t -> Put
put Int
n forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Int
b
  get :: Get Nth
get = Int -> Int -> Nth
Nth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get

instance Binary SelectorSpecificity where
  put :: SelectorSpecificity -> Put
put (SelectorSpecificity Int
a Int
b Int
c) = forall t. Binary t => t -> Put
put Int
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Int
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Int
c
  get :: Get SelectorSpecificity
get = Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get

instance Binary Selector where
  put :: Selector -> Put
put (Selector PseudoSelectorSequence
c) = Word8 -> Put
putWord8 Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put PseudoSelectorSequence
c
  put (Combined PseudoSelectorSequence
c SelectorCombinator
sc Selector
cs) = Word8 -> Put
putWord8 Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put PseudoSelectorSequence
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put SelectorCombinator
sc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Selector
cs
  get :: Get Selector
get = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
      Word8
0 -> PseudoSelectorSequence -> Selector
Selector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
1 -> PseudoSelectorSequence
-> SelectorCombinator -> Selector -> Selector
Combined forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
      Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An error occured while deserializing a Selector object."

instance Binary PseudoSelectorSequence where
  put :: PseudoSelectorSequence -> Put
put (Sequence SelectorSequence
ss) = Word8 -> Put
putWord8 Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put SelectorSequence
ss
  put (SelectorSequence
ss :.:: PseudoElement
pe) = Word8 -> Put
putWord8 Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put SelectorSequence
ss forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put PseudoElement
pe
  get :: Get PseudoSelectorSequence
get = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
      Word8
0 -> SelectorSequence -> PseudoSelectorSequence
Sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
1 -> SelectorSequence -> PseudoElement -> PseudoSelectorSequence
(:.::) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
      Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An error occured while deserializing a PseudoSelectorSequence."

instance Binary PseudoClass where
  put :: PseudoClass -> Put
put PseudoClass
Active = Word8 -> Put
putWord8 Word8
0
  put PseudoClass
Checked = Word8 -> Put
putWord8 Word8
1
  put PseudoClass
Default = Word8 -> Put
putWord8 Word8
2
  put PseudoClass
Disabled = Word8 -> Put
putWord8 Word8
3
  put PseudoClass
Empty = Word8 -> Put
putWord8 Word8
4
  put PseudoClass
Enabled = Word8 -> Put
putWord8 Word8
5
  put PseudoClass
Focus = Word8 -> Put
putWord8 Word8
6
  put PseudoClass
Fullscreen = Word8 -> Put
putWord8 Word8
7
  put PseudoClass
Hover = Word8 -> Put
putWord8 Word8
8
  put PseudoClass
Indeterminate = Word8 -> Put
putWord8 Word8
9
  put PseudoClass
InRange = Word8 -> Put
putWord8 Word8
10
  put PseudoClass
Invalid = Word8 -> Put
putWord8 Word8
11
  put (Lang Text
l) = Word8 -> Put
putWord8 Word8
12 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Text
l
  put PseudoClass
Link = Word8 -> Put
putWord8 Word8
13
  put (NthChild Nth
nth) = Word8 -> Put
putWord8 Word8
14 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Nth
nth
  put (NthLastChild Nth
nth) = Word8 -> Put
putWord8 Word8
15 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Nth
nth
  put (NthLastOfType Nth
nth) = Word8 -> Put
putWord8 Word8
16 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Nth
nth
  put (NthOfType Nth
nth) = Word8 -> Put
putWord8 Word8
17 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Nth
nth
  put PseudoClass
OnlyOfType = Word8 -> Put
putWord8 Word8
18
  put PseudoClass
OnlyChild = Word8 -> Put
putWord8 Word8
19
  put PseudoClass
Optional = Word8 -> Put
putWord8 Word8
20
  put PseudoClass
OutOfRange = Word8 -> Put
putWord8 Word8
21
  put PseudoClass
ReadOnly = Word8 -> Put
putWord8 Word8
22
  put PseudoClass
ReadWrite = Word8 -> Put
putWord8 Word8
23
  put PseudoClass
Required = Word8 -> Put
putWord8 Word8
24
  put PseudoClass
Root = Word8 -> Put
putWord8 Word8
25
  put PseudoClass
Target = Word8 -> Put
putWord8 Word8
26
  put PseudoClass
Valid = Word8 -> Put
putWord8 Word8
27
  put PseudoClass
Visited = Word8 -> Put
putWord8 Word8
28

  get :: Get PseudoClass
get = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
      Word8
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Active
      Word8
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Checked
      Word8
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Default
      Word8
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Disabled
      Word8
4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Empty
      Word8
5 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Enabled
      Word8
6 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Focus
      Word8
7 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Fullscreen
      Word8
8 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Hover
      Word8
9 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Indeterminate
      Word8
10 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
InRange
      Word8
11 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Invalid
      Word8
12 -> Text -> PseudoClass
Lang forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
13 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Link
      Word8
14 -> Nth -> PseudoClass
NthChild forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
15 -> Nth -> PseudoClass
NthLastChild forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
16 -> Nth -> PseudoClass
NthLastOfType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
17 -> Nth -> PseudoClass
NthOfType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
18 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
OnlyOfType
      Word8
19 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
OnlyChild
      Word8
20 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Optional
      Word8
21 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
OutOfRange
      Word8
22 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
ReadOnly
      Word8
23 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
ReadWrite
      Word8
24 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Required
      Word8
25 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Root
      Word8
26 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Target
      Word8
27 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Valid
      Word8
28 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Visited
      Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An error occured while deserialzing a PseudoClass object."


instance Binary PseudoElement where
  put :: PseudoElement -> Put
put = forall a. Enum a => a -> Put
_putEnum
  get :: Get PseudoElement
get = forall a. Enum a => Get a
_getEnum

instance Binary SelectorCombinator where
  put :: SelectorCombinator -> Put
put = forall a. Enum a => a -> Put
_putEnum
  get :: Get SelectorCombinator
get = forall a. Enum a => Get a
_getEnum

instance Binary SelectorSequence where
  put :: SelectorSequence -> Put
put (SimpleSelector TypeSelector
ts) = Word8 -> Put
putWord8 Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put TypeSelector
ts
  put (Filter SelectorSequence
ss SelectorFilter
sf) = Word8 -> Put
putWord8 Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put SelectorSequence
ss forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put SelectorFilter
sf
  get :: Get SelectorSequence
get = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
      Word8
0 -> TypeSelector -> SelectorSequence
SimpleSelector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
1 -> SelectorSequence -> SelectorFilter -> SelectorSequence
Filter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
      Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An error occured while deserializing a Selector object."

instance Binary SelectorFilter where
  put :: SelectorFilter -> Put
put (SHash Hash
h) = Word8 -> Put
putWord8 Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Hash
h
  put (SClass Class
c) = Word8 -> Put
putWord8 Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Class
c
  put (SAttrib Attrib
a) = Word8 -> Put
putWord8 Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Attrib
a
  put (SPseudo PseudoClass
p) = Word8 -> Put
putWord8 Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put PseudoClass
p
  put (SNot Negation
n) = Word8 -> Put
putWord8 Word8
4 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Negation
n
  get :: Get SelectorFilter
get = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
      Word8
0 -> Hash -> SelectorFilter
SHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
1 -> Class -> SelectorFilter
SClass forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
2 -> Attrib -> SelectorFilter
SAttrib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
3 -> PseudoClass -> SelectorFilter
SPseudo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
4 -> Negation -> SelectorFilter
SNot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An error occurred when deserializing a SelectorFilter object."

instance Binary Negation where
  put :: Negation -> Put
put (NTypeSelector TypeSelector
t) = Word8 -> Put
putWord8 Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put TypeSelector
t
  put (NHash Hash
h) = Word8 -> Put
putWord8 Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Hash
h
  put (NClass Class
c) = Word8 -> Put
putWord8 Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Class
c
  put (NAttrib Attrib
a) = Word8 -> Put
putWord8 Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Attrib
a
  put (NPseudo PseudoClass
p) = Word8 -> Put
putWord8 Word8
4 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put PseudoClass
p
  put (NPseudoElement PseudoElement
p) = Word8 -> Put
putWord8 Word8
5 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put PseudoElement
p
  get :: Get Negation
get = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
      Word8
0 -> TypeSelector -> Negation
NTypeSelector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
1 -> Hash -> Negation
NHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
2 -> Class -> Negation
NClass forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
3 -> Attrib -> Negation
NAttrib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
4 -> PseudoClass -> Negation
NPseudo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
5 -> PseudoElement -> Negation
NPseudoElement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An error occurred when deserializing a Negation object."


instance Binary Attrib where
  put :: Attrib -> Put
put (Exist AttributeName
e) = Word8 -> Put
putWord8 Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put AttributeName
e
  put (Attrib AttributeName
an AttributeCombinator
ac Text
av) = Word8 -> Put
putWord8 Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put AttributeName
an forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put AttributeCombinator
ac forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Text
av
  get :: Get Attrib
get = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
      Word8
0 -> AttributeName -> Attrib
Exist forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
1 -> AttributeName -> AttributeCombinator -> Text -> Attrib
Attrib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
      Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An error occured when deserializing an Attrib object."

instance Binary Namespace where
  put :: Namespace -> Put
put Namespace
NAny = Word8 -> Put
putWord8 Word8
0
  put (Namespace Text
t) = Word8 -> Put
putWord8 Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Text
t
  get :: Get Namespace
get = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
      Word8
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Namespace
NAny
      Word8
1 -> Text -> Namespace
Namespace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An error occurred when deserializing a Namespace object."

instance Binary ElementName where
  put :: ElementName -> Put
put ElementName
EAny = Word8 -> Put
putWord8 Word8
0
  put (ElementName Text
t) = Word8 -> Put
putWord8 Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Text
t
  get :: Get ElementName
get = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
      Word8
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ElementName
EAny
      Word8
1 -> Text -> ElementName
ElementName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An error occurred when deserializing an ElementName."

instance Binary TypeSelector where
  put :: TypeSelector -> Put
put (TypeSelector Namespace
ns ElementName
en) = forall t. Binary t => t -> Put
put Namespace
ns forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put ElementName
en
  get :: Get TypeSelector
get = Namespace -> ElementName -> TypeSelector
TypeSelector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get

instance Binary AttributeName where
  put :: AttributeName -> Put
put (AttributeName Namespace
ns Text
n) = forall t. Binary t => t -> Put
put Namespace
ns forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Text
n
  get :: Get AttributeName
get = Namespace -> Text -> AttributeName
AttributeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get

instance Binary AttributeCombinator where
  put :: AttributeCombinator -> Put
put = forall a. Enum a => a -> Put
_putEnum
  get :: Get AttributeCombinator
get = forall a. Enum a => Get a
_getEnum

instance Binary Hash where
  put :: Hash -> Put
put (Hash Text
h) = forall t. Binary t => t -> Put
put Text
h
  get :: Get Hash
get = Text -> Hash
Hash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

instance Binary Class where
  put :: Class -> Put
put (Class Text
h) = forall t. Binary t => t -> Put
put Text
h
  get :: Get Class
get = Text -> Class
Class forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

instance Binary SelectorGroup where
  put :: SelectorGroup -> Put
put (SelectorGroup NonEmpty Selector
g) = forall t. Binary t => t -> Put
put NonEmpty Selector
g
  get :: Get SelectorGroup
get = NonEmpty Selector -> SelectorGroup
SelectorGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
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 :: forall (m :: * -> *). Quote m => Name -> [m Exp] -> m Exp
_apply = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Quote m => Name -> m Exp
conE

instance Lift SelectorGroup where
    lift :: forall (m :: * -> *). Quote m => SelectorGroup -> m Exp
lift (SelectorGroup NonEmpty Selector
sg) = forall (m :: * -> *). Quote m => Name -> [m Exp] -> m Exp
_apply 'SelectorGroup [forall {m :: * -> *} {t}. (Quote m, Lift t) => NonEmpty t -> m Exp
liftNe NonEmpty Selector
sg]
        where liftNe :: NonEmpty t -> m Exp
liftNe (t
a :| [t]
as) = forall (m :: * -> *). Quote m => Name -> [m Exp] -> m Exp
_apply '(:|) [forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift t
a, forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift [t]
as]
#if MIN_VERSION_template_haskell(2,17,0)
    liftTyped :: forall (m :: * -> *).
Quote m =>
SelectorGroup -> Code m SelectorGroup
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
    liftTyped = unsafeTExpCoerce . lift
#endif

instance Lift Selector where
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *). Quote m => Selector -> Code m Selector
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = unsafeTExpCoerce . lift
#endif

instance Lift SelectorCombinator where
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *).
Quote m =>
SelectorCombinator -> Code m SelectorCombinator
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = unsafeTExpCoerce . lift
#endif

instance Lift SelectorSequence where
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *).
Quote m =>
SelectorSequence -> Code m SelectorSequence
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = unsafeTExpCoerce . lift
#endif

instance Lift SelectorFilter where
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *).
Quote m =>
SelectorFilter -> Code m SelectorFilter
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = unsafeTExpCoerce . lift
#endif

instance Lift Attrib where
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *). Quote m => Attrib -> Code m Attrib
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = unsafeTExpCoerce . lift
#endif

instance Lift PseudoSelectorSequence where
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *).
Quote m =>
PseudoSelectorSequence -> Code m PseudoSelectorSequence
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
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 :: forall (m :: * -> *). Quote m => PseudoClass -> Code m PseudoClass
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
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 :: forall (m :: * -> *).
Quote m =>
PseudoElement -> Code m PseudoElement
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
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 :: forall (m :: * -> *). Quote m => Nth -> Code m Nth
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
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 :: forall (m :: * -> *). Quote m => Negation -> Code m Negation
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = unsafeTExpCoerce . lift
#endif

-- ToMarkup instances
_cssToMarkup :: ToCssSelector a => a -> Markup
_cssToMarkup :: forall a. ToCssSelector a => a -> Markup
_cssToMarkup = Text -> Markup
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCssSelector a => a -> Text
toCssSelector

instance ToMarkup SelectorGroup where
    toMarkup :: SelectorGroup -> Markup
toMarkup = forall a. ToCssSelector a => a -> Markup
_cssToMarkup

instance ToMarkup Selector where
    toMarkup :: Selector -> Markup
toMarkup = forall a. ToCssSelector a => a -> Markup
_cssToMarkup

instance ToMarkup SelectorSequence where
    toMarkup :: SelectorSequence -> Markup
toMarkup = forall a. ToCssSelector a => a -> Markup
_cssToMarkup

instance ToMarkup PseudoSelectorSequence where
    toMarkup :: PseudoSelectorSequence -> Markup
toMarkup = forall a. ToCssSelector a => a -> Markup
_cssToMarkup

instance ToMarkup PseudoClass where
    toMarkup :: PseudoClass -> Markup
toMarkup = forall a. ToCssSelector a => a -> Markup
_cssToMarkup

instance ToMarkup PseudoElement where
    toMarkup :: PseudoElement -> Markup
toMarkup = forall a. ToCssSelector a => a -> Markup
_cssToMarkup

instance ToMarkup SelectorFilter where
    toMarkup :: SelectorFilter -> Markup
toMarkup = forall a. ToCssSelector a => a -> Markup
_cssToMarkup

instance ToMarkup Attrib where
    toMarkup :: Attrib -> Markup
toMarkup = forall a. ToCssSelector a => a -> Markup
_cssToMarkup

instance ToMarkup Negation where
    toMarkup :: Negation -> Markup
toMarkup = forall a. ToCssSelector a => a -> Markup
_cssToMarkup

-- ToJavaScript and ToJson instances
_cssToJavascript :: ToCssSelector a => a -> Javascript
#if __GLASGOW_HASKELL__ < 803
_cssToJavascript = toJavascript . toJSON . toCssSelector
#else
_cssToJavascript :: forall a. ToCssSelector a => a -> Javascript
_cssToJavascript = forall a. ToJavascript a => a -> Javascript
toJavascript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCssSelector a => a -> Text
toCssSelector
#endif

_cssToJson :: ToCssSelector a => a -> Value
_cssToJson :: forall a. ToCssSelector a => a -> Value
_cssToJson = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCssSelector a => a -> Text
toCssSelector

instance ToJavascript SelectorGroup where
    toJavascript :: SelectorGroup -> Javascript
toJavascript = forall a. ToCssSelector a => a -> Javascript
_cssToJavascript

instance ToJavascript Selector where
    toJavascript :: Selector -> Javascript
toJavascript = forall a. ToCssSelector a => a -> Javascript
_cssToJavascript

instance ToJavascript SelectorSequence where
    toJavascript :: SelectorSequence -> Javascript
toJavascript = forall a. ToCssSelector a => a -> Javascript
_cssToJavascript

instance ToJavascript PseudoSelectorSequence where
    toJavascript :: PseudoSelectorSequence -> Javascript
toJavascript = forall a. ToCssSelector a => a -> Javascript
_cssToJavascript

instance ToJavascript PseudoClass where
    toJavascript :: PseudoClass -> Javascript
toJavascript = forall a. ToCssSelector a => a -> Javascript
_cssToJavascript

instance ToJavascript PseudoElement where
    toJavascript :: PseudoElement -> Javascript
toJavascript = forall a. ToCssSelector a => a -> Javascript
_cssToJavascript

instance ToJavascript SelectorFilter where
    toJavascript :: SelectorFilter -> Javascript
toJavascript = forall a. ToCssSelector a => a -> Javascript
_cssToJavascript

instance ToJavascript Attrib where
    toJavascript :: Attrib -> Javascript
toJavascript = forall a. ToCssSelector a => a -> Javascript
_cssToJavascript

instance ToJavascript Negation where
    toJavascript :: Negation -> Javascript
toJavascript = forall a. ToCssSelector a => a -> Javascript
_cssToJavascript

instance ToJSON SelectorGroup where
    toJSON :: SelectorGroup -> Value
toJSON = forall a. ToCssSelector a => a -> Value
_cssToJson

instance ToJSON Selector where
    toJSON :: Selector -> Value
toJSON = forall a. ToCssSelector a => a -> Value
_cssToJson

instance ToJSON SelectorSequence where
    toJSON :: SelectorSequence -> Value
toJSON = forall a. ToCssSelector a => a -> Value
_cssToJson

instance ToJSON SelectorFilter where
    toJSON :: SelectorFilter -> Value
toJSON = forall a. ToCssSelector a => a -> Value
_cssToJson

instance ToJSON PseudoSelectorSequence where
    toJSON :: PseudoSelectorSequence -> Value
toJSON = forall a. ToCssSelector a => a -> Value
_cssToJson

instance ToJSON PseudoClass where
    toJSON :: PseudoClass -> Value
toJSON = forall a. ToCssSelector a => a -> Value
_cssToJson

instance ToJSON PseudoElement where
    toJSON :: PseudoElement -> Value
toJSON = forall a. ToCssSelector a => a -> Value
_cssToJson

instance ToJSON Attrib where
    toJSON :: Attrib -> Value
toJSON = forall a. ToCssSelector a => a -> Value
_cssToJson

instance ToJSON Negation where
    toJSON :: Negation -> Value
toJSON = forall a. ToCssSelector a => a -> Value
_cssToJson


-- Arbitrary instances
_arbitraryIdent :: Gen Text
_arbitraryIdent :: Gen Text
_arbitraryIdent = String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf1 forall a. Arbitrary a => Gen a
arbitrary

_arbitraryLanguages :: [Text]
_arbitraryLanguages :: [Text]
_arbitraryLanguages = [Text
"af", Text
"af-ZA", Text
"ar", Text
"ar-AE", Text
"ar-BH", Text
"ar-DZ", Text
"ar-EG", Text
"ar-IQ", Text
"ar-JO", Text
"ar-KW", Text
"ar-LB", Text
"ar-LY", Text
"ar-MA", Text
"ar-OM", Text
"ar-QA", Text
"ar-SA", Text
"ar-SY", Text
"ar-TN", Text
"ar-YE", Text
"az", Text
"az-AZ", Text
"az-AZ", Text
"be", Text
"be-BY", Text
"bg", Text
"bg-BG", Text
"bs-BA", Text
"ca", Text
"ca-ES", Text
"cs", Text
"cs-CZ", Text
"cy", Text
"cy-GB", Text
"da", Text
"da-DK", Text
"de", Text
"de-AT", Text
"de-CH", Text
"de-DE", Text
"de-LI", Text
"de-LU", Text
"dv", Text
"dv-MV", Text
"el", Text
"el-GR", Text
"en", Text
"en-AU", Text
"en-BZ", Text
"en-CA", Text
"en-CB", Text
"en-GB", Text
"en-IE", Text
"en-JM", Text
"en-NZ", Text
"en-PH", Text
"en-TT", Text
"en-US", Text
"en-ZA", Text
"en-ZW", Text
"eo", Text
"es", Text
"es-AR", Text
"es-BO", Text
"es-CL", Text
"es-CO", Text
"es-CR", Text
"es-DO", Text
"es-EC", Text
"es-ES", Text
"es-ES", Text
"es-GT", Text
"es-HN", Text
"es-MX", Text
"es-NI", Text
"es-PA", Text
"es-PE", Text
"es-PR", Text
"es-PY", Text
"es-SV", Text
"es-UY", Text
"es-VE", Text
"et", Text
"et-EE", Text
"eu", Text
"eu-ES", Text
"fa", Text
"fa-IR", Text
"fi", Text
"fi-FI", Text
"fo", Text
"fo-FO", Text
"fr", Text
"fr-BE", Text
"fr-CA", Text
"fr-CH", Text
"fr-FR", Text
"fr-LU", Text
"fr-MC", Text
"gl", Text
"gl-ES", Text
"gu", Text
"gu-IN", Text
"he", Text
"he-IL", Text
"hi", Text
"hi-IN", Text
"hr", Text
"hr-BA", Text
"hr-HR", Text
"hu", Text
"hu-HU", Text
"hy", Text
"hy-AM", Text
"id", Text
"id-ID", Text
"is", Text
"is-IS", Text
"it", Text
"it-CH", Text
"it-IT", Text
"ja", Text
"ja-JP", Text
"ka", Text
"ka-GE", Text
"kk", Text
"kk-KZ", Text
"kn", Text
"kn-IN", Text
"ko", Text
"ko-KR", Text
"kok", Text
"kok-IN", Text
"ky", Text
"ky-KG", Text
"lt", Text
"lt-LT", Text
"lv", Text
"lv-LV", Text
"mi", Text
"mi-NZ", Text
"mk", Text
"mk-MK", Text
"mn", Text
"mn-MN", Text
"mr", Text
"mr-IN", Text
"ms", Text
"ms-BN", Text
"ms-MY", Text
"mt", Text
"mt-MT", Text
"nb", Text
"nb-NO", Text
"nl", Text
"nl-BE", Text
"nl-NL", Text
"nn-NO", Text
"ns", Text
"ns-ZA", Text
"pa", Text
"pa-IN", Text
"pl", Text
"pl-PL", Text
"ps", Text
"ps-AR", Text
"pt", Text
"pt-BR", Text
"pt-PT", Text
"qu", Text
"qu-BO", Text
"qu-EC", Text
"qu-PE", Text
"ro", Text
"ro-RO", Text
"ru", Text
"ru-RU", Text
"sa", Text
"sa-IN", Text
"se", Text
"se-FI", Text
"se-FI", Text
"se-FI", Text
"se-NO", Text
"se-NO", Text
"se-NO", Text
"se-SE", Text
"se-SE", Text
"se-SE", Text
"sk", Text
"sk-SK", Text
"sl", Text
"sl-SI", Text
"sq", Text
"sq-AL", Text
"sr-BA", Text
"sr-BA", Text
"sr-SP", Text
"sr-SP", Text
"sv", Text
"sv-FI", Text
"sv-SE", Text
"sw", Text
"sw-KE", Text
"syr", Text
"syr-SY", Text
"ta", Text
"ta-IN", Text
"te", Text
"te-IN", Text
"th", Text
"th-TH", Text
"tl", Text
"tl-PH", Text
"tn", Text
"tn-ZA", Text
"tr", Text
"tr-TR", Text
"tt", Text
"tt-RU", Text
"ts", Text
"uk", Text
"uk-UA", Text
"ur", Text
"ur-PK", Text
"uz", Text
"uz-UZ", Text
"uz-UZ", Text
"vi", Text
"vi-VN", Text
"xh", Text
"xh-ZA", Text
"zh", Text
"zh-CN", Text
"zh-HK", Text
"zh-MO", Text
"zh-SG", Text
"zh-TW", Text
"zu", Text
"zu-ZA"]

_shrinkText :: Text -> [Text]
_shrinkText :: Text -> [Text]
_shrinkText = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Semigroup a => a -> a -> a
(<>)) Text -> [Text]
inits (Text -> [Text]
tails forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1)

_shrinkIdent :: Text -> [Text]
_shrinkIdent :: Text -> [Text]
_shrinkIdent Text
t
    | Text -> Int
T.length Text
t forall a. Ord a => a -> a -> Bool
< Int
2 = []
    | Bool
otherwise = Text -> [Text]
_shrinkText Text
t

instance Arbitrary Hash where
    arbitrary :: Gen Hash
arbitrary = Text -> Hash
Hash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
_arbitraryIdent
    shrink :: Hash -> [Hash]
shrink (Hash Text
a) = Text -> Hash
Hash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
_shrinkIdent Text
a

instance Arbitrary Class where
    arbitrary :: Gen Class
arbitrary = Text -> Class
Class forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
_arbitraryIdent
    shrink :: Class -> [Class]
shrink (Class Text
a) = Text -> Class
Class forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
_shrinkIdent Text
a

instance Arbitrary Nth where
    arbitrary :: Gen Nth
arbitrary = Int -> Int -> Nth
Nth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int
1forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
abs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
    shrink :: Nth -> [Nth]
shrink Nth
nth
      | Nth
nth forall a. Eq a => a -> a -> Bool
== Nth
nnth = []
      | Bool
otherwise = [Nth
nnth]
      where nnth :: Nth
nnth = Nth -> Nth
normalizeNth Nth
nth

instance Arbitrary Namespace where
    arbitrary :: Gen Namespace
arbitrary = forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
3, forall (f :: * -> *) a. Applicative f => a -> f a
pure Namespace
NAny), (Int
1, Text -> Namespace
Namespace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
_arbitraryIdent)]
    shrink :: Namespace -> [Namespace]
shrink Namespace
NAny = []
    shrink (Namespace Text
a) = Text -> Namespace
Namespace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
_shrinkIdent Text
a

instance Arbitrary ElementName where
    arbitrary :: Gen ElementName
arbitrary = forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure ElementName
EAny), (Int
3, Text -> ElementName
ElementName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
_arbitraryIdent)]
    shrink :: ElementName -> [ElementName]
shrink ElementName
EAny = []
    shrink (ElementName Text
a) = Text -> ElementName
ElementName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
_shrinkIdent Text
a

instance Arbitrary TypeSelector where
    arbitrary :: Gen TypeSelector
arbitrary = Namespace -> ElementName -> TypeSelector
TypeSelector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
    shrink :: TypeSelector -> [TypeSelector]
shrink (TypeSelector Namespace
x ElementName
y) = (Namespace -> ElementName -> TypeSelector
TypeSelector Namespace
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink ElementName
y) forall a. [a] -> [a] -> [a]
++ ((Namespace -> ElementName -> TypeSelector
`TypeSelector` ElementName
y) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Namespace
x)

instance Arbitrary SelectorSequence where
    arbitrary :: Gen SelectorSequence
arbitrary = SelectorSequence -> [SelectorFilter] -> SelectorSequence
addFilters forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeSelector -> SelectorSequence
SimpleSelector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Gen a -> Gen [a]
listOf forall a. Arbitrary a => Gen a
arbitrary
    shrink :: SelectorSequence -> [SelectorSequence]
shrink (SimpleSelector TypeSelector
ss) = TypeSelector -> SelectorSequence
SimpleSelector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink TypeSelector
ss
    shrink (Filter SelectorSequence
ss SelectorFilter
sf) = SelectorSequence
ss forall a. a -> [a] -> [a]
: ((SelectorSequence -> SelectorFilter -> SelectorSequence
`Filter` SelectorFilter
sf) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink SelectorSequence
ss) forall a. [a] -> [a] -> [a]
++ (SelectorSequence -> SelectorFilter -> SelectorSequence
Filter SelectorSequence
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink SelectorFilter
sf)

instance Arbitrary PseudoSelectorSequence where
    arbitrary :: Gen PseudoSelectorSequence
arbitrary = forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
3, SelectorSequence -> PseudoSelectorSequence
Sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary), (Int
1, SelectorSequence -> PseudoElement -> PseudoSelectorSequence
(:.::) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary)]
    shrink :: PseudoSelectorSequence -> [PseudoSelectorSequence]
shrink (Sequence SelectorSequence
ss) = SelectorSequence -> PseudoSelectorSequence
Sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink SelectorSequence
ss
    shrink (SelectorSequence
ss :.:: PseudoElement
pe) = SelectorSequence -> PseudoSelectorSequence
Sequence SelectorSequence
ss forall a. a -> [a] -> [a]
: ((SelectorSequence
ss SelectorSequence -> PseudoElement -> PseudoSelectorSequence
:.::) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink PseudoElement
pe) forall a. [a] -> [a] -> [a]
++ ((SelectorSequence -> PseudoElement -> PseudoSelectorSequence
:.:: PseudoElement
pe) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink SelectorSequence
ss)

instance Arbitrary SelectorCombinator where
    arbitrary :: Gen SelectorCombinator
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary AttributeCombinator where
    arbitrary :: Gen AttributeCombinator
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary SelectorFilter where
    arbitrary :: Gen SelectorFilter
arbitrary = forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
4, Hash -> SelectorFilter
SHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary), (Int
4, Class -> SelectorFilter
SClass forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary), (Int
4, Attrib -> SelectorFilter
SAttrib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary), (Int
4, PseudoClass -> SelectorFilter
SPseudo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary), (Int
1, Negation -> SelectorFilter
SNot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)]
    shrink :: SelectorFilter -> [SelectorFilter]
shrink (SHash Hash
x) = Hash -> SelectorFilter
SHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Hash
x
    shrink (SClass Class
x) = Class -> SelectorFilter
SClass forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Class
x
    shrink (SAttrib Attrib
x) = Attrib -> SelectorFilter
SAttrib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Attrib
x
    shrink (SPseudo PseudoClass
x) = PseudoClass -> SelectorFilter
SPseudo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink PseudoClass
x
    shrink (SNot Negation
x) = Negation -> SelectorFilter
SNot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Negation
x

instance Arbitrary Negation where
    arbitrary :: Gen Negation
arbitrary = forall a. [Gen a] -> Gen a
oneof [TypeSelector -> Negation
NTypeSelector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary, Hash -> Negation
NHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary, Class -> Negation
NClass forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary, Attrib -> Negation
NAttrib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary, PseudoClass -> Negation
NPseudo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary, PseudoElement -> Negation
NPseudoElement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary]
    shrink :: Negation -> [Negation]
shrink (NTypeSelector TypeSelector
x) = TypeSelector -> Negation
NTypeSelector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink TypeSelector
x
    shrink (NHash Hash
x) = Hash -> Negation
NHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Hash
x
    shrink (NClass Class
x) = Class -> Negation
NClass forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Class
x
    shrink (NAttrib Attrib
x) = Attrib -> Negation
NAttrib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Attrib
x
    shrink (NPseudo PseudoClass
x) = PseudoClass -> Negation
NPseudo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink PseudoClass
x
    shrink (NPseudoElement PseudoElement
x) = PseudoElement -> Negation
NPseudoElement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink PseudoElement
x

instance Arbitrary AttributeName where
    arbitrary :: Gen AttributeName
arbitrary = Namespace -> Text -> AttributeName
AttributeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
_arbitraryIdent
    shrink :: AttributeName -> [AttributeName]
shrink (AttributeName Namespace
x Text
y) = (Namespace -> Text -> AttributeName
AttributeName Namespace
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
_shrinkIdent Text
y) forall a. [a] -> [a] -> [a]
++ ((Namespace -> Text -> AttributeName
`AttributeName` Text
y) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Namespace
x)

instance Arbitrary Attrib where
    arbitrary :: Gen Attrib
arbitrary = forall a. [Gen a] -> Gen a
oneof [AttributeName -> Attrib
Exist forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary, AttributeName -> AttributeCombinator -> Text -> Attrib
Attrib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf forall a. Arbitrary a => Gen a
arbitrary)]
    shrink :: Attrib -> [Attrib]
shrink (Exist AttributeName
x) = AttributeName -> Attrib
Exist forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink AttributeName
x
    shrink (Attrib AttributeName
x AttributeCombinator
y Text
z) = (AttributeName -> AttributeCombinator -> Text -> Attrib
Attrib AttributeName
x AttributeCombinator
y forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
_shrinkText Text
z) forall a. [a] -> [a] -> [a]
++ ((\AttributeName
sx -> AttributeName -> AttributeCombinator -> Text -> Attrib
Attrib AttributeName
sx AttributeCombinator
y Text
z) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink AttributeName
x)

instance Arbitrary SelectorGroup where
    arbitrary :: Gen SelectorGroup
arbitrary = NonEmpty Selector -> SelectorGroup
SelectorGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> [a] -> NonEmpty a
(:|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary)
    shrink :: SelectorGroup -> [SelectorGroup]
shrink (SelectorGroup (Selector
x :| [Selector]
xs)) = [Selector] -> [SelectorGroup] -> [SelectorGroup]
go [Selector]
xs (NonEmpty Selector -> SelectorGroup
SelectorGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Selector
x forall a. a -> [a] -> NonEmpty a
:|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink [Selector]
xs)
      where go :: [Selector] -> [SelectorGroup] -> [SelectorGroup]
go [] = forall a. a -> a
id
            go (Selector
y:[Selector]
ys) = (NonEmpty Selector -> SelectorGroup
SelectorGroup (Selector
y forall a. a -> [a] -> NonEmpty a
:| [Selector]
ys) forall a. a -> [a] -> [a]
:)

instance Arbitrary Selector where
    arbitrary :: Gen Selector
arbitrary = forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
3, PseudoSelectorSequence -> Selector
Selector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary), (Int
1, PseudoSelectorSequence
-> SelectorCombinator -> Selector -> Selector
Combined forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary) ]
    shrink :: Selector -> [Selector]
shrink (Selector PseudoSelectorSequence
x) = PseudoSelectorSequence -> Selector
Selector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink PseudoSelectorSequence
x
    shrink (Combined PseudoSelectorSequence
x SelectorCombinator
y Selector
z) = Selector
z forall a. a -> [a] -> [a]
: (PseudoSelectorSequence
-> SelectorCombinator -> Selector -> Selector
Combined PseudoSelectorSequence
x SelectorCombinator
y forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Selector
z) forall a. [a] -> [a] -> [a]
++ ((\PseudoSelectorSequence
sx -> PseudoSelectorSequence
-> SelectorCombinator -> Selector -> Selector
Combined PseudoSelectorSequence
sx SelectorCombinator
y Selector
z) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink PseudoSelectorSequence
x)

instance Arbitrary PseudoClass where
    arbitrary :: Gen PseudoClass
arbitrary = forall a. [Gen a] -> Gen a
oneof ((Text -> PseudoClass
Lang forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Gen a
elements [Text]
_arbitraryLanguages) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. Applicative f => a -> f a
pure [
        PseudoClass
Active, PseudoClass
Checked, PseudoClass
Default, PseudoClass
Disabled, PseudoClass
Empty, PseudoClass
Enabled, PseudoClass
Focus, PseudoClass
Fullscreen, PseudoClass
Hover, PseudoClass
Indeterminate, PseudoClass
InRange, PseudoClass
Invalid, PseudoClass
Link, PseudoClass
OnlyOfType, PseudoClass
OnlyChild
      , PseudoClass
Optional, PseudoClass
OutOfRange, PseudoClass
ReadOnly, PseudoClass
ReadWrite, PseudoClass
Required, PseudoClass
Root, PseudoClass
Target, PseudoClass
Valid, PseudoClass
Visited
      ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary) [Nth -> PseudoClass
NthChild, Nth -> PseudoClass
NthLastChild, Nth -> PseudoClass
NthLastOfType, Nth -> PseudoClass
NthOfType])

instance Arbitrary PseudoElement where
    arbitrary :: Gen PseudoElement
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum