{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, 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(..)
    -- * Selectors and combinators
    , Selector(..)
    , SelectorCombinator(..), SelectorGroup(..)
    , SelectorSequence(..)
    , combinatorText, combine
    , (.>), (.+), (.~)
    -- * Filters
    , SelectorFilter(..), filters, filters', addFilters, (.:)
    -- * Namespaces
    , Namespace(..), pattern NEmpty
    -- * Type selectors
    , ElementName(..), TypeSelector(..), pattern Universal, (.|)
    -- * Attributes
    , Attrib(..), AttributeCombinator(..), AttributeName(..), AttributeValue
    , (.=), (.~=), (.|=), (.^=), (.$=), (.*=)
    , attrib, attributeCombinatorText
    -- * Classes
    , Class(..), (...)
    -- * Hashes
    , Hash(..), (.#)
    -- * 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 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.Data(Data)
import Data.Default(Default(def))
import Data.Function(on)
import Data.Hashable(Hashable)
import Data.List(sort, unfoldr)
import Data.List.NonEmpty(NonEmpty((:|)))
import qualified Data.List.NonEmpty
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, tails, unpack)

import GHC.Exts(IsList(Item, fromList, toList))
import GHC.Generics(Generic)

import Language.Haskell.TH.Lib(appE, conE)
#if MIN_VERSION_template_haskell(2,17,0)
import Language.Haskell.TH.Syntax(Lift(lift, liftTyped), Exp(AppE, ConE, LitE), Lit(StringL), Name, Pat(ConP, ListP, ViewP), Q, unsafeCodeCoerce)
#elif MIN_VERSION_template_haskell(2,16,0)
import Language.Haskell.TH.Syntax(Lift(lift, liftTyped), Exp(AppE, ConE, LitE), Lit(StringL), Name, Pat(ConP, ListP, ViewP), Q, unsafeTExpCoerce)
#else
import Language.Haskell.TH.Syntax(Lift(lift), Exp(AppE, ConE, LitE), Lit(StringL), Name, Pat(ConP, ListP, ViewP), Q)
#endif

import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary, shrink), arbitraryBoundedEnum)
import Test.QuickCheck.Gen(Gen, 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
DataType
Constr
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 -> DataType
SelectorSpecificity -> Constr
(forall b. Data b => b -> b)
-> SelectorSpecificity -> SelectorSpecificity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorSpecificity
-> c SelectorSpecificity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSelectorSpecificity :: Constr
$tSelectorSpecificity :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
gmapMp :: (forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
gmapM :: (forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectorSpecificity -> m SelectorSpecificity
gmapQi :: Int -> (forall d. Data d => d -> u) -> SelectorSpecificity -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectorSpecificity -> u
gmapQ :: (forall d. Data d => d -> u) -> SelectorSpecificity -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SelectorSpecificity -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorSpecificity -> r
gmapT :: (forall b. Data b => b -> b)
-> SelectorSpecificity -> SelectorSpecificity
$cgmapT :: (forall b. Data b => b -> b)
-> SelectorSpecificity -> SelectorSpecificity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSpecificity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorSpecificity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SelectorSpecificity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorSpecificity)
dataTypeOf :: SelectorSpecificity -> DataType
$cdataTypeOf :: SelectorSpecificity -> DataType
toConstr :: SelectorSpecificity -> Constr
$ctoConstr :: SelectorSpecificity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSpecificity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorSpecificity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorSpecificity
-> c SelectorSpecificity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectorSpecificity
-> c SelectorSpecificity
$cp1Data :: Typeable 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
$cto :: forall x. Rep SelectorSpecificity x -> SelectorSpecificity
$cfrom :: forall x. SelectorSpecificity -> Rep SelectorSpecificity x
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
showList :: [SelectorSpecificity] -> ShowS
$cshowList :: [SelectorSpecificity] -> ShowS
show :: SelectorSpecificity -> String
$cshow :: SelectorSpecificity -> String
showsPrec :: Int -> SelectorSpecificity -> ShowS
$cshowsPrec :: Int -> SelectorSpecificity -> ShowS
Show)

instance Hashable SelectorSpecificity

-- | Calculate the specificity value of the 'SelectorSpecificity'
specificityValue :: SelectorSpecificity -- ^ The 'SelectorSpecificity' to calculate the specificity value from.
    -> Int  -- ^ The specificity level of the 'SelectorSpecificity'. If the value is higher, the rules in the css selector take precedence.
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 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 :: 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 :: 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 :: 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 :: 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
DataType
Constr
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 -> DataType
SelectorGroup -> Constr
(forall b. Data b => b -> b) -> SelectorGroup -> SelectorGroup
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorGroup -> c SelectorGroup
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSelectorGroup :: Constr
$tSelectorGroup :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
gmapMp :: (forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
gmapM :: (forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SelectorGroup -> m SelectorGroup
gmapQi :: Int -> (forall d. Data d => d -> u) -> SelectorGroup -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SelectorGroup -> u
gmapQ :: (forall d. Data d => d -> u) -> SelectorGroup -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectorGroup -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectorGroup -> r
gmapT :: (forall b. Data b => b -> b) -> SelectorGroup -> SelectorGroup
$cgmapT :: (forall b. Data b => b -> b) -> SelectorGroup -> SelectorGroup
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorGroup)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectorGroup)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SelectorGroup)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectorGroup)
dataTypeOf :: SelectorGroup -> DataType
$cdataTypeOf :: SelectorGroup -> DataType
toConstr :: SelectorGroup -> Constr
$ctoConstr :: SelectorGroup -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorGroup
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectorGroup
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorGroup -> c SelectorGroup
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectorGroup -> c SelectorGroup
$cp1Data :: Typeable SelectorGroup
Data, SelectorGroup -> SelectorGroup -> Bool
(SelectorGroup -> SelectorGroup -> Bool)
-> (SelectorGroup -> SelectorGroup -> Bool) -> Eq SelectorGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectorGroup -> SelectorGroup -> Bool
$c/= :: SelectorGroup -> SelectorGroup -> Bool
== :: SelectorGroup -> SelectorGroup -> Bool
$c== :: SelectorGroup -> SelectorGroup -> Bool
Eq, (forall x. 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
$cto :: forall x. Rep SelectorGroup x -> SelectorGroup
$cfrom :: forall x. SelectorGroup -> Rep SelectorGroup x
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
min :: SelectorGroup -> SelectorGroup -> SelectorGroup
$cmin :: SelectorGroup -> SelectorGroup -> SelectorGroup
max :: SelectorGroup -> SelectorGroup -> SelectorGroup
$cmax :: SelectorGroup -> SelectorGroup -> SelectorGroup
>= :: SelectorGroup -> SelectorGroup -> Bool
$c>= :: SelectorGroup -> SelectorGroup -> Bool
> :: SelectorGroup -> SelectorGroup -> Bool
$c> :: SelectorGroup -> SelectorGroup -> Bool
<= :: SelectorGroup -> SelectorGroup -> Bool
$c<= :: SelectorGroup -> SelectorGroup -> Bool
< :: SelectorGroup -> SelectorGroup -> Bool
$c< :: SelectorGroup -> SelectorGroup -> Bool
compare :: SelectorGroup -> SelectorGroup -> Ordering
$ccompare :: SelectorGroup -> SelectorGroup -> Ordering
$cp1Ord :: Eq 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
showList :: [SelectorGroup] -> ShowS
$cshowList :: [SelectorGroup] -> ShowS
show :: SelectorGroup -> String
$cshow :: SelectorGroup -> String
showsPrec :: Int -> SelectorGroup -> ShowS
$cshowsPrec :: Int -> SelectorGroup -> ShowS
Show)

