{-# 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
Typeable SelectorSpecificity
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SelectorSpecificity
    -> c SelectorSpecificity)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelectorSpecificity)
-> (SelectorSpecificity -> Constr)
-> (SelectorSpecificity -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> SelectorSpecificity -> SelectorSpecificity)
-> (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 u.
    (forall d. Data d => d -> u) -> SelectorSpecificity -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelectorSpecificity -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelectorSpecificity -> m SelectorSpecificity)
-> Data SelectorSpecificity
SelectorSpecificity -> Constr
SelectorSpecificity -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorSpecificity
-> c SelectorSpecificity
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorSpecificity
-> c SelectorSpecificity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSpecificity
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSpecificity
$ctoConstr :: SelectorSpecificity -> Constr
toConstr :: SelectorSpecificity -> Constr
$cdataTypeOf :: SelectorSpecificity -> DataType
dataTypeOf :: SelectorSpecificity -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorSpecificity)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorSpecificity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSpecificity)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSpecificity)
$cgmapT :: (forall b. Data b => b -> b)
-> SelectorSpecificity -> SelectorSpecificity
gmapT :: (forall b. Data b => b -> b)
-> SelectorSpecificity -> SelectorSpecificity
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SelectorSpecificity -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> SelectorSpecificity -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorSpecificity -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorSpecificity -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
Data, (forall x. SelectorSpecificity -> Rep SelectorSpecificity x)
-> (forall x. Rep SelectorSpecificity x -> SelectorSpecificity)
-> Generic SelectorSpecificity
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
$cfrom :: forall x. SelectorSpecificity -> Rep SelectorSpecificity x
from :: forall x. SelectorSpecificity -> Rep SelectorSpecificity x
$cto :: forall x. Rep SelectorSpecificity x -> SelectorSpecificity
to :: forall x. Rep SelectorSpecificity x -> SelectorSpecificity
Generic, Int -> SelectorSpecificity -> ShowS
[SelectorSpecificity] -> ShowS
SelectorSpecificity -> String
(Int -> SelectorSpecificity -> ShowS)
-> (SelectorSpecificity -> String)
-> ([SelectorSpecificity] -> ShowS)
-> Show SelectorSpecificity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectorSpecificity -> ShowS
showsPrec :: Int -> SelectorSpecificity -> ShowS
$cshow :: SelectorSpecificity -> String
show :: SelectorSpecificity -> String
$cshowList :: [SelectorSpecificity] -> ShowS
showList :: [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
100Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
b Int -> Int -> Int
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
Typeable Nth
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Nth -> c Nth)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Nth)
-> (Nth -> Constr)
-> (Nth -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Nth -> Nth)
-> (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 u. (forall d. Data d => d -> u) -> Nth -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Nth -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Nth -> m Nth)
-> Data Nth
Nth -> Constr
Nth -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Nth -> c Nth
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Nth -> c Nth
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Nth
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Nth
$ctoConstr :: Nth -> Constr
toConstr :: Nth -> Constr
$cdataTypeOf :: Nth -> DataType
dataTypeOf :: Nth -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Nth)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Nth)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Nth)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Nth)
$cgmapT :: (forall b. Data b => b -> b) -> Nth -> Nth
gmapT :: (forall b. Data b => b -> b) -> Nth -> Nth
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Nth -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Nth -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Nth -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Nth -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Nth -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Nth -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Nth -> m Nth
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Nth -> m Nth
Data, Nth -> Nth -> Bool
(Nth -> Nth -> Bool) -> (Nth -> Nth -> Bool) -> Eq Nth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Nth -> Nth -> Bool
== :: Nth -> Nth -> Bool
$c/= :: Nth -> Nth -> Bool
/= :: Nth -> Nth -> Bool
Eq, (forall x. Nth -> Rep Nth x)
-> (forall x. Rep Nth x -> Nth) -> Generic Nth
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
$cfrom :: forall x. Nth -> Rep Nth x
from :: forall x. Nth -> Rep Nth x
$cto :: forall x. Rep Nth x -> Nth
to :: forall x. Rep Nth x -> Nth
Generic, Eq Nth
Eq Nth
-> (Nth -> Nth -> Ordering)
-> (Nth -> Nth -> Bool)
-> (Nth -> Nth -> Bool)
-> (Nth -> Nth -> Bool)
-> (Nth -> Nth -> Bool)
-> (Nth -> Nth -> Nth)
-> (Nth -> Nth -> Nth)
-> Ord 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
$ccompare :: Nth -> Nth -> Ordering
compare :: Nth -> Nth -> Ordering
$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
>= :: Nth -> Nth -> Bool
$cmax :: Nth -> Nth -> Nth
max :: Nth -> Nth -> Nth
$cmin :: Nth -> Nth -> Nth
min :: Nth -> Nth -> Nth
Ord, ReadPrec [Nth]
ReadPrec Nth
Int -> ReadS Nth
ReadS [Nth]
(Int -> ReadS Nth)
-> ReadS [Nth] -> ReadPrec Nth -> ReadPrec [Nth] -> Read Nth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Nth
readsPrec :: Int -> ReadS Nth
$creadList :: ReadS [Nth]
readList :: ReadS [Nth]
$creadPrec :: ReadPrec Nth
readPrec :: ReadPrec Nth
$creadListPrec :: ReadPrec [Nth]
readListPrec :: ReadPrec [Nth]
Read, Int -> Nth -> ShowS
[Nth] -> ShowS
Nth -> String
(Int -> Nth -> ShowS)
-> (Nth -> String) -> ([Nth] -> ShowS) -> Show Nth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Nth -> ShowS
showsPrec :: Int -> Nth -> ShowS
$cshow :: Nth -> String
show :: Nth -> String
$cshowList :: [Nth] -> ShowS
showList :: [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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> Int -> Nth
Nth Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
c)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = let cn :: Int
cn = Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n in if Int
cn Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = let {c' :: Int
c' = Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n; cn' :: Int
cn' = Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n} in (if Int
c' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then (Int
c'Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) else [Int] -> [Int]
forall a. a -> a
id) [Int
cn', Int
cn' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n ..]
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = [Int
c, Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n ..]
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [ Int
c, Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n .. Int
1 ]
  | Bool
otherwise = [Int
c | Int
c Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
nthContainsValue (Nth Int
n Int
c) Int
i = Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n Int -> Int -> Bool
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 = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) ([Int] -> [Int]) -> (Nth -> [Int]) -> Nth -> [Int]
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 $mEven :: forall {r}. Nth -> ((# #) -> r) -> ((# #) -> r) -> r
$bEven :: Nth
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 $mOdd :: forall {r}. Nth -> ((# #) -> r) -> ((# #) -> r) -> r
$bOdd :: Nth
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 $mOne :: forall {r}. Nth -> ((# #) -> r) -> ((# #) -> r) -> r
$bOne :: Nth
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 (Int -> String
forall a. Show a => a -> String
show Int
n)) Char
'n'
nthToText (Nth Int
0 Int
b) = String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
b)
nthToText (Nth Int
n Int
b)
  | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'n' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
b)
  | Bool
otherwise = String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'n' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'+' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
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 = a -> a
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 (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
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 (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
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 = ByteString -> a
forall a. Binary a => ByteString -> a
decode (ByteString -> a) -> (ByteString -> ByteString) -> ByteString -> a
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 (SelectorSpecificity -> Int)
-> (a -> SelectorSpecificity) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SelectorSpecificity
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
Typeable SelectorGroup
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SelectorGroup -> c SelectorGroup)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelectorGroup)
-> (SelectorGroup -> Constr)
-> (SelectorGroup -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> SelectorGroup -> SelectorGroup)
-> (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 u. (forall d. Data d => d -> u) -> SelectorGroup -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelectorGroup -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup)
-> Data SelectorGroup
SelectorGroup -> Constr
SelectorGroup -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorGroup -> c SelectorGroup
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorGroup -> c SelectorGroup
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorGroup
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorGroup
$ctoConstr :: SelectorGroup -> Constr
toConstr :: SelectorGroup -> Constr
$cdataTypeOf :: SelectorGroup -> DataType
dataTypeOf :: SelectorGroup -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorGroup)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorGroup)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorGroup)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorGroup)
$cgmapT :: (forall b. Data b => b -> b) -> SelectorGroup -> SelectorGroup
gmapT :: (forall b. Data b => b -> b) -> SelectorGroup -> SelectorGroup
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorGroup -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorGroup -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SelectorGroup -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SelectorGroup -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
Data, SelectorGroup -> SelectorGroup -> Bool
(SelectorGroup -> SelectorGroup -> Bool)
-> (SelectorGroup -> SelectorGroup -> Bool) -> Eq SelectorGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectorGroup -> SelectorGroup -> Bool
== :: SelectorGroup -> SelectorGroup -> Bool
$c/= :: SelectorGroup -> SelectorGroup -> Bool
/= :: SelectorGroup -> SelectorGroup -> Bool
Eq, (forall x. SelectorGroup -> Rep SelectorGroup x)
-> (forall x. Rep SelectorGroup x -> SelectorGroup)
-> Generic SelectorGroup
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
$cfrom :: forall x. SelectorGroup -> Rep SelectorGroup x
from :: forall x. SelectorGroup -> Rep SelectorGroup x
$cto :: forall x. Rep SelectorGroup x -> SelectorGroup
to :: forall x. Rep SelectorGroup x -> SelectorGroup
Generic, Eq SelectorGroup
Eq SelectorGroup
-> (SelectorGroup -> SelectorGroup -> Ordering)
-> (SelectorGroup -> SelectorGroup -> Bool)
-> (SelectorGroup -> SelectorGroup -> Bool)
-> (SelectorGroup -> SelectorGroup -> Bool)
-> (SelectorGroup -> SelectorGroup -> Bool)
-> (SelectorGroup -> SelectorGroup -> SelectorGroup)
-> (SelectorGroup -> SelectorGroup -> SelectorGroup)
-> Ord 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
$ccompare :: SelectorGroup -> SelectorGroup -> Ordering
compare :: SelectorGroup -> SelectorGroup -> Ordering
$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
>= :: SelectorGroup -> SelectorGroup -> Bool
$cmax :: SelectorGroup -> SelectorGroup -> SelectorGroup
max :: SelectorGroup -> SelectorGroup -> SelectorGroup
$cmin :: SelectorGroup -> SelectorGroup -> SelectorGroup
min :: SelectorGroup -> SelectorGroup -> SelectorGroup
Ord, Int -> SelectorGroup -> ShowS
[SelectorGroup] -> ShowS
SelectorGroup -> String
(Int -> SelectorGroup -> ShowS)
-> (SelectorGroup -> String)
-> ([SelectorGroup] -> ShowS)
-> Show SelectorGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectorGroup -> ShowS
showsPrec :: Int -> SelectorGroup -> ShowS
$cshow :: SelectorGroup -> String
show :: SelectorGroup -> String
$cshowList :: [SelectorGroup] -> ShowS
showList :: [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
Typeable Selector
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Selector -> c Selector)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Selector)
-> (Selector -> Constr)
-> (Selector -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Selector -> Selector)
-> (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 u. (forall d. Data d => d -> u) -> Selector -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Selector -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Selector -> m Selector)
-> Data Selector
Selector -> Constr
Selector -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Selector -> c Selector
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Selector -> c Selector
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Selector
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Selector
$ctoConstr :: Selector -> Constr
toConstr :: Selector -> Constr
$cdataTypeOf :: Selector -> DataType
dataTypeOf :: Selector -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Selector)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Selector)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Selector)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Selector)
$cgmapT :: (forall b. Data b => b -> b) -> Selector -> Selector
gmapT :: (forall b. Data b => b -> b) -> Selector -> Selector
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Selector -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Selector -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Selector -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Selector -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
Data, Selector -> Selector -> Bool
(Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool) -> Eq Selector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
/= :: Selector -> Selector -> Bool
Eq, (forall x. Selector -> Rep Selector x)
-> (forall x. Rep Selector x -> Selector) -> Generic Selector
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
$cfrom :: forall x. Selector -> Rep Selector x
from :: forall x. Selector -> Rep Selector x
$cto :: forall x. Rep Selector x -> Selector
to :: forall x. Rep Selector x -> Selector
Generic, Eq Selector
Eq Selector
-> (Selector -> Selector -> Ordering)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Selector)
-> (Selector -> Selector -> Selector)
-> Ord 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
$ccompare :: Selector -> Selector -> Ordering
compare :: Selector -> Selector -> Ordering
$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
>= :: Selector -> Selector -> Bool
$cmax :: Selector -> Selector -> Selector
max :: Selector -> Selector -> Selector
$cmin :: Selector -> Selector -> Selector
min :: Selector -> Selector -> Selector
Ord, Int -> Selector -> ShowS
[Selector] -> ShowS
Selector -> String
(Int -> Selector -> ShowS)
-> (Selector -> String) -> ([Selector] -> ShowS) -> Show Selector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Selector -> ShowS
showsPrec :: Int -> Selector -> ShowS
$cshow :: Selector -> String
show :: Selector -> String
$cshowList :: [Selector] -> ShowS
showList :: [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
SelectorCombinator
-> SelectorCombinator -> Bounded SelectorCombinator
forall a. a -> a -> Bounded a
$cminBound :: SelectorCombinator
minBound :: SelectorCombinator
$cmaxBound :: SelectorCombinator
maxBound :: SelectorCombinator
Bounded, Typeable SelectorCombinator
Typeable SelectorCombinator
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SelectorCombinator
    -> c SelectorCombinator)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelectorCombinator)
-> (SelectorCombinator -> Constr)
-> (SelectorCombinator -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> SelectorCombinator -> SelectorCombinator)
-> (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 u.
    (forall d. Data d => d -> u) -> SelectorCombinator -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelectorCombinator -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelectorCombinator -> m SelectorCombinator)
