-- | Central infrastructure for implementing queryable stylesheets.
-- NOTE: This internal module isn't intended to be fully documented.
module Data.CSS.Style.Common(
        RuleStore(..), StyleRule'(..), selector, properties, psuedoElement, styleRule',
        Element(..), Attribute(..),
        -- Re-exports
        Text(..), StyleRule(..), Selector(..), SimpleSelector(..), PropertyTest(..)
    ) where

import Data.CSS.Syntax.StyleSheet
import Data.CSS.Syntax.Selector
import Data.CSS.Syntax.Tokens
import Data.Text.Internal (Text(..))

-- | An inversely-linked tree of elements, to apply CSS selectors to.
data Element = ElementNode {
    -- | The element's parent in the tree.
    Element -> Maybe Element
parent :: Maybe Element,
    -- | The element's previous sibling in the tree.
    Element -> Maybe Element
previous :: Maybe Element,
    -- | The element's name.
    Element -> Text
name :: Text,
    -- | The element's namespace.
    Element -> Text
namespace :: Text,
    -- | The element's attributes, in sorted order.
    Element -> [Attribute]
attributes :: [Attribute]
}
-- | A key-value attribute.
data Attribute = Attribute Text Text String deriving (Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq, Eq Attribute
Eq Attribute
-> (Attribute -> Attribute -> Ordering)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Attribute)
-> (Attribute -> Attribute -> Attribute)
-> Ord Attribute
Attribute -> Attribute -> Bool
Attribute -> Attribute -> Ordering
Attribute -> Attribute -> Attribute
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 :: Attribute -> Attribute -> Attribute
$cmin :: Attribute -> Attribute -> Attribute
max :: Attribute -> Attribute -> Attribute
$cmax :: Attribute -> Attribute -> Attribute
>= :: Attribute -> Attribute -> Bool
$c>= :: Attribute -> Attribute -> Bool
> :: Attribute -> Attribute -> Bool
$c> :: Attribute -> Attribute -> Bool
<= :: Attribute -> Attribute -> Bool
$c<= :: Attribute -> Attribute -> Bool
< :: Attribute -> Attribute -> Bool
$c< :: Attribute -> Attribute -> Bool
compare :: Attribute -> Attribute -> Ordering
$ccompare :: Attribute -> Attribute -> Ordering
$cp1Ord :: Eq Attribute
Ord)

class RuleStore a where
    new :: a
    addStyleRule :: a -> Int -> StyleRule' -> a
    lookupRules :: a -> Element -> [StyleRule']

type SelectorFunc = Element -> Bool
data StyleRule' = StyleRule' {
    StyleRule' -> StyleRule
inner :: StyleRule,
    StyleRule' -> SelectorFunc
compiledSelector :: SelectorFunc,
    StyleRule' -> (Int, (Int, Int, Int), Int)
rank :: (Int, (Int, Int, Int), Int) -- This reads ugly, but oh well.
}
styleRule' :: StyleRule -> StyleRule'
styleRule' :: StyleRule -> StyleRule'
styleRule' StyleRule
rule = StyleRule' :: StyleRule
-> SelectorFunc -> (Int, (Int, Int, Int), Int) -> StyleRule'
StyleRule' {
    inner :: StyleRule
inner = StyleRule
rule,
    compiledSelector :: SelectorFunc
compiledSelector = \Element
_ -> Bool
True,
    rank :: (Int, (Int, Int, Int), Int)
rank = (Int
0, (Int
0, Int
0, Int
0), Int
0)
}

instance Eq StyleRule' where
    StyleRule'
a == :: StyleRule' -> StyleRule' -> Bool
== StyleRule'
b = StyleRule' -> StyleRule
inner StyleRule'
a StyleRule -> StyleRule -> Bool
forall a. Eq a => a -> a -> Bool
== StyleRule' -> StyleRule
inner StyleRule'
b
instance Show StyleRule' where show :: StyleRule' -> String
show StyleRule'
a = StyleRule -> String
forall a. Show a => a -> String
show (StyleRule -> String) -> StyleRule -> String
forall a b. (a -> b) -> a -> b
$ StyleRule' -> StyleRule
inner StyleRule'
a
instance Ord StyleRule' where compare :: StyleRule' -> StyleRule' -> Ordering
compare StyleRule'
x StyleRule'
y = StyleRule' -> (Int, (Int, Int, Int), Int)
rank StyleRule'
x (Int, (Int, Int, Int), Int)
-> (Int, (Int, Int, Int), Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` StyleRule' -> (Int, (Int, Int, Int), Int)
rank StyleRule'
y

selector :: StyleRule' -> Selector
selector :: StyleRule' -> Selector
selector StyleRule'
rule | StyleRule Selector
sel [(Text, [Token])]
_ Text
_ <- StyleRule' -> StyleRule
inner StyleRule'
rule = Selector
sel
properties :: StyleRule' -> [(Text, [Data.CSS.Syntax.Tokens.Token])]
properties :: StyleRule' -> [(Text, [Token])]
properties StyleRule'
rule | StyleRule Selector
_ [(Text, [Token])]
props Text
_ <- StyleRule' -> StyleRule
inner StyleRule'
rule = [(Text, [Token])]
props
psuedoElement :: StyleRule' -> Text
psuedoElement :: StyleRule' -> Text
psuedoElement StyleRule'
rule | StyleRule Selector
_ [(Text, [Token])]
_ Text
psuedo <- StyleRule' -> StyleRule
inner StyleRule'
rule = Text
psuedo