instance Hashable SelectorGroup

-- | The type of a single selector. This is a sequence of 'SelectorSequence's that
-- are combined with a 'SelectorCombinator'.
data Selector =
      Selector SelectorSequence -- ^ Convert a given 'SelectorSequence' to a 'Selector'.
    | Combined SelectorSequence SelectorCombinator Selector -- ^ Create a combined selector where we have a 'SelectorSequence' that is combined with a given 'SelectorCombinator' to a 'Selector'.
    deriving (Typeable Selector
DataType
Constr
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 -> DataType
Selector -> Constr
(forall b. Data b => b -> b) -> Selector -> Selector
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Selector -> c Selector
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cCombined :: Constr
$cSelector :: Constr
$tSelector :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Selector -> m Selector
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
gmapMp :: (forall d. Data d => d -> m d) -> Selector -> m Selector
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
gmapM :: (forall d. Data d => d -> m d) -> Selector -> m Selector
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Selector -> m Selector
gmapQi :: Int -> (forall d. Data d => d -> u) -> Selector -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Selector -> u
gmapQ :: (forall d. Data d => d -> u) -> Selector -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Selector -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Selector -> r
gmapT :: (forall b. Data b => b -> b) -> Selector -> Selector
$cgmapT :: (forall b. Data b => b -> b) -> Selector -> Selector
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Selector)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Selector)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Selector)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Selector)
dataTypeOf :: Selector -> DataType
$cdataTypeOf :: Selector -> DataType
toConstr :: Selector -> Constr
$ctoConstr :: Selector -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Selector
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Selector
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Selector -> c Selector
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Selector -> c Selector
$cp1Data :: Typeable Selector
Data, Selector -> Selector -> Bool
(Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool) -> Eq Selector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c== :: Selector -> Selector -> Bool
Eq, (forall x. 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
$cto :: forall x. Rep Selector x -> Selector
$cfrom :: forall x. Selector -> Rep Selector x
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
min :: Selector -> Selector -> Selector
$cmin :: Selector -> Selector -> Selector
max :: Selector -> Selector -> Selector
$cmax :: Selector -> Selector -> Selector
>= :: Selector -> Selector -> Bool
$c>= :: Selector -> Selector -> Bool
> :: Selector -> Selector -> Bool
$c> :: Selector -> Selector -> Bool
<= :: Selector -> Selector -> Bool
$c<= :: Selector -> Selector -> Bool
< :: Selector -> Selector -> Bool
$c< :: Selector -> Selector -> Bool
compare :: Selector -> Selector -> Ordering
$ccompare :: Selector -> Selector -> Ordering
$cp1Ord :: Eq 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
showList :: [Selector] -> ShowS
$cshowList :: [Selector] -> ShowS
show :: Selector -> String
$cshow :: Selector -> String
showsPrec :: Int -> Selector -> ShowS
$cshowsPrec :: Int -> Selector -> ShowS
Show)