-> Data SelectorCombinator
SelectorCombinator -> Constr
SelectorCombinator -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorCombinator
-> c SelectorCombinator
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorCombinator
-> c SelectorCombinator
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorCombinator
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorCombinator
$ctoConstr :: SelectorCombinator -> Constr
toConstr :: SelectorCombinator -> Constr
$cdataTypeOf :: SelectorCombinator -> DataType
dataTypeOf :: SelectorCombinator -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorCombinator)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorCombinator)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorCombinator)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorCombinator)
$cgmapT :: (forall b. Data b => b -> b)
-> SelectorCombinator -> SelectorCombinator
gmapT :: (forall b. Data b => b -> b)
-> SelectorCombinator -> SelectorCombinator
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorCombinator -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorCombinator -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorCombinator -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorCombinator -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorCombinator -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorCombinator -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorCombinator -> m SelectorCombinator
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorCombinator -> m SelectorCombinator
Data, Int -> SelectorCombinator
SelectorCombinator -> Int
SelectorCombinator -> [SelectorCombinator]
SelectorCombinator -> SelectorCombinator
SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
SelectorCombinator
-> SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
(SelectorCombinator -> SelectorCombinator)
-> (SelectorCombinator -> SelectorCombinator)
-> (Int -> SelectorCombinator)
-> (SelectorCombinator -> Int)
-> (SelectorCombinator -> [SelectorCombinator])
-> (SelectorCombinator
    -> SelectorCombinator -> [SelectorCombinator])
-> (SelectorCombinator
    -> SelectorCombinator -> [SelectorCombinator])
-> (SelectorCombinator
    -> SelectorCombinator
    -> SelectorCombinator
    -> [SelectorCombinator])
-> Enum 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
$csucc :: SelectorCombinator -> SelectorCombinator
succ :: SelectorCombinator -> SelectorCombinator
$cpred :: SelectorCombinator -> SelectorCombinator
pred :: SelectorCombinator -> SelectorCombinator
$ctoEnum :: Int -> SelectorCombinator
toEnum :: Int -> SelectorCombinator
$cfromEnum :: SelectorCombinator -> Int
fromEnum :: SelectorCombinator -> Int
$cenumFrom :: SelectorCombinator -> [SelectorCombinator]
enumFrom :: SelectorCombinator -> [SelectorCombinator]
$cenumFromThen :: SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
enumFromThen :: SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
$cenumFromTo :: SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
enumFromTo :: SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
$cenumFromThenTo :: SelectorCombinator
-> SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
enumFromThenTo :: SelectorCombinator
-> SelectorCombinator -> SelectorCombinator -> [SelectorCombinator]
Enum, SelectorCombinator -> SelectorCombinator -> Bool
(SelectorCombinator -> SelectorCombinator -> Bool)
-> (SelectorCombinator -> SelectorCombinator -> Bool)
-> Eq SelectorCombinator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectorCombinator -> SelectorCombinator -> Bool
== :: SelectorCombinator -> SelectorCombinator -> Bool
$c/= :: SelectorCombinator -> SelectorCombinator -> Bool
/= :: SelectorCombinator -> SelectorCombinator -> Bool
Eq, (forall x. SelectorCombinator -> Rep SelectorCombinator x)
-> (forall x. Rep SelectorCombinator x -> SelectorCombinator)
-> Generic SelectorCombinator
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
$cfrom :: forall x. SelectorCombinator -> Rep SelectorCombinator x
from :: forall x. SelectorCombinator -> Rep SelectorCombinator x
$cto :: forall x. Rep SelectorCombinator x -> SelectorCombinator
to :: forall x. Rep SelectorCombinator x -> SelectorCombinator
Generic, Eq SelectorCombinator
Eq SelectorCombinator
-> (SelectorCombinator -> SelectorCombinator -> Ordering)
-> (SelectorCombinator -> SelectorCombinator -> Bool)
-> (SelectorCombinator -> SelectorCombinator -> Bool)
-> (SelectorCombinator -> SelectorCombinator -> Bool)
-> (SelectorCombinator -> SelectorCombinator -> Bool)
-> (SelectorCombinator -> SelectorCombinator -> SelectorCombinator)
-> (SelectorCombinator -> SelectorCombinator -> SelectorCombinator)
-> Ord 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
$ccompare :: SelectorCombinator -> SelectorCombinator -> Ordering
compare :: SelectorCombinator -> SelectorCombinator -> Ordering
$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
>= :: SelectorCombinator -> SelectorCombinator -> Bool
$cmax :: SelectorCombinator -> SelectorCombinator -> SelectorCombinator
max :: SelectorCombinator -> SelectorCombinator -> SelectorCombinator
$cmin :: SelectorCombinator -> SelectorCombinator -> SelectorCombinator
min :: SelectorCombinator -> SelectorCombinator -> SelectorCombinator
Ord, ReadPrec [SelectorCombinator]
ReadPrec SelectorCombinator
Int -> ReadS SelectorCombinator
ReadS [SelectorCombinator]
(Int -> ReadS SelectorCombinator)
-> ReadS [SelectorCombinator]
-> ReadPrec SelectorCombinator
-> ReadPrec [SelectorCombinator]
-> Read SelectorCombinator
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SelectorCombinator
readsPrec :: Int -> ReadS SelectorCombinator
$creadList :: ReadS [SelectorCombinator]
readList :: ReadS [SelectorCombinator]
$creadPrec :: ReadPrec SelectorCombinator
readPrec :: ReadPrec SelectorCombinator
$creadListPrec :: ReadPrec [SelectorCombinator]
readListPrec :: ReadPrec [SelectorCombinator]
Read, Int -> SelectorCombinator -> ShowS
[SelectorCombinator] -> ShowS
SelectorCombinator -> String
(Int -> SelectorCombinator -> ShowS)
-> (SelectorCombinator -> String)
-> ([SelectorCombinator] -> ShowS)
-> Show SelectorCombinator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectorCombinator -> ShowS
showsPrec :: Int -> SelectorCombinator -> ShowS
$cshow :: SelectorCombinator -> String
show :: SelectorCombinator -> String
$cshowList :: [SelectorCombinator] -> ShowS
showList :: [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
Typeable SelectorSequence
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SelectorSequence -> c SelectorSequence)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelectorSequence)
-> (SelectorSequence -> Constr)
-> (SelectorSequence -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> SelectorSequence -> SelectorSequence)
-> (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 u.
    (forall d. Data d => d -> u) -> SelectorSequence -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelectorSequence -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelectorSequence -> m SelectorSequence)
-> Data SelectorSequence
SelectorSequence -> Constr
SelectorSequence -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorSequence -> c SelectorSequence
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorSequence -> c SelectorSequence
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSequence
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSequence
$ctoConstr :: SelectorSequence -> Constr
toConstr :: SelectorSequence -> Constr
$cdataTypeOf :: SelectorSequence -> DataType
dataTypeOf :: SelectorSequence -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorSequence)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorSequence)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSequence)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSequence)
$cgmapT :: (forall b. Data b => b -> b)
-> SelectorSequence -> SelectorSequence
gmapT :: (forall b. Data b => b -> b)
-> SelectorSequence -> SelectorSequence
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSequence -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSequence -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorSequence -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorSequence -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorSequence -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorSequence -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSequence -> m SelectorSequence
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSequence -> m SelectorSequence
Data, SelectorSequence -> SelectorSequence -> Bool
(SelectorSequence -> SelectorSequence -> Bool)
-> (SelectorSequence -> SelectorSequence -> Bool)
-> Eq SelectorSequence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectorSequence -> SelectorSequence -> Bool
== :: SelectorSequence -> SelectorSequence -> Bool
$c/= :: SelectorSequence -> SelectorSequence -> Bool
/= :: SelectorSequence -> SelectorSequence -> Bool
Eq, (forall x. SelectorSequence -> Rep SelectorSequence x)
-> (forall x. Rep SelectorSequence x -> SelectorSequence)
-> Generic SelectorSequence
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
$cfrom :: forall x. SelectorSequence -> Rep SelectorSequence x
from :: forall x. SelectorSequence -> Rep SelectorSequence x
$cto :: forall x. Rep SelectorSequence x -> SelectorSequence
to :: forall x. Rep SelectorSequence x -> SelectorSequence
Generic, Eq SelectorSequence
Eq SelectorSequence
-> (SelectorSequence -> SelectorSequence -> Ordering)
-> (SelectorSequence -> SelectorSequence -> Bool)
-> (SelectorSequence -> SelectorSequence -> Bool)
-> (SelectorSequence -> SelectorSequence -> Bool)
-> (SelectorSequence -> SelectorSequence -> Bool)
-> (SelectorSequence -> SelectorSequence -> SelectorSequence)
-> (SelectorSequence -> SelectorSequence -> SelectorSequence)
-> Ord 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
$ccompare :: SelectorSequence -> SelectorSequence -> Ordering
compare :: SelectorSequence -> SelectorSequence -> Ordering
$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
>= :: SelectorSequence -> SelectorSequence -> Bool
$cmax :: SelectorSequence -> SelectorSequence -> SelectorSequence
max :: SelectorSequence -> SelectorSequence -> SelectorSequence
$cmin :: SelectorSequence -> SelectorSequence -> SelectorSequence
min :: SelectorSequence -> SelectorSequence -> SelectorSequence
Ord, Int -> SelectorSequence -> ShowS
[SelectorSequence] -> ShowS
SelectorSequence -> String
(Int -> SelectorSequence -> ShowS)
-> (SelectorSequence -> String)
-> ([SelectorSequence] -> ShowS)
-> Show SelectorSequence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectorSequence -> ShowS
showsPrec :: Int -> SelectorSequence -> ShowS
$cshow :: SelectorSequence -> String
show :: SelectorSequence -> String
$cshowList :: [SelectorSequence] -> ShowS
showList :: [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
Typeable PseudoSelectorSequence
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> PseudoSelectorSequence
    -> c PseudoSelectorSequence)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PseudoSelectorSequence)
-> (PseudoSelectorSequence -> Constr)
-> (PseudoSelectorSequence -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> PseudoSelectorSequence -> PseudoSelectorSequence)
-> (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 u.
    (forall d. Data d => d -> u) -> PseudoSelectorSequence -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PseudoSelectorSequence -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PseudoSelectorSequence -> m PseudoSelectorSequence)
-> Data PseudoSelectorSequence
PseudoSelectorSequence -> Constr
PseudoSelectorSequence -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PseudoSelectorSequence
-> c PseudoSelectorSequence
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PseudoSelectorSequence
-> c PseudoSelectorSequence
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoSelectorSequence
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoSelectorSequence
$ctoConstr :: PseudoSelectorSequence -> Constr
toConstr :: PseudoSelectorSequence -> Constr
$cdataTypeOf :: PseudoSelectorSequence -> DataType
dataTypeOf :: PseudoSelectorSequence -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoSelectorSequence)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoSelectorSequence)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoSelectorSequence)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoSelectorSequence)
$cgmapT :: (forall b. Data b => b -> b)
-> PseudoSelectorSequence -> PseudoSelectorSequence
gmapT :: (forall b. Data b => b -> b)
-> PseudoSelectorSequence -> PseudoSelectorSequence
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> PseudoSelectorSequence
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> PseudoSelectorSequence
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> PseudoSelectorSequence -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> PseudoSelectorSequence -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PseudoSelectorSequence -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PseudoSelectorSequence -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PseudoSelectorSequence -> m PseudoSelectorSequence
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PseudoSelectorSequence -> m PseudoSelectorSequence
Data, PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
(PseudoSelectorSequence -> PseudoSelectorSequence -> Bool)
-> (PseudoSelectorSequence -> PseudoSelectorSequence -> Bool)
-> Eq PseudoSelectorSequence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
== :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
$c/= :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
/= :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
Eq, (forall x. PseudoSelectorSequence -> Rep PseudoSelectorSequence x)
-> (forall x.
    Rep PseudoSelectorSequence x -> PseudoSelectorSequence)
-> Generic PseudoSelectorSequence
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
$cfrom :: forall x. PseudoSelectorSequence -> Rep PseudoSelectorSequence x
from :: forall x. PseudoSelectorSequence -> Rep PseudoSelectorSequence x
$cto :: forall x. Rep PseudoSelectorSequence x -> PseudoSelectorSequence
to :: forall x. Rep PseudoSelectorSequence x -> PseudoSelectorSequence
Generic, Eq PseudoSelectorSequence
Eq PseudoSelectorSequence
-> (PseudoSelectorSequence -> PseudoSelectorSequence -> Ordering)
-> (PseudoSelectorSequence -> PseudoSelectorSequence -> Bool)
-> (PseudoSelectorSequence -> PseudoSelectorSequence -> Bool)
-> (PseudoSelectorSequence -> PseudoSelectorSequence -> Bool)
-> (PseudoSelectorSequence -> PseudoSelectorSequence -> Bool)
-> (PseudoSelectorSequence
    -> PseudoSelectorSequence -> PseudoSelectorSequence)
-> (PseudoSelectorSequence
    -> PseudoSelectorSequence -> PseudoSelectorSequence)