instance Hashable Selector


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

instance Hashable SelectorCombinator

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

instance Hashable SelectorSequence

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

instance Hashable SelectorFilter

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

instance Hashable Attrib

-- | A flipped version of the 'Attrib' data constructor, where one first
-- specifies the conbinator, then the 'AttributeName' and finally the value.
attrib :: AttributeCombinator -- ^ The 'AttributeCombinator' that specifies the required relation between the attribute and a value.
    -> 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

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

instance Hashable Namespace

-- | The empty namespace. This is /not/ the wildcard namespace (@*@). This is a
-- bidirectional namespace and can thus be used in expressions as well.
pattern NEmpty :: Namespace
pattern $bNEmpty :: Namespace
$mNEmpty :: forall r. Namespace -> (Void# -> r) -> (Void# -> r) -> r
NEmpty = Namespace ""

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

instance Hashable ElementName

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

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

instance Hashable AttributeName

-- | We use 'Text' as the type to store an attribute value.
type AttributeValue = 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
maxBound :: AttributeCombinator
$cmaxBound :: AttributeCombinator
minBound :: AttributeCombinator
$cminBound :: AttributeCombinator
Bounded, Typeable AttributeCombinator
DataType
Constr
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 -> DataType
AttributeCombinator -> Constr
(forall b. Data b => b -> b)
-> AttributeCombinator -> AttributeCombinator
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AttributeCombinator
-> c AttributeCombinator
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSubstringMatch :: Constr
$cSuffixMatch :: Constr
$cPrefixMatch :: Constr
$cDashMatch :: Constr
$cInclude :: Constr
$cExact :: Constr
$tAttributeCombinator :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
gmapMp :: (forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
gmapM :: (forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AttributeCombinator -> m AttributeCombinator
gmapQi :: Int -> (forall d. Data d => d -> u) -> AttributeCombinator -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AttributeCombinator -> u
gmapQ :: (forall d. Data d => d -> u) -> AttributeCombinator -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AttributeCombinator -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeCombinator -> r
gmapT :: (forall b. Data b => b -> b)
-> AttributeCombinator -> AttributeCombinator
$cgmapT :: (forall b. Data b => b -> b)
-> AttributeCombinator -> AttributeCombinator
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeCombinator)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeCombinator)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AttributeCombinator)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeCombinator)
dataTypeOf :: AttributeCombinator -> DataType
$cdataTypeOf :: AttributeCombinator -> DataType
toConstr :: AttributeCombinator -> Constr
$ctoConstr :: AttributeCombinator -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeCombinator
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeCombinator
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AttributeCombinator
-> c AttributeCombinator
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AttributeCombinator
-> c AttributeCombinator
$cp1Data :: Typeable 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
enumFromThenTo :: AttributeCombinator
-> AttributeCombinator
-> AttributeCombinator
-> [AttributeCombinator]
$cenumFromThenTo :: AttributeCombinator
-> AttributeCombinator
-> AttributeCombinator
-> [AttributeCombinator]
enumFromTo :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
$cenumFromTo :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
enumFromThen :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
$cenumFromThen :: AttributeCombinator -> AttributeCombinator -> [AttributeCombinator]
enumFrom :: AttributeCombinator -> [AttributeCombinator]
$cenumFrom :: AttributeCombinator -> [AttributeCombinator]
fromEnum :: AttributeCombinator -> Int
$cfromEnum :: AttributeCombinator -> Int
toEnum :: Int -> AttributeCombinator
$ctoEnum :: Int -> AttributeCombinator
pred :: AttributeCombinator -> AttributeCombinator
$cpred :: AttributeCombinator -> AttributeCombinator
succ :: AttributeCombinator -> AttributeCombinator
$csucc :: AttributeCombinator -> AttributeCombinator
Enum, AttributeCombinator -> AttributeCombinator -> Bool
(AttributeCombinator -> AttributeCombinator -> Bool)
-> (AttributeCombinator -> AttributeCombinator -> Bool)
-> Eq AttributeCombinator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeCombinator -> AttributeCombinator -> Bool
$c/= :: AttributeCombinator -> AttributeCombinator -> Bool
== :: AttributeCombinator -> AttributeCombinator -> Bool
$c== :: AttributeCombinator -> AttributeCombinator -> Bool
Eq, (forall x. 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
$cto :: forall x. Rep AttributeCombinator x -> AttributeCombinator
$cfrom :: forall x. AttributeCombinator -> Rep AttributeCombinator x
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
min :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
$cmin :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
max :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
$cmax :: AttributeCombinator -> AttributeCombinator -> AttributeCombinator
>= :: AttributeCombinator -> AttributeCombinator -> Bool
$c>= :: AttributeCombinator -> AttributeCombinator -> Bool
> :: AttributeCombinator -> AttributeCombinator -> Bool
$c> :: AttributeCombinator -> AttributeCombinator -> Bool
<= :: AttributeCombinator -> AttributeCombinator -> Bool
$c<= :: AttributeCombinator -> AttributeCombinator -> Bool
< :: AttributeCombinator -> AttributeCombinator -> Bool
$c< :: AttributeCombinator -> AttributeCombinator -> Bool
compare :: AttributeCombinator -> AttributeCombinator -> Ordering
$ccompare :: AttributeCombinator -> AttributeCombinator -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [AttributeCombinator]
$creadListPrec :: ReadPrec [AttributeCombinator]
readPrec :: ReadPrec AttributeCombinator
$creadPrec :: ReadPrec AttributeCombinator
readList :: ReadS [AttributeCombinator]
$creadList :: ReadS [AttributeCombinator]
readsPrec :: Int -> ReadS AttributeCombinator
$creadsPrec :: Int -> ReadS AttributeCombinator
Read, Int -> AttributeCombinator -> ShowS
[AttributeCombinator] -> ShowS
AttributeCombinator -> String
(Int -> AttributeCombinator -> ShowS)
-> (AttributeCombinator -> String)
-> ([AttributeCombinator] -> ShowS)
-> Show AttributeCombinator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeCombinator] -> ShowS
$cshowList :: [AttributeCombinator] -> ShowS
show :: AttributeCombinator -> String
$cshow :: AttributeCombinator -> String
showsPrec :: Int -> AttributeCombinator -> ShowS
$cshowsPrec :: Int -> AttributeCombinator -> ShowS
Show)