-> Ord 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
$ccompare :: PseudoSelectorSequence -> PseudoSelectorSequence -> Ordering
compare :: PseudoSelectorSequence -> PseudoSelectorSequence -> Ordering
$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
>= :: PseudoSelectorSequence -> PseudoSelectorSequence -> Bool
$cmax :: PseudoSelectorSequence
-> PseudoSelectorSequence -> PseudoSelectorSequence
max :: PseudoSelectorSequence
-> PseudoSelectorSequence -> PseudoSelectorSequence
$cmin :: PseudoSelectorSequence
-> PseudoSelectorSequence -> PseudoSelectorSequence
min :: PseudoSelectorSequence
-> PseudoSelectorSequence -> PseudoSelectorSequence
Ord, Int -> PseudoSelectorSequence -> ShowS
[PseudoSelectorSequence] -> ShowS
PseudoSelectorSequence -> String
(Int -> PseudoSelectorSequence -> ShowS)
-> (PseudoSelectorSequence -> String)
-> ([PseudoSelectorSequence] -> ShowS)
-> Show PseudoSelectorSequence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PseudoSelectorSequence -> ShowS
showsPrec :: Int -> PseudoSelectorSequence -> ShowS
$cshow :: PseudoSelectorSequence -> String
show :: PseudoSelectorSequence -> String
$cshowList :: [PseudoSelectorSequence] -> ShowS
showList :: [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 = (SelectorSequence -> SelectorFilter -> SelectorSequence)
-> SelectorSequence -> [SelectorFilter] -> SelectorSequence
forall b a. (b -> a -> b) -> b -> [a] -> b
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' = (SelectorSequence -> Maybe (SelectorFilter, SelectorSequence))
-> SelectorSequence -> [SelectorFilter]
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) = (SelectorFilter, SelectorSequence)
-> Maybe (SelectorFilter, SelectorSequence)
forall a. a -> Maybe a
Just (SelectorFilter
f, SelectorSequence
s)
          go (SimpleSelector TypeSelector
_) = Maybe (SelectorFilter, SelectorSequence)
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 = [SelectorFilter] -> [SelectorFilter]
forall a. [a] -> [a]
reverse ([SelectorFilter] -> [SelectorFilter])
-> (SelectorSequence -> [SelectorFilter])
-> SelectorSequence
-> [SelectorFilter]
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
Typeable SelectorFilter
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SelectorFilter -> c SelectorFilter)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelectorFilter)
-> (SelectorFilter -> Constr)
-> (SelectorFilter -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> SelectorFilter -> SelectorFilter)
-> (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 u.
    (forall d. Data d => d -> u) -> SelectorFilter -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelectorFilter -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelectorFilter -> m SelectorFilter)
-> Data SelectorFilter
SelectorFilter -> Constr
SelectorFilter -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorFilter -> c SelectorFilter
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorFilter -> c SelectorFilter
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorFilter
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorFilter
$ctoConstr :: SelectorFilter -> Constr
toConstr :: SelectorFilter -> Constr
$cdataTypeOf :: SelectorFilter -> DataType
dataTypeOf :: SelectorFilter -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorFilter)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorFilter)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorFilter)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorFilter)
$cgmapT :: (forall b. Data b => b -> b) -> SelectorFilter -> SelectorFilter
gmapT :: (forall b. Data b => b -> b) -> SelectorFilter -> SelectorFilter
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorFilter -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorFilter -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorFilter -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorFilter -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorFilter -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorFilter -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorFilter -> m SelectorFilter
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorFilter -> m SelectorFilter
Data, SelectorFilter -> SelectorFilter -> Bool
(SelectorFilter -> SelectorFilter -> Bool)
-> (SelectorFilter -> SelectorFilter -> Bool) -> Eq SelectorFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectorFilter -> SelectorFilter -> Bool
== :: SelectorFilter -> SelectorFilter -> Bool
$c/= :: SelectorFilter -> SelectorFilter -> Bool
/= :: SelectorFilter -> SelectorFilter -> Bool
Eq, (forall x. SelectorFilter -> Rep SelectorFilter x)
-> (forall x. Rep SelectorFilter x -> SelectorFilter)
-> Generic SelectorFilter
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
$cfrom :: forall x. SelectorFilter -> Rep SelectorFilter x
from :: forall x. SelectorFilter -> Rep SelectorFilter x
$cto :: forall x. Rep SelectorFilter x -> SelectorFilter
to :: forall x. Rep SelectorFilter x -> SelectorFilter
Generic, Eq SelectorFilter
Eq SelectorFilter
-> (SelectorFilter -> SelectorFilter -> Ordering)
-> (SelectorFilter -> SelectorFilter -> Bool)
-> (SelectorFilter -> SelectorFilter -> Bool)
-> (SelectorFilter -> SelectorFilter -> Bool)
-> (SelectorFilter -> SelectorFilter -> Bool)
-> (SelectorFilter -> SelectorFilter -> SelectorFilter)
-> (SelectorFilter -> SelectorFilter -> SelectorFilter)
-> Ord 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
$ccompare :: SelectorFilter -> SelectorFilter -> Ordering
compare :: SelectorFilter -> SelectorFilter -> Ordering
$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
>= :: SelectorFilter -> SelectorFilter -> Bool
$cmax :: SelectorFilter -> SelectorFilter -> SelectorFilter
max :: SelectorFilter -> SelectorFilter -> SelectorFilter
$cmin :: SelectorFilter -> SelectorFilter -> SelectorFilter
min :: SelectorFilter -> SelectorFilter -> SelectorFilter
Ord, Int -> SelectorFilter -> ShowS
[SelectorFilter] -> ShowS
SelectorFilter -> String
(Int -> SelectorFilter -> ShowS)
-> (SelectorFilter -> String)
-> ([SelectorFilter] -> ShowS)
-> Show SelectorFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectorFilter -> ShowS
showsPrec :: Int -> SelectorFilter -> ShowS
$cshow :: SelectorFilter -> String
show :: SelectorFilter -> String
$cshowList :: [SelectorFilter] -> ShowS
showList :: [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
Typeable Negation
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Negation -> c Negation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Negation)
-> (Negation -> Constr)
-> (Negation -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Negation -> Negation)
-> (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 u. (forall d. Data d => d -> u) -> Negation -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Negation -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Negation -> m Negation)
-> Data Negation
Negation -> Constr
Negation -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Negation -> c Negation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Negation -> c Negation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Negation
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Negation
$ctoConstr :: Negation -> Constr
toConstr :: Negation -> Constr
$cdataTypeOf :: Negation -> DataType
dataTypeOf :: Negation -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Negation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Negation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Negation)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Negation)
$cgmapT :: (forall b. Data b => b -> b) -> Negation -> Negation
gmapT :: (forall b. Data b => b -> b) -> Negation -> Negation
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Negation -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Negation -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Negation -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Negation -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Negation -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Negation -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Negation -> m Negation
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Negation -> m Negation
Data, Negation -> Negation -> Bool
(Negation -> Negation -> Bool)
-> (Negation -> Negation -> Bool) -> Eq Negation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Negation -> Negation -> Bool
== :: Negation -> Negation -> Bool
$c/= :: Negation -> Negation -> Bool
/= :: Negation -> Negation -> Bool
Eq, (forall x. Negation -> Rep Negation x)
-> (forall x. Rep Negation x -> Negation) -> Generic Negation
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
$cfrom :: forall x. Negation -> Rep Negation x
from :: forall x. Negation -> Rep Negation x
$cto :: forall x. Rep Negation x -> Negation
to :: forall x. Rep Negation x -> Negation
Generic, Eq Negation
Eq Negation
-> (Negation -> Negation -> Ordering)
-> (Negation -> Negation -> Bool)
-> (Negation -> Negation -> Bool)
-> (Negation -> Negation -> Bool)
-> (Negation -> Negation -> Bool)
-> (Negation -> Negation -> Negation)
-> (Negation -> Negation -> Negation)
-> Ord 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
$ccompare :: Negation -> Negation -> Ordering
compare :: Negation -> Negation -> Ordering
$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
>= :: Negation -> Negation -> Bool
$cmax :: Negation -> Negation -> Negation
max :: Negation -> Negation -> Negation
$cmin :: Negation -> Negation -> Negation
min :: Negation -> Negation -> Negation
Ord, Int -> Negation -> ShowS
[Negation] -> ShowS
Negation -> String
(Int -> Negation -> ShowS)
-> (Negation -> String) -> ([Negation] -> ShowS) -> Show Negation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Negation -> ShowS
showsPrec :: Int -> Negation -> ShowS
$cshow :: Negation -> String
show :: Negation -> String
$cshowList :: [Negation] -> ShowS
showList :: [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
Typeable Attrib
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Attrib -> c Attrib)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Attrib)
-> (Attrib -> Constr)
-> (Attrib -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Attrib -> Attrib)
-> (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 u. (forall d. Data d => d -> u) -> Attrib -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Attrib -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Attrib -> m Attrib)
-> Data Attrib
Attrib -> Constr
Attrib -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attrib -> c Attrib
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attrib -> c Attrib
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attrib
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attrib
$ctoConstr :: Attrib -> Constr
toConstr :: Attrib -> Constr
$cdataTypeOf :: Attrib -> DataType
dataTypeOf :: Attrib -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attrib)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attrib)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attrib)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attrib)
$cgmapT :: (forall b. Data b => b -> b) -> Attrib -> Attrib
gmapT :: (forall b. Data b => b -> b) -> Attrib -> Attrib
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Attrib -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Attrib -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Attrib -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Attrib -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Attrib -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Attrib -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attrib -> m Attrib
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attrib -> m Attrib
Data, Attrib -> Attrib -> Bool
(Attrib -> Attrib -> Bool)
-> (Attrib -> Attrib -> Bool) -> Eq Attrib
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Attrib -> Attrib -> Bool
== :: Attrib -> Attrib -> Bool
$c/= :: Attrib -> Attrib -> Bool
/= :: Attrib -> Attrib -> Bool
Eq, (forall x. Attrib -> Rep Attrib x)
-> (forall x. Rep Attrib x -> Attrib) -> Generic Attrib
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
$cfrom :: forall x. Attrib -> Rep Attrib x
from :: forall x. Attrib -> Rep Attrib x
$cto :: forall x. Rep Attrib x -> Attrib
to :: forall x. Rep Attrib x -> Attrib
Generic, Eq Attrib
Eq Attrib
-> (Attrib -> Attrib -> Ordering)
-> (Attrib -> Attrib -> Bool)
-> (Attrib -> Attrib -> Bool)
-> (Attrib -> Attrib -> Bool)
-> (Attrib -> Attrib -> Bool)
-> (Attrib -> Attrib -> Attrib)
-> (Attrib -> Attrib -> Attrib)
-> Ord 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
$ccompare :: Attrib -> Attrib -> Ordering
compare :: Attrib -> Attrib -> Ordering
$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
>= :: Attrib -> Attrib -> Bool
$cmax :: Attrib -> Attrib -> Attrib
max :: Attrib -> Attrib -> Attrib
$cmin :: Attrib -> Attrib -> Attrib
min :: Attrib -> Attrib -> Attrib
Ord, Int -> Attrib -> ShowS
[Attrib] -> ShowS
Attrib -> String
(Int -> Attrib -> ShowS)
-> (Attrib -> String) -> ([Attrib] -> ShowS) -> Show Attrib
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Attrib -> ShowS
showsPrec :: Int -> Attrib -> ShowS
$cshow :: Attrib -> String
show :: Attrib -> String
$cshowList :: [Attrib] -> ShowS
showList :: [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 = (AttributeName -> AttributeCombinator -> Text -> Attrib)
-> AttributeCombinator -> AttributeName -> Text -> 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
(.#) = ((SelectorFilter -> SelectorSequence)
-> (Hash -> SelectorFilter) -> Hash -> SelectorSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> SelectorFilter
SHash) ((SelectorFilter -> SelectorSequence) -> Hash -> SelectorSequence)
-> (SelectorSequence -> SelectorFilter -> SelectorSequence)
-> SelectorSequence
-> Hash
-> SelectorSequence
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
(...) = ((SelectorFilter -> SelectorSequence)
-> (Class -> SelectorFilter) -> Class -> SelectorSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> SelectorFilter
SClass) ((SelectorFilter -> SelectorSequence) -> Class -> SelectorSequence)
-> (SelectorSequence -> SelectorFilter -> SelectorSequence)
-> SelectorSequence
-> Class
-> SelectorSequence
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
(.:) = ((SelectorFilter -> SelectorSequence)
-> (PseudoClass -> SelectorFilter)
-> PseudoClass
-> SelectorSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PseudoClass -> SelectorFilter
SPseudo) ((SelectorFilter -> SelectorSequence)
 -> PseudoClass -> SelectorSequence)
-> (SelectorSequence -> SelectorFilter -> SelectorSequence)
-> SelectorSequence
-> PseudoClass
-> SelectorSequence
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
Typeable Namespace
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Namespace -> c Namespace)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Namespace)
-> (Namespace -> Constr)
-> (Namespace -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Namespace -> Namespace)
-> (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 u. (forall d. Data d => d -> u) -> Namespace -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Namespace -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Namespace -> m Namespace)
-> Data Namespace
Namespace -> Constr
Namespace -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Namespace -> c Namespace
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Namespace -> c Namespace
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Namespace
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Namespace
$ctoConstr :: Namespace -> Constr
toConstr :: Namespace -> Constr
$cdataTypeOf :: Namespace -> DataType
dataTypeOf :: Namespace -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Namespace)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Namespace)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Namespace)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Namespace)
$cgmapT :: (forall b. Data b => b -> b) -> Namespace -> Namespace
gmapT :: (forall b. Data b => b -> b) -> Namespace -> Namespace
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Namespace -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Namespace -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Namespace -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Namespace -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Namespace -> m Namespace
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Namespace -> m Namespace
Data, Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
/= :: Namespace -> Namespace -> Bool
Eq, (forall x. Namespace -> Rep Namespace x)
-> (forall x. Rep Namespace x -> Namespace) -> Generic Namespace
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
$cfrom :: forall x. Namespace -> Rep Namespace x
from :: forall x. Namespace -> Rep Namespace x
$cto :: forall x. Rep Namespace x -> Namespace
to :: forall x. Rep Namespace x -> Namespace
Generic, Eq Namespace
Eq Namespace
-> (Namespace -> Namespace -> Ordering)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Namespace)
-> (Namespace -> Namespace -> Namespace)
-> Ord 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
$ccompare :: Namespace -> Namespace -> Ordering
compare :: Namespace -> Namespace -> Ordering
$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
>= :: Namespace -> Namespace -> Bool
$cmax :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
min :: Namespace -> Namespace -> Namespace
Ord, Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Namespace -> ShowS
showsPrec :: Int -> Namespace -> ShowS
$cshow :: Namespace -> String
show :: Namespace -> String
$cshowList :: [Namespace] -> ShowS
showList :: [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 $mNEmpty :: forall {r}. Namespace -> ((# #) -> r) -> ((# #) -> r) -> r
$bNEmpty :: Namespace
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
Typeable ElementName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ElementName -> c ElementName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ElementName)
-> (ElementName -> Constr)
-> (ElementName -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> ElementName -> ElementName)
-> (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 u. (forall d. Data d => d -> u) -> ElementName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ElementName -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ElementName -> m ElementName)
-> Data ElementName
ElementName -> Constr
ElementName -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ElementName -> c ElementName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ElementName -> c ElementName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ElementName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ElementName
$ctoConstr :: ElementName -> Constr
toConstr :: ElementName -> Constr
$cdataTypeOf :: ElementName -> DataType
dataTypeOf :: ElementName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ElementName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ElementName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ElementName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ElementName)
$cgmapT :: (forall b. Data b => b -> b) -> ElementName -> ElementName
gmapT :: (forall b. Data b => b -> b) -> ElementName -> ElementName
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ElementName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ElementName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ElementName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ElementName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ElementName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ElementName -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ElementName -> m ElementName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ElementName -> m ElementName
Data, ElementName -> ElementName -> Bool
(ElementName -> ElementName -> Bool)
-> (ElementName -> ElementName -> Bool) -> Eq ElementName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElementName -> ElementName -> Bool
== :: ElementName -> ElementName -> Bool
$c/= :: ElementName -> ElementName -> Bool
/= :: ElementName -> ElementName -> Bool
Eq, (forall x. ElementName -> Rep ElementName x)
-> (forall x. Rep ElementName x -> ElementName)
-> Generic ElementName
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
$cfrom :: forall x. ElementName -> Rep ElementName x
from :: forall x. ElementName -> Rep ElementName x
$cto :: forall x. Rep ElementName x -> ElementName
to :: forall x. Rep ElementName x -> ElementName
Generic, Eq ElementName
Eq ElementName
-> (ElementName -> ElementName -> Ordering)
-> (ElementName -> ElementName -> Bool)
-> (ElementName -> ElementName -> Bool)
-> (ElementName -> ElementName -> Bool)
-> (ElementName -> ElementName -> Bool)
-> (ElementName -> ElementName -> ElementName)
-> (ElementName -> ElementName -> ElementName)
-> Ord 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
$ccompare :: ElementName -> ElementName -> Ordering
compare :: ElementName -> ElementName -> Ordering
$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
>= :: ElementName -> ElementName -> Bool
$cmax :: ElementName -> ElementName -> ElementName
max :: ElementName -> ElementName -> ElementName
$cmin :: ElementName -> ElementName -> ElementName
min :: ElementName -> ElementName -> ElementName
Ord, Int -> ElementName -> ShowS
[ElementName] -> ShowS
ElementName -> String
(Int -> ElementName -> ShowS)
-> (ElementName -> String)
-> ([ElementName] -> ShowS)
-> Show ElementName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElementName -> ShowS
showsPrec :: Int -> ElementName -> ShowS
$cshow :: ElementName -> String
show :: ElementName -> String
$cshowList :: [ElementName] -> ShowS
showList :: [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
Typeable TypeSelector
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TypeSelector -> c TypeSelector)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TypeSelector)
-> (TypeSelector -> Constr)
-> (TypeSelector -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> TypeSelector -> TypeSelector)
-> (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 u. (forall d. Data d => d -> u) -> TypeSelector -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TypeSelector -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TypeSelector -> m TypeSelector)
-> Data TypeSelector
TypeSelector -> Constr
TypeSelector -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSelector -> c TypeSelector
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSelector -> c TypeSelector
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSelector
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSelector
$ctoConstr :: TypeSelector -> Constr
toConstr :: TypeSelector -> Constr
$cdataTypeOf :: TypeSelector -> DataType
dataTypeOf :: TypeSelector -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeSelector)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeSelector)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeSelector)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeSelector)
$cgmapT :: (forall b. Data b => b -> b) -> TypeSelector -> TypeSelector
gmapT :: (forall b. Data b => b -> b) -> TypeSelector -> TypeSelector
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSelector -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSelector -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeSelector -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeSelector -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeSelector -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeSelector -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSelector -> m TypeSelector
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSelector -> m TypeSelector
Data, TypeSelector -> TypeSelector -> Bool
(TypeSelector -> TypeSelector -> Bool)
-> (TypeSelector -> TypeSelector -> Bool) -> Eq TypeSelector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeSelector -> TypeSelector -> Bool
== :: TypeSelector -> TypeSelector -> Bool
$c/= :: TypeSelector -> TypeSelector -> Bool
/= :: TypeSelector -> TypeSelector -> Bool
Eq, (forall x. TypeSelector -> Rep TypeSelector x)
-> (forall x. Rep TypeSelector x -> TypeSelector)
-> Generic TypeSelector
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
$cfrom :: forall x. TypeSelector -> Rep TypeSelector x
from :: forall x. TypeSelector -> Rep TypeSelector x
$cto :: forall x. Rep TypeSelector x -> TypeSelector
to :: forall x. Rep TypeSelector x -> TypeSelector
Generic, Eq TypeSelector
Eq TypeSelector
-> (TypeSelector -> TypeSelector -> Ordering)
-> (TypeSelector -> TypeSelector -> Bool)
-> (TypeSelector -> TypeSelector -> Bool)
-> (TypeSelector -> TypeSelector -> Bool)
-> (TypeSelector -> TypeSelector -> Bool)
-> (TypeSelector -> TypeSelector -> TypeSelector)
-> (TypeSelector -> TypeSelector -> TypeSelector)
-> Ord 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
$ccompare :: TypeSelector -> TypeSelector -> Ordering
compare :: TypeSelector -> TypeSelector -> Ordering
$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
>= :: TypeSelector -> TypeSelector -> Bool
$cmax :: TypeSelector -> TypeSelector -> TypeSelector
max :: TypeSelector -> TypeSelector -> TypeSelector
$cmin :: TypeSelector -> TypeSelector -> TypeSelector
min :: TypeSelector -> TypeSelector -> TypeSelector
Ord, Int -> TypeSelector -> ShowS
[TypeSelector] -> ShowS
TypeSelector -> String
(Int -> TypeSelector -> ShowS)
-> (TypeSelector -> String)
-> ([TypeSelector] -> ShowS)
-> Show TypeSelector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeSelector -> ShowS
showsPrec :: Int -> TypeSelector -> ShowS
$cshow :: TypeSelector -> String
show :: TypeSelector -> String
$cshowList :: [TypeSelector] -> ShowS
showList :: [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
Typeable AttributeName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AttributeName -> c AttributeName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AttributeName)
-> (AttributeName -> Constr)
-> (AttributeName -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> AttributeName -> AttributeName)
-> (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 u. (forall d. Data d => d -> u) -> AttributeName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AttributeName -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AttributeName -> m AttributeName)
-> Data AttributeName
AttributeName -> Constr
AttributeName -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeName -> c AttributeName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeName -> c AttributeName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeName
$ctoConstr :: AttributeName -> Constr
toConstr :: AttributeName -> Constr
$cdataTypeOf :: AttributeName -> DataType
dataTypeOf :: AttributeName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeName)
$cgmapT :: (forall b. Data b => b -> b) -> AttributeName -> AttributeName
gmapT :: (forall b. Data b => b -> b) -> AttributeName -> AttributeName
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AttributeName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AttributeName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AttributeName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AttributeName -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AttributeName -> m AttributeName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AttributeName -> m AttributeName
Data, AttributeName -> AttributeName -> Bool
(AttributeName -> AttributeName -> Bool)
-> (AttributeName -> AttributeName -> Bool) -> Eq AttributeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttributeName -> AttributeName -> Bool
== :: AttributeName -> AttributeName -> Bool
$c/= :: AttributeName -> AttributeName -> Bool
/= :: AttributeName -> AttributeName -> Bool
Eq, (forall x. AttributeName -> Rep AttributeName x)
-> (forall x. Rep AttributeName x -> AttributeName)
-> Generic AttributeName
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
$cfrom :: forall x. AttributeName -> Rep AttributeName x
from :: forall x. AttributeName -> Rep AttributeName x
$cto :: forall x. Rep AttributeName x -> AttributeName
to :: forall x. Rep AttributeName x -> AttributeName
Generic, Eq AttributeName
Eq AttributeName
-> (AttributeName -> AttributeName -> Ordering)
-> (AttributeName -> AttributeName -> Bool)
-> (AttributeName -> AttributeName -> Bool)
-> (AttributeName -> AttributeName -> Bool)
-> (AttributeName -> AttributeName -> Bool)
-> (AttributeName -> AttributeName -> AttributeName)
-> (AttributeName -> AttributeName -> AttributeName)
-> Ord 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
$ccompare :: AttributeName -> AttributeName -> Ordering
compare :: AttributeName -> AttributeName -> Ordering
$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
>= :: AttributeName -> AttributeName -> Bool
$cmax :: AttributeName -> AttributeName -> AttributeName
max :: AttributeName -> AttributeName -> AttributeName
$cmin :: AttributeName -> AttributeName -> AttributeName
min :: AttributeName -> AttributeName -> AttributeName
Ord, Int -> AttributeName -> ShowS
[AttributeName] -> ShowS
AttributeName -> String
(Int -> AttributeName -> ShowS)
-> (AttributeName -> String)
-> ([AttributeName] -> ShowS)
-> Show AttributeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttributeName -> ShowS
showsPrec :: Int -> AttributeName -> ShowS
$cshow :: AttributeName -> String
show :: AttributeName -> String
$cshowList :: [AttributeName] -> ShowS
showList :: [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
AttributeCombinator
-> AttributeCombinator -> Bounded AttributeCombinator
forall a. a -> a -> Bounded a
$cminBound :: AttributeCombinator
minBound :: AttributeCombinator
$cmaxBound :: AttributeCombinator
maxBound :: AttributeCombinator
Bounded, Typeable AttributeCombinator
Typeable AttributeCombinator
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> AttributeCombinator
    -> c AttributeCombinator)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AttributeCombinator)
-> (AttributeCombinator -> Constr)
-> (AttributeCombinator -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> AttributeCombinator -> AttributeCombinator)
-> (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 u.
    (forall d. Data d => d -> u) -> AttributeCombinator -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AttributeCombinator -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AttributeCombinator -> m AttributeCombinator)
-> Data AttributeCombinator
AttributeCombinator -> Constr
AttributeCombinator -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AttributeCombinator
-> c AttributeCombinator
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AttributeCombinator
-> c AttributeCombinator
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeCombinator
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeCombinator
$ctoConstr :: AttributeCombinator -> Constr
toConstr :: AttributeCombinator -> Constr
$cdataTypeOf :: AttributeCombinator -> DataType
dataTypeOf :: AttributeCombinator -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeCombinator)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeCombinator)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeCombinator)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeCombinator)
$cgmapT :: (forall b. Data b => b -> b)
-> AttributeCombinator -> AttributeCombinator
gmapT :: (forall b. Data b => b -> b)
-> AttributeCombinator -> AttributeCombinator
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AttributeCombinator -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> AttributeCombinator -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AttributeCombinator -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AttributeCombinator -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
Data, Int -> AttributeCombinator
AttributeCombinator -> Int
AttributeCombinator -> [AttributeCombinator]
AttributeCombinator -> AttributeCombinator
AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
AttributeCombinator
-> AttributeCombinator
-> AttributeCombinator
-> [AttributeCombinator]
(AttributeCombinator -> AttributeCombinator)
-> (AttributeCombinator -> AttributeCombinator)
-> (Int -> AttributeCombinator)
-> (AttributeCombinator -> Int)
-> (AttributeCombinator -> [AttributeCombinator])
-> (AttributeCombinator
    -> AttributeCombinator -> [AttributeCombinator])
-> (AttributeCombinator
    -> AttributeCombinator -> [AttributeCombinator])
-> (AttributeCombinator
    -> AttributeCombinator
    -> AttributeCombinator
    -> [AttributeCombinator])
-> Enum 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
$csucc :: AttributeCombinator -> AttributeCombinator
succ :: AttributeCombinator -> AttributeCombinator
$cpred :: AttributeCombinator -> AttributeCombinator
pred :: AttributeCombinator -> AttributeCombinator
$ctoEnum :: Int -> AttributeCombinator
toEnum :: Int -> AttributeCombinator
$cfromEnum :: AttributeCombinator -> Int
fromEnum :: AttributeCombinator -> Int
$cenumFrom :: AttributeCombinator -> [AttributeCombinator]
enumFrom :: AttributeCombinator -> [AttributeCombinator]
$cenumFromThen :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
enumFromThen :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
$cenumFromTo :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
enumFromTo :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
$cenumFromThenTo :: AttributeCombinator
-> AttributeCombinator
-> AttributeCombinator
-> [AttributeCombinator]
enumFromThenTo :: AttributeCombinator
-> AttributeCombinator
-> AttributeCombinator
-> [AttributeCombinator]
Enum, AttributeCombinator -> AttributeCombinator -> Bool
(AttributeCombinator -> AttributeCombinator -> Bool)
-> (AttributeCombinator -> AttributeCombinator -> Bool)
-> Eq AttributeCombinator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttributeCombinator -> AttributeCombinator -> Bool
== :: AttributeCombinator -> AttributeCombinator -> Bool
$c/= :: AttributeCombinator -> AttributeCombinator -> Bool
/= :: AttributeCombinator -> AttributeCombinator -> Bool
Eq, (forall x. AttributeCombinator -> Rep AttributeCombinator x)
-> (forall x. Rep AttributeCombinator x -> AttributeCombinator)
-> Generic AttributeCombinator
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
$cfrom :: forall x. AttributeCombinator -> Rep AttributeCombinator x
from :: forall x. AttributeCombinator -> Rep AttributeCombinator x
$cto :: forall x. Rep AttributeCombinator x -> AttributeCombinator
to :: forall x. Rep AttributeCombinator x -> AttributeCombinator
Generic, Eq AttributeCombinator
Eq AttributeCombinator
-> (AttributeCombinator -> AttributeCombinator -> Ordering)
-> (AttributeCombinator -> AttributeCombinator -> Bool)
-> (AttributeCombinator -> AttributeCombinator -> Bool)
-> (AttributeCombinator -> AttributeCombinator -> Bool)
-> (AttributeCombinator -> AttributeCombinator -> Bool)
-> (AttributeCombinator
    -> AttributeCombinator -> AttributeCombinator)