instance Hashable AttributeCombinator

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

instance Hashable Class

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

instance Hashable Hash

-- | Convert the given 'AttributeCombinator' to its css selector counterpart.
attributeCombinatorText :: AttributeCombinator -- ^ The 'AttributeCombinator' for which we obtain the corresponding css selector text.
    -> AttributeValue -- ^ The css selector text for the given 'AttributeCombinator'.
attributeCombinatorText :: AttributeCombinator -> Text
attributeCombinatorText AttributeCombinator
Exact = Text
"="
attributeCombinatorText AttributeCombinator
Include = Text
"~="
attributeCombinatorText AttributeCombinator
DashMatch = Text
"|="
attributeCombinatorText AttributeCombinator
PrefixMatch = Text
"^="
attributeCombinatorText AttributeCombinator
SuffixMatch = Text
"$="
attributeCombinatorText AttributeCombinator
SubstringMatch = Text
"*="

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

-- Semigroup and Monoid instances
instance Semigroup SelectorSpecificity where
    SelectorSpecificity Int
a1 Int
b1 Int
c1 <> :: SelectorSpecificity -> SelectorSpecificity -> SelectorSpecificity
<> SelectorSpecificity Int
a2 Int
b2 Int
c2 = Int -> Int -> Int -> SelectorSpecificity
SelectorSpecificity (Int
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

-- 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
. [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)

_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 -> [Pat] -> Pat
ConP []

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 (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 = Selector -> SelectorGroup
forall a. ToCssSelector a => a -> SelectorGroup
toSelectorGroup (Selector -> SelectorGroup)
-> (SelectorSequence -> Selector)
-> SelectorSequence
-> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorSequence -> Selector
Selector
    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
    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
    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]

instance ToCssSelector Selector where
    toCssSelector :: Selector -> Text
toCssSelector (Selector SelectorSequence
s) = SelectorSequence -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector SelectorSequence
s
    toCssSelector (Combined SelectorSequence
s1 SelectorCombinator
c Selector
s2) = SelectorSequence -> Text
forall a. ToCssSelector a => a -> Text
toCssSelector SelectorSequence
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 (f :: * -> *) a. Applicative f => a -> f a
pure
    specificity' :: Selector -> SelectorSpecificity
specificity' (Selector SelectorSequence
s) = SelectorSequence -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' SelectorSequence
s
    specificity' (Combined SelectorSequence