-> (AttributeCombinator
    -> AttributeCombinator -> AttributeCombinator)
-> Ord 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
$ccompare :: AttributeCombinator -> AttributeCombinator -> Ordering
compare :: AttributeCombinator -> AttributeCombinator -> Ordering
$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
>= :: AttributeCombinator -> AttributeCombinator -> Bool
$cmax :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
max :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
$cmin :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
min :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
Ord, ReadPrec [AttributeCombinator]
ReadPrec AttributeCombinator
Int -> ReadS AttributeCombinator
ReadS [AttributeCombinator]
(Int -> ReadS AttributeCombinator)
-> ReadS [AttributeCombinator]
-> ReadPrec AttributeCombinator
-> ReadPrec [AttributeCombinator]
-> Read AttributeCombinator
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AttributeCombinator
readsPrec :: Int -> ReadS AttributeCombinator
$creadList :: ReadS [AttributeCombinator]
readList :: ReadS [AttributeCombinator]
$creadPrec :: ReadPrec AttributeCombinator
readPrec :: ReadPrec AttributeCombinator
$creadListPrec :: ReadPrec [AttributeCombinator]
readListPrec :: ReadPrec [AttributeCombinator]
Read, Int -> AttributeCombinator -> ShowS
[AttributeCombinator] -> ShowS
AttributeCombinator -> String
(Int -> AttributeCombinator -> ShowS)
-> (AttributeCombinator -> String)
-> ([AttributeCombinator] -> ShowS)
-> Show AttributeCombinator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttributeCombinator -> ShowS
showsPrec :: Int -> AttributeCombinator -> ShowS
$cshow :: AttributeCombinator -> String
show :: AttributeCombinator -> String
$cshowList :: [AttributeCombinator] -> ShowS
showList :: [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
Typeable PseudoClass
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PseudoClass -> c PseudoClass)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PseudoClass)
-> (PseudoClass -> Constr)
-> (PseudoClass -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> PseudoClass -> PseudoClass)
-> (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 u. (forall d. Data d => d -> u) -> PseudoClass -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PseudoClass -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PseudoClass -> m PseudoClass)
-> Data PseudoClass
PseudoClass -> Constr
PseudoClass -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PseudoClass -> c PseudoClass
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PseudoClass -> c PseudoClass
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoClass
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoClass
$ctoConstr :: PseudoClass -> Constr
toConstr :: PseudoClass -> Constr
$cdataTypeOf :: PseudoClass -> DataType
dataTypeOf :: PseudoClass -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoClass)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoClass)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoClass)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoClass)
$cgmapT :: (forall b. Data b => b -> b) -> PseudoClass -> PseudoClass
gmapT :: (forall b. Data b => b -> b) -> PseudoClass -> PseudoClass
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoClass -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoClass -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PseudoClass -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PseudoClass -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PseudoClass -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PseudoClass -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoClass -> m PseudoClass
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoClass -> m PseudoClass
Data, PseudoClass -> PseudoClass -> Bool
(PseudoClass -> PseudoClass -> Bool)
-> (PseudoClass -> PseudoClass -> Bool) -> Eq PseudoClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PseudoClass -> PseudoClass -> Bool
== :: PseudoClass -> PseudoClass -> Bool
$c/= :: PseudoClass -> PseudoClass -> Bool
/= :: PseudoClass -> PseudoClass -> Bool
Eq, (forall x. PseudoClass -> Rep PseudoClass x)
-> (forall x. Rep PseudoClass x -> PseudoClass)
-> Generic PseudoClass
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
$cfrom :: forall x. PseudoClass -> Rep PseudoClass x
from :: forall x. PseudoClass -> Rep PseudoClass x
$cto :: forall x. Rep PseudoClass x -> PseudoClass
to :: forall x. Rep PseudoClass x -> PseudoClass
Generic, Eq PseudoClass
Eq PseudoClass
-> (PseudoClass -> PseudoClass -> Ordering)
-> (PseudoClass -> PseudoClass -> Bool)
-> (PseudoClass -> PseudoClass -> Bool)
-> (PseudoClass -> PseudoClass -> Bool)
-> (PseudoClass -> PseudoClass -> Bool)
-> (PseudoClass -> PseudoClass -> PseudoClass)
-> (PseudoClass -> PseudoClass -> PseudoClass)
-> Ord 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
$ccompare :: PseudoClass -> PseudoClass -> Ordering
compare :: PseudoClass -> PseudoClass -> Ordering
$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
>= :: PseudoClass -> PseudoClass -> Bool
$cmax :: PseudoClass -> PseudoClass -> PseudoClass
max :: PseudoClass -> PseudoClass -> PseudoClass
$cmin :: PseudoClass -> PseudoClass -> PseudoClass
min :: PseudoClass -> PseudoClass -> PseudoClass
Ord, ReadPrec [PseudoClass]
ReadPrec PseudoClass
Int -> ReadS PseudoClass
ReadS [PseudoClass]
(Int -> ReadS PseudoClass)
-> ReadS [PseudoClass]
-> ReadPrec PseudoClass
-> ReadPrec [PseudoClass]
-> Read PseudoClass
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PseudoClass
readsPrec :: Int -> ReadS PseudoClass
$creadList :: ReadS [PseudoClass]
readList :: ReadS [PseudoClass]
$creadPrec :: ReadPrec PseudoClass
readPrec :: ReadPrec PseudoClass
$creadListPrec :: ReadPrec [PseudoClass]
readListPrec :: ReadPrec [PseudoClass]
Read, Int -> PseudoClass -> ShowS
[PseudoClass] -> ShowS
PseudoClass -> String
(Int -> PseudoClass -> ShowS)
-> (PseudoClass -> String)
-> ([PseudoClass] -> ShowS)
-> Show PseudoClass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PseudoClass -> ShowS
showsPrec :: Int -> PseudoClass -> ShowS
$cshow :: PseudoClass -> String
show :: PseudoClass -> String
$cshowList :: [PseudoClass] -> ShowS
showList :: [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 $mFirstChild :: forall {r}. PseudoClass -> ((# #) -> r) -> ((# #) -> r) -> r
$bFirstChild :: PseudoClass
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 $mFirstOfType :: forall {r}. PseudoClass -> ((# #) -> r) -> ((# #) -> r) -> r
$bFirstOfType :: PseudoClass
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 $mLastChild :: forall {r}. PseudoClass -> ((# #) -> r) -> ((# #) -> r) -> r
$bLastChild :: PseudoClass
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 $mLastOfType :: forall {r}. PseudoClass -> ((# #) -> r) -> ((# #) -> r) -> r
$bLastOfType :: PseudoClass
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
PseudoElement -> PseudoElement -> Bounded PseudoElement
forall a. a -> a -> Bounded a
$cminBound :: PseudoElement
minBound :: PseudoElement
$cmaxBound :: PseudoElement
maxBound :: PseudoElement
Bounded, Typeable PseudoElement
Typeable PseudoElement
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PseudoElement -> c PseudoElement)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PseudoElement)
-> (PseudoElement -> Constr)
-> (PseudoElement -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> PseudoElement -> PseudoElement)
-> (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 u. (forall d. Data d => d -> u) -> PseudoElement -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PseudoElement -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PseudoElement -> m PseudoElement)
-> Data PseudoElement
PseudoElement -> Constr
PseudoElement -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PseudoElement -> c PseudoElement
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PseudoElement -> c PseudoElement
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoElement
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PseudoElement
$ctoConstr :: PseudoElement -> Constr
toConstr :: PseudoElement -> Constr
$cdataTypeOf :: PseudoElement -> DataType
dataTypeOf :: PseudoElement -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoElement)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PseudoElement)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoElement)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PseudoElement)
$cgmapT :: (forall b. Data b => b -> b) -> PseudoElement -> PseudoElement
gmapT :: (forall b. Data b => b -> b) -> PseudoElement -> PseudoElement
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoElement -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PseudoElement -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PseudoElement -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PseudoElement -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PseudoElement -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PseudoElement -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoElement -> m PseudoElement
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PseudoElement -> m PseudoElement
Data, Int -> PseudoElement
PseudoElement -> Int
PseudoElement -> [PseudoElement]
PseudoElement -> PseudoElement
PseudoElement -> PseudoElement -> [PseudoElement]
PseudoElement -> PseudoElement -> PseudoElement -> [PseudoElement]
(PseudoElement -> PseudoElement)
-> (PseudoElement -> PseudoElement)
-> (Int -> PseudoElement)
-> (PseudoElement -> Int)
-> (PseudoElement -> [PseudoElement])
-> (PseudoElement -> PseudoElement -> [PseudoElement])
-> (PseudoElement -> PseudoElement -> [PseudoElement])
-> (PseudoElement
    -> PseudoElement -> PseudoElement -> [PseudoElement])
-> Enum 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
$csucc :: PseudoElement -> PseudoElement
succ :: PseudoElement -> PseudoElement
$cpred :: PseudoElement -> PseudoElement
pred :: PseudoElement -> PseudoElement
$ctoEnum :: Int -> PseudoElement
toEnum :: Int -> PseudoElement
$cfromEnum :: PseudoElement -> Int
fromEnum :: PseudoElement -> Int
$cenumFrom :: PseudoElement -> [PseudoElement]
enumFrom :: PseudoElement -> [PseudoElement]
$cenumFromThen :: PseudoElement -> PseudoElement -> [PseudoElement]
enumFromThen :: PseudoElement -> PseudoElement -> [PseudoElement]
$cenumFromTo :: PseudoElement -> PseudoElement -> [PseudoElement]
enumFromTo :: PseudoElement -> PseudoElement -> [PseudoElement]
$cenumFromThenTo :: PseudoElement -> PseudoElement -> PseudoElement -> [PseudoElement]
enumFromThenTo :: PseudoElement -> PseudoElement -> PseudoElement -> [PseudoElement]
Enum, PseudoElement -> PseudoElement -> Bool
(PseudoElement -> PseudoElement -> Bool)
-> (PseudoElement -> PseudoElement -> Bool) -> Eq PseudoElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PseudoElement -> PseudoElement -> Bool
== :: PseudoElement -> PseudoElement -> Bool
$c/= :: PseudoElement -> PseudoElement -> Bool
/= :: PseudoElement -> PseudoElement -> Bool
Eq, (forall x. PseudoElement -> Rep PseudoElement x)
-> (forall x. Rep PseudoElement x -> PseudoElement)
-> Generic PseudoElement
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
$cfrom :: forall x. PseudoElement -> Rep PseudoElement x
from :: forall x. PseudoElement -> Rep PseudoElement x
$cto :: forall x. Rep PseudoElement x -> PseudoElement
to :: forall x. Rep PseudoElement x -> PseudoElement
Generic, Eq PseudoElement
Eq PseudoElement
-> (PseudoElement -> PseudoElement -> Ordering)
-> (PseudoElement -> PseudoElement -> Bool)
-> (PseudoElement -> PseudoElement -> Bool)
-> (PseudoElement -> PseudoElement -> Bool)
-> (PseudoElement -> PseudoElement -> Bool)
-> (PseudoElement -> PseudoElement -> PseudoElement)
-> (PseudoElement -> PseudoElement -> PseudoElement)
-> Ord 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
$ccompare :: PseudoElement -> PseudoElement -> Ordering
compare :: PseudoElement -> PseudoElement -> Ordering
$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
>= :: PseudoElement -> PseudoElement -> Bool
$cmax :: PseudoElement -> PseudoElement -> PseudoElement
max :: PseudoElement -> PseudoElement -> PseudoElement
$cmin :: PseudoElement -> PseudoElement -> PseudoElement
min :: PseudoElement -> PseudoElement -> PseudoElement
Ord, ReadPrec [PseudoElement]
ReadPrec PseudoElement
Int -> ReadS PseudoElement
ReadS [PseudoElement]
(Int -> ReadS PseudoElement)
-> ReadS [PseudoElement]
-> ReadPrec PseudoElement
-> ReadPrec [PseudoElement]
-> Read PseudoElement
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PseudoElement
readsPrec :: Int -> ReadS PseudoElement
$creadList :: ReadS [PseudoElement]
readList :: ReadS [PseudoElement]
$creadPrec :: ReadPrec PseudoElement
readPrec :: ReadPrec PseudoElement
$creadListPrec :: ReadPrec [PseudoElement]
readListPrec :: ReadPrec [PseudoElement]
Read, Int -> PseudoElement -> ShowS
[PseudoElement] -> ShowS
PseudoElement -> String
(Int -> PseudoElement -> ShowS)
-> (PseudoElement -> String)
-> ([PseudoElement] -> ShowS)
-> Show PseudoElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PseudoElement -> ShowS
showsPrec :: Int -> PseudoElement -> ShowS
$cshow :: PseudoElement -> String
show :: PseudoElement -> String
$cshowList :: [PseudoElement] -> ShowS
showList :: [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
Typeable Class
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Class -> c Class)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Class)
-> (Class -> Constr)
-> (Class -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Class -> Class)
-> (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 u. (forall d. Data d => d -> u) -> Class -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Class -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Class -> m Class)
-> Data Class
Class -> Constr
Class -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Class -> c Class
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Class -> c Class
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Class
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Class
$ctoConstr :: Class -> Constr
toConstr :: Class -> Constr
$cdataTypeOf :: Class -> DataType
dataTypeOf :: Class -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Class)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Class)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Class)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Class)
$cgmapT :: (forall b. Data b => b -> b) -> Class -> Class
gmapT :: (forall b. Data b => b -> b) -> Class -> Class
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Class -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Class -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Class -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Class -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Class -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Class -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Class -> m Class
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Class -> m Class
Data, Class -> Class -> Bool
(Class -> Class -> Bool) -> (Class -> Class -> Bool) -> Eq Class
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Class -> Class -> Bool
== :: Class -> Class -> Bool
$c/= :: Class -> Class -> Bool
/= :: Class -> Class -> Bool
Eq, (forall x. Class -> Rep Class x)
-> (forall x. Rep Class x -> Class) -> Generic Class
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
$cfrom :: forall x. Class -> Rep Class x
from :: forall x. Class -> Rep Class x
$cto :: forall x. Rep Class x -> Class
to :: forall x. Rep Class x -> Class
Generic, Eq Class
Eq Class
-> (Class -> Class -> Ordering)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Class)
-> (Class -> Class -> Class)
-> Ord 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
$ccompare :: Class -> Class -> Ordering
compare :: Class -> Class -> Ordering
$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
>= :: Class -> Class -> Bool
$cmax :: Class -> Class -> Class
max :: Class -> Class -> Class
$cmin :: Class -> Class -> Class
min :: Class -> Class -> Class
Ord, Int -> Class -> ShowS
[Class] -> ShowS
Class -> String
(Int -> Class -> ShowS)
-> (Class -> String) -> ([Class] -> ShowS) -> Show Class
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Class -> ShowS
showsPrec :: Int -> Class -> ShowS
$cshow :: Class -> String
show :: Class -> String
$cshowList :: [Class] -> ShowS
showList :: [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
Typeable Hash
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Hash -> c Hash)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Hash)
-> (Hash -> Constr)
-> (Hash -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Hash -> Hash)
-> (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 u. (forall d. Data d => d -> u) -> Hash -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Hash -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Hash -> m Hash)
-> Data Hash
Hash -> Constr
Hash -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hash -> c Hash
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hash -> c Hash
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Hash
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Hash
$ctoConstr :: Hash -> Constr
toConstr :: Hash -> Constr
$cdataTypeOf :: Hash -> DataType
dataTypeOf :: Hash -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Hash)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Hash)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Hash)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Hash)
$cgmapT :: (forall b. Data b => b -> b) -> Hash -> Hash
gmapT :: (forall b. Data b => b -> b) -> Hash -> Hash
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hash -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hash -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Hash -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Hash -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Hash -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Hash -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hash -> m Hash
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hash -> m Hash
Data, Hash -> Hash -> Bool
(Hash -> Hash -> Bool) -> (Hash -> Hash -> Bool) -> Eq Hash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash -> Hash -> Bool
== :: Hash -> Hash -> Bool
$c/= :: Hash -> Hash -> Bool
/= :: Hash -> Hash -> Bool
Eq, (forall x. Hash -> Rep Hash x)
-> (forall x. Rep Hash x -> Hash) -> Generic Hash
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
$cfrom :: forall x. Hash -> Rep Hash x
from :: forall x. Hash -> Rep Hash x
$cto :: forall x. Rep Hash x -> Hash
to :: forall x. Rep Hash x -> Hash
Generic, Eq Hash
Eq Hash
-> (Hash -> Hash -> Ordering)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Hash)
-> (Hash -> Hash -> Hash)
-> Ord 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
$ccompare :: Hash -> Hash -> Ordering
compare :: Hash -> Hash -> Ordering
$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
>= :: Hash -> Hash -> Bool
$cmax :: Hash -> Hash -> Hash
max :: Hash -> Hash -> Hash
$cmin :: Hash -> Hash -> Hash
min :: Hash -> Hash -> Hash
Ord, Int -> Hash -> ShowS
[Hash] -> ShowS
Hash -> String
(Int -> Hash -> ShowS)
-> (Hash -> String) -> ([Hash] -> ShowS) -> Show Hash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash -> ShowS
showsPrec :: Int -> Hash -> ShowS
$cshow :: Hash -> String
show :: Hash -> String
$cshowList :: [Hash] -> ShowS
showList :: [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 $mUniversal :: forall {r}. TypeSelector -> ((# #) -> r) -> ((# #) -> r) -> r
$bUniversal :: TypeSelector
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
a1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
a2) (Int
b1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b2) (Int
c1Int -> Int -> Int
forall 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 NonEmpty Selector -> NonEmpty Selector -> NonEmpty Selector
forall a. Semigroup a => a -> a -> a
<> NonEmpty Selector
g2)

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

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

instance Semigroup ElementName where
    <> :: ElementName -> ElementName -> ElementName
(<>) ElementName
EAny = ElementName -> ElementName
forall a. a -> a
id
    (<>) ElementName
x = ElementName -> ElementName -> ElementName
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 = (Text -> Class) -> String -> Class
forall a. (Text -> a) -> String -> a
toIdentifier Text -> Class
Class

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

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

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

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

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

instance IsString PseudoClass where
    fromString :: String -> PseudoClass
fromString = String -> PseudoClass
go (String -> PseudoClass) -> ShowS -> String -> PseudoClass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
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 = String -> PseudoClass
forall a. HasCallStack => String -> a
error (String
"The pseudo class \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
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 (String -> Nth -> PseudoClass)
-> ShowS -> String -> Nth -> PseudoClass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
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 = String -> Nth -> PseudoClass
forall a. HasCallStack => String -> a
error (String
"There is no pseudo class \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" that takes an Nth object as parameter.")

instance IsString PseudoElement where
    fromString :: String -> PseudoElement
fromString = String -> PseudoElement
go (String -> PseudoElement) -> ShowS -> String -> PseudoElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
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 = String -> PseudoElement
forall a. HasCallStack => String -> a
error (String
"The pseudo element \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
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 (NonEmpty Selector -> SelectorGroup)
-> ([Selector] -> NonEmpty Selector) -> [Selector] -> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item (NonEmpty Selector)] -> NonEmpty Selector
[Selector] -> NonEmpty Selector
forall l. IsList l => [Item l] -> l
fromList
    toList :: SelectorGroup -> [Item SelectorGroup]
toList (SelectorGroup NonEmpty Selector
ss) = NonEmpty Selector -> [Item (NonEmpty Selector)]
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)

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

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


instance ToCssSelector SelectorGroup where
    toCssSelector :: SelectorGroup -> Text
toCssSelector (SelectorGroup NonEmpty Selector
g) = Text -> [Text] -> Text
intercalate Text
" , " ((Selector -> Text) -> [Selector] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Selector -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector (NonEmpty Selector -> [Item (NonEmpty Selector)]
forall l. IsList l => l -> [Item l]
toList NonEmpty Selector
g))
    toSelectorGroup :: SelectorGroup -> SelectorGroup
toSelectorGroup = SelectorGroup -> SelectorGroup
forall a. a -> a
id
    specificity' :: SelectorGroup -> SelectorSpecificity
specificity' (SelectorGroup NonEmpty Selector
g) = (Selector -> SelectorSpecificity)
-> NonEmpty Selector -> SelectorSpecificity
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Selector -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' NonEmpty Selector
g
    toPattern :: SelectorGroup -> Pat
toPattern (SelectorGroup NonEmpty Selector
g) = Name -> [Pat] -> Pat
_conP 'SelectorGroup [NonEmpty Selector -> Pat
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 '(:|) [a -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern a
x, [Pat] -> Pat
ListP ((a -> Pat) -> [a] -> [Pat]
forall a b. (a -> b) -> [a] -> [b]
map a -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern [a]
xs)]
    normalize :: SelectorGroup -> SelectorGroup
normalize (SelectorGroup NonEmpty Selector
g) = NonEmpty Selector -> SelectorGroup
SelectorGroup (NonEmpty Selector -> NonEmpty Selector
forall a. Ord a => NonEmpty a -> NonEmpty a
Data.List.NonEmpty.sort (Selector -> Selector
forall a. ToCssSelector a => a -> a
normalize (Selector -> Selector) -> NonEmpty Selector -> NonEmpty Selector
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
'.' (Text -> Text) -> (Class -> Text) -> Class -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
encodeIdentifier (Text -> Text) -> (Class -> Text) -> Class -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Text
unClass
    toSelectorGroup :: Class -> SelectorGroup
toSelectorGroup = SelectorFilter -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (SelectorFilter -> SelectorGroup)
-> (Class -> SelectorFilter) -> Class -> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> SelectorFilter
SClass
    specificity' :: Class -> SelectorSpecificity
specificity' = SelectorSpecificity -> Class -> SelectorSpecificity
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
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AttributeName -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector AttributeName
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
    toCssSelector (Attrib AttributeName
name AttributeCombinator
op Text
val) = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AttributeName -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector AttributeName
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AttributeCombinator -> Text
attributeCombinatorText AttributeCombinator
op Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
encodeText Char
'"' Text
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
    toSelectorGroup :: Attrib -> SelectorGroup
toSelectorGroup = SelectorFilter -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (SelectorFilter -> SelectorGroup)
-> (Attrib -> SelectorFilter) -> Attrib -> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attrib -> SelectorFilter
SAttrib
    specificity' :: Attrib -> SelectorSpecificity
specificity' = SelectorSpecificity -> Attrib -> SelectorSpecificity
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 [AttributeName -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern AttributeName
name]
    toPattern (Attrib AttributeName
name AttributeCombinator
op Text
val) = Name -> [Pat] -> Pat
_conP 'Attrib [AttributeName -> Pat
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) = Namespace -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector Namespace
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
encodeIdentifier Text
e
    toSelectorGroup :: AttributeName -> SelectorGroup
toSelectorGroup = Attrib -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (Attrib -> SelectorGroup)
-> (AttributeName -> Attrib) -> AttributeName -> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeName -> Attrib
Exist
    specificity' :: AttributeName -> SelectorSpecificity
specificity' = AttributeName -> SelectorSpecificity
forall a. Monoid a => a
mempty
    toPattern :: AttributeName -> Pat
toPattern (AttributeName Namespace
n Text
a) = Name -> [Pat] -> Pat
_conP 'AttributeName [Namespace -> Pat
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
'#' (Text -> Text) -> (Hash -> Text) -> Hash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
encodeIdentifier (Text -> Text) -> (Hash -> Text) -> Hash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Text
unHash
    toSelectorGroup :: Hash -> SelectorGroup
toSelectorGroup = SelectorFilter -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (SelectorFilter -> SelectorGroup)
-> (Hash -> SelectorFilter) -> Hash -> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> SelectorFilter
SHash
    specificity' :: Hash -> SelectorSpecificity
specificity' = SelectorSpecificity -> Hash -> SelectorSpecificity
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 = TypeSelector -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (TypeSelector -> SelectorGroup)
-> (Namespace -> TypeSelector) -> Namespace -> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Namespace -> ElementName -> TypeSelector)
-> ElementName -> Namespace -> TypeSelector
forall a b c. (a -> b -> c) -> b -> a -> c
flip Namespace -> ElementName -> TypeSelector
TypeSelector ElementName
EAny
    specificity' :: Namespace -> SelectorSpecificity
specificity' = Namespace -> SelectorSpecificity
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) = TypeSelector -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector TypeSelector
s
    toCssSelector (Filter SelectorSequence
s SelectorFilter
f) = SelectorSequence -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector SelectorSequence
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SelectorFilter -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector SelectorFilter
f
    toSelectorGroup :: SelectorSequence -> SelectorGroup
toSelectorGroup = PseudoSelectorSequence -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (PseudoSelectorSequence -> SelectorGroup)
-> (SelectorSequence -> PseudoSelectorSequence)
-> SelectorSequence
-> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorSequence -> PseudoSelectorSequence
Sequence
    specificity' :: SelectorSequence -> SelectorSpecificity
specificity' (SimpleSelector TypeSelector
s) = TypeSelector -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' TypeSelector
s
    specificity' (Filter SelectorSequence
s SelectorFilter
f) = SelectorSequence -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' SelectorSequence
s SelectorSpecificity -> SelectorSpecificity -> SelectorSpecificity
forall a. Semigroup a => a -> a -> a
<> SelectorFilter -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' SelectorFilter
f
    toPattern :: SelectorSequence -> Pat
toPattern (SimpleSelector TypeSelector
s) = Name -> [Pat] -> Pat
_conP 'SimpleSelector [TypeSelector -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern TypeSelector
s]
    toPattern (Filter SelectorSequence
s SelectorFilter
f) = Name -> [Pat] -> Pat
_conP 'Filter [SelectorSequence -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern SelectorSequence
s, SelectorFilter -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern SelectorFilter
f]
    normalize :: SelectorSequence -> SelectorSequence
normalize = (SelectorSequence -> [SelectorFilter] -> SelectorSequence)
-> [SelectorFilter] -> SelectorSequence -> SelectorSequence
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 ([SelectorFilter] -> SelectorSequence)
-> ([SelectorFilter] -> [SelectorFilter])
-> [SelectorFilter]
-> SelectorSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SelectorFilter -> SelectorFilter
forall a. ToCssSelector a => a -> a
normalize SelectorFilter
fSelectorFilter -> [SelectorFilter] -> [SelectorFilter]
forall a. a -> [a] -> [a]
:)
              go (SimpleSelector TypeSelector
s) = SelectorSequence -> [SelectorFilter] -> SelectorSequence
addFilters (TypeSelector -> SelectorSequence
SimpleSelector (TypeSelector -> TypeSelector
forall a. ToCssSelector a => a -> a
normalize TypeSelector
s)) ([SelectorFilter] -> SelectorSequence)
-> ([SelectorFilter] -> [SelectorFilter])
-> [SelectorFilter]
-> SelectorSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SelectorFilter] -> [SelectorFilter]
forall a. Ord a => [a] -> [a]
sort

instance ToCssSelector TypeSelector where
    toCssSelector :: TypeSelector -> Text