s1 SelectorCombinator
_ Selector
s2) = SelectorSequence -> SelectorSpecificity
forall a. ToCssSelector a => a -> SelectorSpecificity
specificity' SelectorSequence
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 SelectorSequence
s) = Name -> [Pat] -> Pat
ConP 'Selector [SelectorSequence -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern SelectorSequence
s]
    toPattern (Combined SelectorSequence
s1 SelectorCombinator
c Selector
s2) = Name -> [Pat] -> Pat
ConP 'Combined [SelectorSequence -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern SelectorSequence
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 SelectorSequence
s) = SelectorSequence -> Selector
Selector (SelectorSequence -> SelectorSequence
forall a. ToCssSelector a => a -> a
normalize SelectorSequence
s)
    normalize (Combined SelectorSequence
s1 SelectorCombinator
c Selector
s2) = SelectorSequence -> SelectorCombinator -> Selector -> Selector
Combined (SelectorSequence -> SelectorSequence
forall a. ToCssSelector a => a -> a
normalize SelectorSequence
s1) SelectorCombinator
c (Selector -> Selector
forall a. ToCssSelector a => a -> a
normalize Selector
s2)

-- 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 (f :: * -> *) a. Applicative f => a -> f a
pure Selector
forall a. Default a => a
def)

instance Default Selector where
    def :: Selector
def = SelectorSequence -> Selector
Selector 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