toCssSelector (TypeSelector Namespace
NAny ElementName
e) = ElementName -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector ElementName
e
    toCssSelector (TypeSelector Namespace
n ElementName
e) = Namespace -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector Namespace
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ElementName -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector ElementName
e
    toSelectorGroup :: TypeSelector -> SelectorGroup
toSelectorGroup = SelectorSequence -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (SelectorSequence -> SelectorGroup)
-> (TypeSelector -> SelectorSequence)
-> TypeSelector
-> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeSelector -> SelectorSequence
SimpleSelector
    specificity' :: TypeSelector -> SelectorSpecificity
specificity' (TypeSelector Namespace
_ ElementName
e) = ElementName -> SelectorSpecificity
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 [Namespace -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern Namespace
n, ElementName -> Pat
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 = TypeSelector -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (TypeSelector -> SelectorGroup)
-> (ElementName -> TypeSelector) -> ElementName -> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Namespace -> ElementName -> TypeSelector
TypeSelector Namespace
NAny
    specificity' :: ElementName -> SelectorSpecificity
specificity' ElementName
EAny = SelectorSpecificity
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) = Hash -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector Hash
h
    toCssSelector (SClass Class
c) = Class -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector Class
c
    toCssSelector (SAttrib Attrib
a) = Attrib -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector Attrib
a
    toCssSelector (SPseudo PseudoClass
p) = PseudoClass -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector PseudoClass
p
    toCssSelector (SNot Negation
n) = Negation -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector Negation
n
    toSelectorGroup :: SelectorFilter -> SelectorGroup
toSelectorGroup = SelectorSequence -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (SelectorSequence -> SelectorGroup)
-> (SelectorFilter -> SelectorSequence)
-> SelectorFilter
-> SelectorGroup
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) = Hash -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Hash
h
    specificity' (SClass Class
c) = Class -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Class
c
    specificity' (SAttrib Attrib
a) = Attrib -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Attrib
a
    specificity' (SPseudo PseudoClass
p) = PseudoClass -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' PseudoClass
p
    specificity' (SNot Negation
n) = Negation -> SelectorSpecificity
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 [Hash -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern Hash
h]
    toPattern (SClass Class
c) = Name -> [Pat] -> Pat
_conP 'SClass [Class -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern Class
c]
    toPattern (SAttrib Attrib
a) = Name -> [Pat] -> Pat
_conP 'SAttrib [Attrib -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern Attrib
a]
    toPattern (SPseudo PseudoClass
p) = Name -> [Pat] -> Pat
_conP 'SPseudo [PseudoClass -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern PseudoClass
p]
    toPattern (SNot Negation
n) = Name -> [Pat] -> Pat
_conP 'SNot [Negation -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern Negation
n]

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

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

instance ToCssSelector PseudoClass where
    toCssSelector :: PseudoClass -> Text
toCssSelector = Char -> Text -> Text
cons Char
':' (Text -> Text) -> (PseudoClass -> Text) -> PseudoClass -> Text
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(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            go PseudoClass
FirstChild = Text
"first-child"
            go (NthChild Nth
nth) = Text
"nth-child(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Nth -> Text
nthToText Nth
nth Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            go PseudoClass
LastChild = Text
"last-child"
            go (NthLastChild Nth
nth) = Text
"nth-last-child(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Nth -> Text
nthToText Nth
nth Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            go PseudoClass
LastOfType = Text
"last-of-type"
            go (NthLastOfType Nth
nth) = Text
"nth-last-of-type(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Nth -> Text
nthToText Nth
nth Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            go PseudoClass
FirstOfType = Text
"first-of-type"
            go (NthOfType Nth
nth) = Text
"nth-of-type(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Nth -> Text
nthToText Nth
nth Text -> Text -> Text
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' = SelectorSpecificity -> PseudoClass -> SelectorSpecificity
forall a b. a -> b -> a
const (Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity Int
0 Int
1 Int
0)
    toSelectorGroup :: PseudoClass -> SelectorGroup
toSelectorGroup = SelectorFilter -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (SelectorFilter -> SelectorGroup)
-> (PseudoClass -> SelectorFilter) -> PseudoClass -> SelectorGroup
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("Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Negation -> Text
go Negation
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      where go :: Negation -> Text
go (NTypeSelector TypeSelector
t) = TypeSelector -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector TypeSelector
t
            go (NHash Hash
h) = Hash -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector Hash
h
            go (NClass Class
c) = Class -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector Class
c
            go (NAttrib Attrib
a) = Attrib -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector Attrib
a
            go (NPseudo PseudoClass
p) = PseudoClass -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector PseudoClass
p
            go (NPseudoElement PseudoElement
p) = PseudoElement -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector PseudoElement
p
    toSelectorGroup :: Negation -> SelectorGroup
toSelectorGroup = SelectorFilter -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (SelectorFilter -> SelectorGroup)
-> (Negation -> SelectorFilter) -> Negation -> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Negation -> SelectorFilter
SNot
    specificity' :: Negation -> SelectorSpecificity
specificity' (NTypeSelector TypeSelector
t) = TypeSelector -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' TypeSelector
t
    specificity' (NHash Hash
h) = Hash -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Hash
h
    specificity' (NClass Class
c) = Class -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Class
c
    specificity' (NAttrib Attrib
a) = Attrib -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' Attrib
a
    specificity' (NPseudo PseudoClass
p) = PseudoClass -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' PseudoClass
p
    specificity' (NPseudoElement PseudoElement
p) = PseudoElement -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' PseudoElement
p
    toPattern :: Negation -> Pat
toPattern (NTypeSelector TypeSelector
t) = Name -> [Pat] -> Pat
_conP 'NTypeSelector [TypeSelector -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern TypeSelector
t]
    toPattern (NHash Hash
h) = Name -> [Pat] -> Pat
_conP 'NHash [Hash -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern Hash
h]
    toPattern (NClass Class
c) = Name -> [Pat] -> Pat
_conP 'NClass [Class -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern Class
c]
    toPattern (NAttrib Attrib
a) = Name -> [Pat] -> Pat
_conP 'NAttrib [Attrib -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern Attrib
a]
    toPattern (NPseudo PseudoClass
p) = Name -> [Pat] -> Pat
_conP 'NPseudo [PseudoClass -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern PseudoClass
p]
    toPattern (NPseudoElement PseudoElement
p) = Name -> [Pat] -> Pat
_conP 'NPseudoElement [PseudoElement -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern PseudoElement
p]

instance ToCssSelector PseudoElement where
    toCssSelector :: PseudoElement -> Text
toCssSelector = String -> Text
pack (String -> Text)
-> (PseudoElement -> String) -> PseudoElement -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (PseudoElement -> String) -> PseudoElement -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (PseudoElement -> String) -> PseudoElement -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PseudoElement -> String
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' = SelectorSpecificity -> PseudoElement -> SelectorSpecificity
forall a b. a -> b -> a
const (Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity Int
0 Int
0 Int
1)
    toSelectorGroup :: PseudoElement -> SelectorGroup
toSelectorGroup = PseudoSelectorSequence -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (PseudoSelectorSequence -> SelectorGroup)
-> (PseudoElement -> PseudoSelectorSequence)
-> PseudoElement
-> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SelectorSequence
forall a. Default a => a
def SelectorSequence -> PseudoElement -> PseudoSelectorSequence
:.::)
    toPattern :: PseudoElement -> Pat
toPattern = Name -> Pat
_constantP (Name -> Pat) -> (PseudoElement -> Name) -> PseudoElement -> Pat
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
(==) = (Int -> Int -> Bool)
-> (SelectorSpecificity -> Int)
-> SelectorSpecificity
-> SelectorSpecificity
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) SelectorSpecificity -> Int
specificityValue

instance Ord SelectorSpecificity where
    compare :: SelectorSpecificity -> SelectorSpecificity -> Ordering
compare = (SelectorSpecificity -> Int)
-> SelectorSpecificity -> SelectorSpecificity -> Ordering
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 (Selector -> NonEmpty Selector
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Selector
forall a. Default a => a
def)

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

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

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

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

instance Default SelectorSpecificity where
    def :: SelectorSpecificity
def = SelectorSpecificity
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 (Word8 -> Put) -> (a -> Word8) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (a -> Int) -> a -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum

_getEnum :: Enum a => Get a
_getEnum :: forall a. Enum a => Get a
_getEnum = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (Word8 -> Int) -> Word8 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Get Word8 -> Get a
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) = Int -> Put
forall t. Binary t => t -> Put
put Int
n Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
b
  get :: Get Nth
get = Int -> Int -> Nth
Nth (Int -> Int -> Nth) -> Get Int -> Get (Int -> Nth)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall t. Binary t => Get t
get Get (Int -> Nth) -> Get Int -> Get Nth
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get

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

instance Binary Selector where
  put :: Selector -> Put
put (Selector PseudoSelectorSequence
c) = Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PseudoSelectorSequence -> Put
forall t. Binary t => t -> Put
put PseudoSelectorSequence
c
  put (Combined PseudoSelectorSequence
c SelectorCombinator
sc Selector
cs) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PseudoSelectorSequence -> Put
forall t. Binary t => t -> Put
put PseudoSelectorSequence
c Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SelectorCombinator -> Put
forall t. Binary t => t -> Put
put SelectorCombinator
sc Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Selector -> Put
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 (PseudoSelectorSequence -> Selector)
-> Get PseudoSelectorSequence -> Get Selector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PseudoSelectorSequence
forall t. Binary t => Get t
get
      Word8
1 -> PseudoSelectorSequence
-> SelectorCombinator -> Selector -> Selector
Combined (PseudoSelectorSequence
 -> SelectorCombinator -> Selector -> Selector)