-- Binary instance
_putEnum :: Enum a => a -> Put
_putEnum :: 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 :: 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 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 (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 (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 (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 (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 SelectorSequence
c) = Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SelectorSequence -> Put
forall t. Binary t => t -> Put
put SelectorSequence
c
  put (Combined SelectorSequence
c SelectorCombinator
sc Selector
cs) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SelectorSequence -> Put
forall t. Binary t => t -> Put
put SelectorSequence
c Put -> Put -> Put
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 (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 -> SelectorSequence -> Selector
Selector (SelectorSequence -> Selector)
-> Get SelectorSequence -> Get Selector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SelectorSequence
forall t. Binary t => Get t
get
      Word8
1 -> SelectorSequence -> SelectorCombinator -> Selector -> Selector
Combined (SelectorSequence -> SelectorCombinator -> Selector -> Selector)
-> Get SelectorSequence
-> Get (SelectorCombinator -> Selector -> Selector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SelectorSequence
forall t. Binary t => Get t
get Get (SelectorCombinator -> Selector -> Selector)
-> Get SelectorCombinator -> Get (Selector -> Selector)
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 (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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An error occured while deserializing a Selector object"

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 (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 (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 (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 (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 (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 (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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Attrib -> Put
forall t. Binary t => t -> Put
put Attrib
a
  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
_ -> String -> Get SelectorFilter
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An error occurred when deserializing a SelectorFilter object."

instance Binary Attrib where
  put :: Attrib -> Put
put (Exist AttributeName
e) = Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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
_apply :: Name -> [Q Exp] -> Q Exp
_apply :: Name -> [Q Exp] -> Q Exp
_apply = (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> [Q Exp] -> Q Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Exp -> Q Exp -> Q Exp
appE (Q Exp -> [Q Exp] -> Q Exp)
-> (Name -> Q Exp) -> Name -> [Q Exp] -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Exp
conE

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


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

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

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

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

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


-- ToMarkup instances
_cssToMarkup :: ToCssSelector a => a -> Markup
_cssToMarkup :: 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 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

-- ToJavaScript and ToJson instances
_cssToJavascript :: ToCssSelector a => a -> Javascript
#if __GLASGOW_HASKELL__ < 803
_cssToJavascript = toJavascript . toJSON . toCssSelector
#else
_cssToJavascript :: 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 :: 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 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 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 Attrib where
    toJSON :: Attrib -> Value
toJSON = Attrib -> 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

_shrinkText :: Text -> [Text]
_shrinkText :: Text -> [Text]
_shrinkText = ([Text] -> [Text] -> [Text])
-> (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
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 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 (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 (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 (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 (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
_) = []
    shrink (Filter SelectorSequence
ss SelectorFilter
sf) = 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 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 = [Gen SelectorFilter] -> Gen SelectorFilter
forall a. [Gen a] -> Gen a
oneof [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, 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, 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]
    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

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 (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 (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 (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 (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, SelectorSequence -> Selector
Selector (SelectorSequence -> Selector)
-> Gen SelectorSequence -> Gen Selector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SelectorSequence
forall a. Arbitrary a => Gen a
arbitrary), (Int
1, SelectorSequence -> SelectorCombinator -> Selector -> Selector
Combined (SelectorSequence -> SelectorCombinator -> Selector -> Selector)
-> Gen SelectorSequence
-> Gen (SelectorCombinator -> Selector -> Selector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SelectorSequence
forall a. Arbitrary a => Gen a
arbitrary Gen (SelectorCombinator -> Selector -> Selector)
-> Gen SelectorCombinator -> Gen (Selector -> Selector)
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 (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 SelectorSequence
x) = SelectorSequence -> Selector
Selector (SelectorSequence -> Selector) -> [SelectorSequence] -> [Selector]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectorSequence -> [SelectorSequence]
forall a. Arbitrary a => a -> [a]
shrink SelectorSequence
x
    shrink (Combined SelectorSequence
x SelectorCombinator
y Selector
z) = Selector
z Selector -> [Selector] -> [Selector]
forall a. a -> [a] -> [a]
: (SelectorSequence -> SelectorCombinator -> Selector -> Selector
Combined SelectorSequence
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]
++ ((\SelectorSequence
sx -> SelectorSequence -> SelectorCombinator -> Selector -> Selector
Combined SelectorSequence
sx SelectorCombinator
y Selector
z) (SelectorSequence -> Selector) -> [SelectorSequence] -> [Selector]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectorSequence -> [SelectorSequence]
forall a. Arbitrary a => a -> [a]
shrink SelectorSequence
x)