-> Get PseudoSelectorSequence
-> Get (SelectorCombinator -> Selector -> Selector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PseudoSelectorSequence
forall t. Binary t => Get t
get Get (SelectorCombinator -> Selector -> Selector)
-> Get SelectorCombinator -> Get (Selector -> Selector)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get SelectorCombinator
forall t. Binary t => Get t
get Get (Selector -> Selector) -> Get Selector -> Get Selector
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Selector
forall t. Binary t => Get t
get
      Word8
_ -> String -> Get Selector
forall a. String -> Get a
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 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SelectorSequence -> Put
forall t. Binary t => t -> Put
put SelectorSequence
ss
  put (SelectorSequence
ss :.:: PseudoElement
pe) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SelectorSequence -> Put
forall t. Binary t => t -> Put
put SelectorSequence
ss Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PseudoElement -> Put
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 (SelectorSequence -> PseudoSelectorSequence)
-> Get SelectorSequence -> Get PseudoSelectorSequence
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SelectorSequence
forall t. Binary t => Get t
get
      Word8
1 -> SelectorSequence -> PseudoElement -> PseudoSelectorSequence
(:.::) (SelectorSequence -> PseudoElement -> PseudoSelectorSequence)
-> Get SelectorSequence
-> Get (PseudoElement -> PseudoSelectorSequence)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SelectorSequence
forall t. Binary t => Get t
get Get (PseudoElement -> PseudoSelectorSequence)
-> Get PseudoElement -> Get PseudoSelectorSequence
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get PseudoElement
forall t. Binary t => Get t
get
      Word8
_ -> String -> Get PseudoSelectorSequence
forall a. String -> Get a
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 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Put
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 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Nth -> Put
forall t. Binary t => t -> Put
put Nth
nth
  put (NthLastChild Nth
nth) = Word8 -> Put
putWord8 Word8
15 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Nth -> Put
forall t. Binary t => t -> Put
put Nth
nth
  put (NthLastOfType Nth
nth) = Word8 -> Put
putWord8 Word8
16 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Nth -> Put
forall t. Binary t => t -> Put
put Nth
nth
  put (NthOfType Nth
nth) = Word8 -> Put
putWord8 Word8
17 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Nth -> Put
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 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Active
      Word8
1 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Checked
      Word8
2 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Default
      Word8
3 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Disabled
      Word8
4 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Empty
      Word8
5 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Enabled
      Word8
6 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Focus
      Word8
7 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Fullscreen
      Word8
8 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Hover
      Word8
9 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Indeterminate
      Word8
10 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
InRange
      Word8
11 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Invalid
      Word8
12 -> Text -> PseudoClass
Lang (Text -> PseudoClass) -> Get Text -> Get PseudoClass
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall t. Binary t => Get t
get
      Word8
13 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Link
      Word8
14 -> Nth -> PseudoClass
NthChild (Nth -> PseudoClass) -> Get Nth -> Get PseudoClass
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Nth
forall t. Binary t => Get t
get
      Word8
15 -> Nth -> PseudoClass
NthLastChild (Nth -> PseudoClass) -> Get Nth -> Get PseudoClass
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Nth
forall t. Binary t => Get t
get
      Word8
16 -> Nth -> PseudoClass
NthLastOfType (Nth -> PseudoClass) -> Get Nth -> Get PseudoClass
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Nth
forall t. Binary t => Get t
get
      Word8
17 -> Nth -> PseudoClass
NthOfType (Nth -> PseudoClass) -> Get Nth -> Get PseudoClass
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Nth
forall t. Binary t => Get t
get
      Word8
18 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
OnlyOfType
      Word8
19 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
OnlyChild
      Word8
20 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Optional
      Word8
21 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
OutOfRange
      Word8
22 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
ReadOnly
      Word8
23 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
ReadWrite
      Word8
24 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Required
      Word8
25 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Root
      Word8
26 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Target
      Word8
27 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Valid
      Word8
28 -> PseudoClass -> Get PseudoClass
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PseudoClass
Visited
      Word8
_ -> String -> Get PseudoClass
forall a. String -> Get a
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 = PseudoElement -> Put
forall a. Enum a => a -> Put
_putEnum
  get :: Get PseudoElement
get = Get PseudoElement
forall a. Enum a => Get a
_getEnum

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

instance Binary SelectorSequence where
  put :: SelectorSequence -> Put
put (SimpleSelector TypeSelector
ts) = Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeSelector -> Put
forall t. Binary t => t -> Put
put TypeSelector
ts
  put (Filter SelectorSequence
ss SelectorFilter
sf) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SelectorSequence -> Put
forall t. Binary t => t -> Put
put SelectorSequence
ss Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SelectorFilter -> Put
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 (TypeSelector -> SelectorSequence)
-> Get TypeSelector -> Get SelectorSequence
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeSelector
forall t. Binary t => Get t
get
      Word8
1 -> SelectorSequence -> SelectorFilter -> SelectorSequence
Filter (SelectorSequence -> SelectorFilter -> SelectorSequence)
-> Get SelectorSequence -> Get (SelectorFilter -> SelectorSequence)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SelectorSequence
forall t. Binary t => Get t
get Get (SelectorFilter -> SelectorSequence)
-> Get SelectorFilter -> Get SelectorSequence
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get SelectorFilter
forall t. Binary t => Get t
get
      Word8
_ -> String -> Get SelectorSequence
forall a. String -> Get a
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 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Hash -> Put
forall t. Binary t => t -> Put
put Hash
h
  put (SClass Class
c) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Class -> Put
forall t. Binary t => t -> Put
put Class
c
  put (SAttrib Attrib
a) = Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Attrib -> Put
forall t. Binary t => t -> Put
put Attrib
a
  put (SPseudo PseudoClass
p) = Word8 -> Put
putWord8 Word8
3 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PseudoClass -> Put
forall t. Binary t => t -> Put
put PseudoClass
p
  put (SNot Negation
n) = Word8 -> Put
putWord8 Word8
4 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Negation -> Put
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 (Hash -> SelectorFilter) -> Get Hash -> Get SelectorFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Hash
forall t. Binary t => Get t
get
      Word8
1 -> Class -> SelectorFilter
SClass (Class -> SelectorFilter) -> Get Class -> Get SelectorFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Class
forall t. Binary t => Get t
get
      Word8
2 -> Attrib -> SelectorFilter
SAttrib (Attrib -> SelectorFilter) -> Get Attrib -> Get SelectorFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Attrib
forall t. Binary t => Get t
get
      Word8
3 -> PseudoClass -> SelectorFilter
SPseudo (PseudoClass -> SelectorFilter)
-> Get PseudoClass -> Get SelectorFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PseudoClass
forall t. Binary t => Get t
get
      Word8
4 -> Negation -> SelectorFilter
SNot (Negation -> SelectorFilter) -> Get Negation -> Get SelectorFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Negation
forall t. Binary t => Get t
get
      Word8
_ -> String -> Get SelectorFilter
forall a. String -> Get a
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 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeSelector -> Put
forall t. Binary t => t -> Put
put TypeSelector
t
  put (NHash Hash
h) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Hash -> Put
forall t. Binary t => t -> Put
put Hash
h
  put (NClass Class
c) = Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Class -> Put
forall t. Binary t => t -> Put
put Class
c
  put (NAttrib Attrib
a) = Word8 -> Put
putWord8 Word8
3 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Attrib -> Put
forall t. Binary t => t -> Put
put Attrib
a
  put (NPseudo PseudoClass
p) = Word8 -> Put
putWord8 Word8
4 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PseudoClass -> Put
forall t. Binary t => t -> Put
put PseudoClass
p
  put (NPseudoElement PseudoElement
p) = Word8 -> Put
putWord8 Word8
5 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PseudoElement -> Put
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 (TypeSelector -> Negation) -> Get TypeSelector -> Get Negation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeSelector
forall t. Binary t => Get t
get
      Word8
1 -> Hash -> Negation
NHash (Hash -> Negation) -> Get Hash -> Get Negation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Hash
forall t. Binary t => Get t
get
      Word8
2 -> Class -> Negation
NClass (Class -> Negation) -> Get Class -> Get Negation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Class
forall t. Binary t => Get t
get
      Word8
3 -> Attrib -> Negation
NAttrib (Attrib -> Negation) -> Get Attrib -> Get Negation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Attrib
forall t. Binary t => Get t
get
      Word8
4 -> PseudoClass -> Negation
NPseudo (PseudoClass -> Negation) -> Get PseudoClass -> Get Negation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PseudoClass
forall t. Binary t => Get t
get
      Word8
5 -> PseudoElement -> Negation
NPseudoElement (PseudoElement -> Negation) -> Get PseudoElement -> Get Negation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PseudoElement
forall t. Binary t => Get t
get
      Word8
_ -> String -> Get Negation
forall a. String -> Get a
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 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AttributeName -> Put
forall t. Binary t => t -> Put
put AttributeName
e
  put (Attrib AttributeName
an AttributeCombinator
ac Text
av) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AttributeName -> Put
forall t. Binary t => t -> Put
put AttributeName
an Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AttributeCombinator -> Put
forall t. Binary t => t -> Put
put AttributeCombinator
ac Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Put
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 (AttributeName -> Attrib) -> Get AttributeName -> Get Attrib
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get AttributeName
forall t. Binary t => Get t
get
      Word8
1 -> AttributeName -> AttributeCombinator -> Text -> Attrib
Attrib (AttributeName -> AttributeCombinator -> Text -> Attrib)
-> Get AttributeName -> Get (AttributeCombinator -> Text -> Attrib)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get AttributeName
forall t. Binary t => Get t
get Get (AttributeCombinator -> Text -> Attrib)
-> Get AttributeCombinator -> Get (Text -> Attrib)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get AttributeCombinator
forall t. Binary t => Get t
get Get (Text -> Attrib) -> Get Text -> Get Attrib
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Text
forall t. Binary t => Get t
get
      Word8
_ -> String -> Get Attrib
forall a. String -> Get a
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 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Put
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 -> Namespace -> Get Namespace
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Namespace
NAny
      Word8
1 -> Text -> Namespace
Namespace (Text -> Namespace) -> Get Text -> Get Namespace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall t. Binary t => Get t
get
      Word8
_ -> String -> Get Namespace
forall a. String -> Get a
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 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Put
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 -> ElementName -> Get ElementName
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ElementName
EAny
      Word8
1 -> Text -> ElementName
ElementName (Text -> ElementName) -> Get Text -> Get ElementName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall t. Binary t => Get t
get
      Word8
_ -> String -> Get ElementName
forall a. String -> Get a
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) = Namespace -> Put
forall t. Binary t => t -> Put
put Namespace
ns Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ElementName -> Put
forall t. Binary t => t -> Put
put ElementName
en
  get :: Get TypeSelector
get = Namespace -> ElementName -> TypeSelector
TypeSelector (Namespace -> ElementName -> TypeSelector)
-> Get Namespace -> Get (ElementName -> TypeSelector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Namespace
forall t. Binary t => Get t
get Get (ElementName -> TypeSelector)
-> Get ElementName -> Get TypeSelector
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ElementName
forall t. Binary t => Get t
get

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

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

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

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

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

instance Lift SelectorGroup where
    lift :: forall (m :: * -> *). Quote m => SelectorGroup -> m Exp
lift (SelectorGroup NonEmpty Selector
sg) = Name -> [m Exp] -> m Exp
forall (m :: * -> *). Quote m => Name -> [m Exp] -> m Exp
_apply 'SelectorGroup [NonEmpty Selector -> m Exp
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) = Name -> [m Exp] -> m Exp
forall (m :: * -> *). Quote m => Name -> [m Exp] -> m Exp
_apply '(:|) [t -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => t -> m Exp
lift t
a, [t] -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). 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 = m Exp -> Code m SelectorGroup
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m SelectorGroup)
-> (SelectorGroup -> m Exp)
-> SelectorGroup
-> Code m SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorGroup -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => SelectorGroup -> 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 = m Exp -> Code m Selector
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m Selector)
-> (Selector -> m Exp) -> Selector -> Code m Selector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Selector -> 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 = m Exp -> Code m SelectorCombinator
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m SelectorCombinator)
-> (SelectorCombinator -> m Exp)
-> SelectorCombinator
-> Code m SelectorCombinator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorCombinator -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => SelectorCombinator -> 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 = m Exp -> Code m SelectorSequence
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m SelectorSequence)
-> (SelectorSequence -> m Exp)
-> SelectorSequence
-> Code m SelectorSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorSequence -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => SelectorSequence -> 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 = m Exp -> Code m SelectorFilter
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m SelectorFilter)
-> (SelectorFilter -> m Exp)
-> SelectorFilter
-> Code m SelectorFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorFilter -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => SelectorFilter -> 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 = m Exp -> Code m Attrib
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m Attrib)
-> (Attrib -> m Exp) -> Attrib -> Code m Attrib
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attrib -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Attrib -> 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 = m Exp -> Code m PseudoSelectorSequence
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m PseudoSelectorSequence)
-> (PseudoSelectorSequence -> m Exp)
-> PseudoSelectorSequence
-> Code m PseudoSelectorSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PseudoSelectorSequence -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => PseudoSelectorSequence -> 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 = m Exp -> Code m PseudoClass
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m PseudoClass)
-> (PseudoClass -> m Exp) -> PseudoClass -> Code m PseudoClass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PseudoClass -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => PseudoClass -> 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 = m Exp -> Code m PseudoElement
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m PseudoElement)
-> (PseudoElement -> m Exp)
-> PseudoElement
-> Code m PseudoElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PseudoElement -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => PseudoElement -> 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 = m Exp -> Code m Nth
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m Nth) -> (Nth -> m Exp) -> Nth -> Code m Nth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nth -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Nth -> 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 = m Exp -> Code m Negation
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m Negation)
-> (Negation -> m Exp) -> Negation -> Code m Negation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Negation -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Negation -> 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 (Text -> Markup) -> (a -> Text) -> a -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector

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

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

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

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

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

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

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

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

instance ToMarkup Negation where
    toMarkup :: Negation -> Markup
toMarkup = Negation -> Markup
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 = Text -> Javascript
forall a. ToJavascript a => a -> Javascript
toJavascript (Text -> Javascript) -> (a -> Text) -> a -> Javascript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector
#endif

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


-- Arbitrary instances
_arbitraryIdent :: Gen Text
_arbitraryIdent :: Gen Text
_arbitraryIdent = String -> Text
pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 Gen Char
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 = ([Text] -> [Text] -> [Text])
-> (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall a b c.
(a -> b -> c) -> (Text -> a) -> (Text -> b) -> Text -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Text -> Text -> Text) -> [Text] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>)) Text -> [Text]
inits (Text -> [Text]
tails (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
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 Int -> Int -> Bool
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 (Text -> Hash) -> Gen Text -> Gen 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 (Text -> Hash) -> [Text] -> [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 (Text -> Class) -> Gen Text -> Gen 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 (Text -> Class) -> [Text] -> [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 (Int -> Int -> Nth) -> (Int -> Int) -> Int -> Int -> Nth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
abs (Int -> Int -> Nth) -> Gen Int -> Gen (Int -> Nth)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. Arbitrary a => Gen a
arbitrary Gen (Int -> Nth) -> Gen Int -> Gen Nth
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: Nth -> [Nth]
shrink Nth
nth
      | Nth
nth Nth -> Nth -> Bool
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 = [(Int, Gen Namespace)] -> Gen Namespace
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
3, Namespace -> Gen Namespace
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Namespace
NAny), (Int
1, Text -> Namespace
Namespace (Text -> Namespace) -> Gen Text -> Gen 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 (Text -> Namespace) -> [Text] -> [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 = [(Int, Gen ElementName)] -> Gen ElementName
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
1, ElementName -> Gen ElementName
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ElementName
EAny), (Int
3, Text -> ElementName
ElementName (Text -> ElementName) -> Gen Text -> Gen 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 (Text -> ElementName) -> [Text] -> [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 (Namespace -> ElementName -> TypeSelector)
-> Gen Namespace -> Gen (ElementName -> TypeSelector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Namespace
forall a. Arbitrary a => Gen a
arbitrary Gen (ElementName -> TypeSelector)
-> Gen ElementName -> Gen TypeSelector
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ElementName
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: TypeSelector -> [TypeSelector]
shrink (TypeSelector Namespace
x ElementName
y) = (Namespace -> ElementName -> TypeSelector
TypeSelector Namespace
x (ElementName -> TypeSelector) -> [ElementName] -> [TypeSelector]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElementName -> [ElementName]
forall a. Arbitrary a => a -> [a]
shrink ElementName
y) [TypeSelector] -> [TypeSelector] -> [TypeSelector]
forall a. [a] -> [a] -> [a]
++ ((Namespace -> ElementName -> TypeSelector
`TypeSelector` ElementName
y) (Namespace -> TypeSelector) -> [Namespace] -> [TypeSelector]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace -> [Namespace]
forall a. Arbitrary a => a -> [a]
shrink Namespace
x)

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

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

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

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

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

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

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

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

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

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

instance Arbitrary PseudoClass where
    arbitrary :: Gen PseudoClass
arbitrary = [Gen PseudoClass] -> Gen PseudoClass
forall a. [Gen a] -> Gen a
oneof ((Text -> PseudoClass
Lang (Text -> PseudoClass) -> Gen Text -> Gen PseudoClass
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Gen Text
forall a. [a] -> Gen a
elements [Text]
_arbitraryLanguages) Gen PseudoClass -> [Gen PseudoClass] -> [Gen PseudoClass]
forall a. a -> [a] -> [a]
: (PseudoClass -> Gen PseudoClass)
-> [PseudoClass] -> [Gen PseudoClass]
forall a b. (a -> b) -> [a] -> [b]
map PseudoClass -> Gen PseudoClass
forall a. a -> Gen a
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
      ] [Gen PseudoClass] -> [Gen PseudoClass] -> [Gen PseudoClass]
forall a. [a] -> [a] -> [a]
++ ((Nth -> PseudoClass) -> Gen PseudoClass)
-> [Nth -> PseudoClass] -> [Gen PseudoClass]
forall a b. (a -> b) -> [a] -> [b]
map ((Nth -> PseudoClass) -> Gen Nth -> Gen PseudoClass
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Nth
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 = Gen PseudoElement
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum