-- | Parses CSS selectors
-- See `parseSelectors`
module Stylist.Parse.Selector(
        Selector(..), SimpleSelector(..), PropertyTest(..), PropertyFunc(..),
        parseSelectors
    ) where

import Data.CSS.Syntax.Tokens
import Stylist.Parse.Util

import Data.Text.Internal (Text(..))

-- | A CSS "selector" indicating which elements should be effected by CSS.
data Selector = Element [SimpleSelector] -- ^ Selects a single element.
    | Child Selector [SimpleSelector] -- ^ Represents "a > b" operator.
    | Descendant Selector [SimpleSelector] -- ^ Represents "a b" operator.
    | Adjacent Selector [SimpleSelector] -- ^ Represents "a + b" operator.
    | Sibling Selector [SimpleSelector] -- ^ Represents "a ~ b" operator.
    deriving (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, 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)
-- | An individual test comprising a CSS stylesheet.
data SimpleSelector = Tag Text -- ^ Matches a tagname, e.g. "a"
    | Namespace Text
    | Id Text -- ^ Matches the "id" attribute, e.g. "#header"
    | Class Text -- ^ Matches the "class" attribute, e.g. ".ad"
    | Property (Maybe Text) Text PropertyTest -- ^ Matches a specified property
    | Psuedoclass Text [Token] -- ^ Matches psuedoclasses provided by the caller (via a nameless property).
    deriving (Int -> SimpleSelector -> ShowS
[SimpleSelector] -> ShowS
SimpleSelector -> String
(Int -> SimpleSelector -> ShowS)
-> (SimpleSelector -> String)
-> ([SimpleSelector] -> ShowS)
-> Show SimpleSelector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleSelector] -> ShowS
$cshowList :: [SimpleSelector] -> ShowS
show :: SimpleSelector -> String
$cshow :: SimpleSelector -> String
showsPrec :: Int -> SimpleSelector -> ShowS
$cshowsPrec :: Int -> SimpleSelector -> ShowS
Show, SimpleSelector -> SimpleSelector -> Bool
(SimpleSelector -> SimpleSelector -> Bool)
-> (SimpleSelector -> SimpleSelector -> Bool) -> Eq SimpleSelector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleSelector -> SimpleSelector -> Bool
$c/= :: SimpleSelector -> SimpleSelector -> Bool
== :: SimpleSelector -> SimpleSelector -> Bool
$c== :: SimpleSelector -> SimpleSelector -> Bool
Eq)
-- | How should a property be matched.
data PropertyTest = Exists -- ^ Matches whether an attribute actually exists, e.g. "[title]"
    | Equals Text -- ^ Matches whether the attribute is exactly equal to the value, e.g. "="
    | Suffix Text -- ^ Matches whether attribute ends with the given value, e.g. "$="
    | Prefix Text -- ^ Matches whether attribute starts with the given value, e.g. "^="
    | Substring Text -- ^ Matches whether the attribute contains the given value, e.g. "*="
    | Include Text -- ^ Is one of the whitespace-seperated values the one specified? e.g. "~="
    | Dash Text -- ^ Matches whitespace seperated values, or their "-"-seperated prefixes. e.g. "|="
    | Callback PropertyFunc -- ^ Calls the given function to test this property.
    deriving (Int -> PropertyTest -> ShowS
[PropertyTest] -> ShowS
PropertyTest -> String
(Int -> PropertyTest -> ShowS)
-> (PropertyTest -> String)
-> ([PropertyTest] -> ShowS)
-> Show PropertyTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertyTest] -> ShowS
$cshowList :: [PropertyTest] -> ShowS
show :: PropertyTest -> String
$cshow :: PropertyTest -> String
showsPrec :: Int -> PropertyTest -> ShowS
$cshowsPrec :: Int -> PropertyTest -> ShowS
Show, PropertyTest -> PropertyTest -> Bool
(PropertyTest -> PropertyTest -> Bool)
-> (PropertyTest -> PropertyTest -> Bool) -> Eq PropertyTest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropertyTest -> PropertyTest -> Bool
$c/= :: PropertyTest -> PropertyTest -> Bool
== :: PropertyTest -> PropertyTest -> Bool
$c== :: PropertyTest -> PropertyTest -> Bool
Eq)
-- | Caller-specified functions to extend property selection.
-- Has incorrect Show/Eq implementations so this rare exception doesn't break things.
data PropertyFunc = PropertyFunc (String -> Bool)
instance Show PropertyFunc where
    show :: PropertyFunc -> String
show _ = "xx"
instance Eq PropertyFunc where
    _ == :: PropertyFunc -> PropertyFunc -> Bool
== _ = Bool
False

-- | Parses a CSS selector.
parseSelectors :: Parser [Selector]
parseSelectors :: Parser [Selector]
parseSelectors tokens :: [Token]
tokens = (Selector -> [Selector] -> [Selector])
-> Parser Selector -> Parser [Selector] -> Parser [Selector]
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
concatP (:) Parser Selector
parseCompound Parser [Selector]
parseSelectorsTail Parser [Selector] -> Parser [Selector]
forall a b. (a -> b) -> a -> b
$ [Token] -> [Token]
skipSpace [Token]
tokens
parseSelectorsTail :: Parser [Selector]
parseSelectorsTail :: Parser [Selector]
parseSelectorsTail (Comma:tokens :: [Token]
tokens) = Parser [Selector]
parseSelectors [Token]
tokens
parseSelectorsTail tokens :: [Token]
tokens = ([], [Token]
tokens)
parseCompound :: Parser Selector
parseCompound :: Parser Selector
parseCompound tokens :: [Token]
tokens = Selector -> Parser Selector
parseCombinators ([SimpleSelector] -> Selector
Element [SimpleSelector]
selector) [Token]
tokens'
    where (selector :: [SimpleSelector]
selector, tokens' :: [Token]
tokens') = Parser [SimpleSelector]
parseSelector [Token]
tokens

parseSelector' :: SimpleSelector -> Parser [SimpleSelector]
parseSelector' :: SimpleSelector -> Parser [SimpleSelector]
parseSelector' op :: SimpleSelector
op tokens :: [Token]
tokens = (SimpleSelector
opSimpleSelector -> [SimpleSelector] -> [SimpleSelector]
forall a. a -> [a] -> [a]
:[SimpleSelector]
selector, [Token]
tokens')
    where (selector :: [SimpleSelector]
selector, tokens' :: [Token]
tokens') = Parser [SimpleSelector]
parseSelector [Token]
tokens

parseSelector :: Parser [SimpleSelector]
parseSelector :: Parser [SimpleSelector]
parseSelector (Ident ns :: Text
ns:Delim '|':tokens :: [Token]
tokens) = SimpleSelector -> Parser [SimpleSelector]
parseSelector' (Text -> SimpleSelector
Namespace Text
ns) [Token]
tokens
parseSelector (Delim '*':tokens :: [Token]
tokens) = Parser [SimpleSelector]
parseSelector [Token]
tokens
parseSelector (Ident tag :: Text
tag:tokens :: [Token]
tokens) = SimpleSelector -> Parser [SimpleSelector]
parseSelector' (Text -> SimpleSelector
Tag Text
tag) [Token]
tokens
parseSelector (Hash _ i :: Text
i:tokens :: [Token]
tokens) = SimpleSelector -> Parser [SimpleSelector]
parseSelector' (Text -> SimpleSelector
Id Text
i) [Token]
tokens
parseSelector (Delim '.':Ident class_ :: Text
class_:tokens :: [Token]
tokens) = SimpleSelector -> Parser [SimpleSelector]
parseSelector' (Text -> SimpleSelector
Class Text
class_) [Token]
tokens
parseSelector (LeftSquareBracket:Ident ns :: Text
ns:Delim '|':Ident prop :: Text
prop:tokens :: [Token]
tokens) =
        (PropertyTest -> [SimpleSelector] -> [SimpleSelector])
-> Parser PropertyTest
-> Parser [SimpleSelector]
-> Parser [SimpleSelector]
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
concatP PropertyTest -> [SimpleSelector] -> [SimpleSelector]
appendPropertySel Parser PropertyTest
parsePropertySel Parser [SimpleSelector]
parseSelector [Token]
tokens
    where appendPropertySel :: PropertyTest -> [SimpleSelector] -> [SimpleSelector]
appendPropertySel test :: PropertyTest
test selector :: [SimpleSelector]
selector = Maybe Text -> Text -> PropertyTest -> SimpleSelector
Property (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns) Text
prop PropertyTest
test SimpleSelector -> [SimpleSelector] -> [SimpleSelector]
forall a. a -> [a] -> [a]
: [SimpleSelector]
selector
parseSelector (LeftSquareBracket:Ident prop :: Text
prop:tokens :: [Token]
tokens) =
        (PropertyTest -> [SimpleSelector] -> [SimpleSelector])
-> Parser PropertyTest
-> Parser [SimpleSelector]
-> Parser [SimpleSelector]
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
concatP PropertyTest -> [SimpleSelector] -> [SimpleSelector]
appendPropertySel Parser PropertyTest
parsePropertySel Parser [SimpleSelector]
parseSelector [Token]
tokens
    where appendPropertySel :: PropertyTest -> [SimpleSelector] -> [SimpleSelector]
appendPropertySel test :: PropertyTest
test selector :: [SimpleSelector]
selector = Maybe Text -> Text -> PropertyTest -> SimpleSelector
Property Maybe Text
forall a. Maybe a
Nothing Text
prop PropertyTest
test SimpleSelector -> [SimpleSelector] -> [SimpleSelector]
forall a. a -> [a] -> [a]
: [SimpleSelector]
selector
parseSelector (Colon:Ident p :: Text
p:ts :: [Token]
ts) = SimpleSelector -> Parser [SimpleSelector]
parseSelector' (Text -> [Token] -> SimpleSelector
Psuedoclass Text
p []) [Token]
ts
parseSelector (Colon:Function fn :: Text
fn:tokens :: [Token]
tokens) =
        ([Token] -> [SimpleSelector] -> [SimpleSelector])
-> Parser [Token]
-> Parser [SimpleSelector]
-> Parser [SimpleSelector]
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
concatP [Token] -> [SimpleSelector] -> [SimpleSelector]
appendPseudo Parser [Token]
scanBlock Parser [SimpleSelector]
parseSelector [Token]
tokens
    where appendPseudo :: [Token] -> [SimpleSelector] -> [SimpleSelector]
appendPseudo args :: [Token]
args selector :: [SimpleSelector]
selector = Text -> [Token] -> SimpleSelector
Psuedoclass Text
fn [Token]
args SimpleSelector -> [SimpleSelector] -> [SimpleSelector]
forall a. a -> [a] -> [a]
: [SimpleSelector]
selector
parseSelector tokens :: [Token]
tokens = ([], [Token]
tokens)

parseCombinators' :: Selector -> Parser Selector
parseCombinators' :: Selector -> Parser Selector
parseCombinators' selector :: Selector
selector tokens :: [Token]
tokens = Selector -> Parser Selector
parseCombinators Selector
selector' [Token]
tokens'
    where (selector' :: Selector
selector', tokens' :: [Token]
tokens') = Selector -> Parser Selector
parseCombinator Selector
selector [Token]
tokens
parseCombinators :: Selector -> Parser Selector
parseCombinators :: Selector -> Parser Selector
parseCombinators selector :: Selector
selector (Whitespace:tokens :: [Token]
tokens) = Selector -> Parser Selector
parseCombinators' Selector
selector [Token]
tokens
parseCombinators selector :: Selector
selector tokens :: [Token]
tokens@(Delim _:_) = Selector -> Parser Selector
parseCombinators' Selector
selector [Token]
tokens
parseCombinators selector :: Selector
selector tokens :: [Token]
tokens = (Selector
selector, [Token]
tokens)

parseCombinator' :: (Selector -> [SimpleSelector] -> Selector)
                    -> Selector -> Parser Selector
parseCombinator' :: (Selector -> [SimpleSelector] -> Selector)
-> Selector -> Parser Selector
parseCombinator' cb :: Selector -> [SimpleSelector] -> Selector
cb selector :: Selector
selector tokens :: [Token]
tokens = (Selector -> [SimpleSelector] -> Selector
cb Selector
selector [SimpleSelector]
selector', [Token]
tokens')
    where (selector' :: [SimpleSelector]
selector', tokens' :: [Token]
tokens') = Parser [SimpleSelector]
parseSelector Parser [SimpleSelector] -> Parser [SimpleSelector]
forall a b. (a -> b) -> a -> b
$ [Token] -> [Token]
skipSpace [Token]
tokens
parseCombinator :: Selector -> [Token] -> (Selector, [Token])
parseCombinator :: Selector -> Parser Selector
parseCombinator selector :: Selector
selector (Whitespace:tokens :: [Token]
tokens) = Selector -> Parser Selector
parseCombinator Selector
selector [Token]
tokens
parseCombinator selector :: Selector
selector (Delim '>':tokens :: [Token]
tokens) = (Selector -> [SimpleSelector] -> Selector)
-> Selector -> Parser Selector
parseCombinator' Selector -> [SimpleSelector] -> Selector
Child Selector
selector [Token]
tokens
parseCombinator selector :: Selector
selector (Delim '~':tokens :: [Token]
tokens) = (Selector -> [SimpleSelector] -> Selector)
-> Selector -> Parser Selector
parseCombinator' Selector -> [SimpleSelector] -> Selector
Sibling Selector
selector [Token]
tokens
parseCombinator selector :: Selector
selector (Delim '+':tokens :: [Token]
tokens) = (Selector -> [SimpleSelector] -> Selector)
-> Selector -> Parser Selector
parseCombinator' Selector -> [SimpleSelector] -> Selector
Adjacent Selector
selector [Token]
tokens
-- Take special care to avoid adding a trailing Descendant when not needed.
parseCombinator selector :: Selector
selector tokens :: [Token]
tokens@(LeftCurlyBracket:_) = (Selector
selector, [Token]
tokens)
parseCombinator selector :: Selector
selector tokens :: [Token]
tokens@(RightCurlyBracket:_) = (Selector
selector, [Token]
tokens)
parseCombinator selector :: Selector
selector tokens :: [Token]
tokens@(RightSquareBracket:_) = (Selector
selector, [Token]
tokens)
parseCombinator selector :: Selector
selector tokens :: [Token]
tokens@(Comma:_) = (Selector
selector, [Token]
tokens)

parseCombinator selector :: Selector
selector tokens :: [Token]
tokens@(RightParen:_) = (Selector
selector, [Token]
tokens)
parseCombinator selector :: Selector
selector [] = (Selector
selector, [])

parseCombinator selector :: Selector
selector tokens :: [Token]
tokens = (Selector -> [SimpleSelector] -> Selector)
-> Selector -> Parser Selector
parseCombinator' Selector -> [SimpleSelector] -> Selector
Descendant Selector
selector [Token]
tokens

parsePropertySel :: Parser PropertyTest
parsePropertySel :: Parser PropertyTest
parsePropertySel (RightSquareBracket:tokens :: [Token]
tokens) = (PropertyTest
Exists, [Token]
tokens)
parsePropertySel (Delim '=':tokens :: [Token]
tokens) = (Text -> PropertyTest) -> Parser PropertyTest
parsePropertyVal (Text -> PropertyTest
Equals) [Token]
tokens
parsePropertySel (SuffixMatch:tokens :: [Token]
tokens) = (Text -> PropertyTest) -> Parser PropertyTest
parsePropertyVal (Text -> PropertyTest
Suffix) [Token]
tokens
parsePropertySel (PrefixMatch:tokens :: [Token]
tokens) = (Text -> PropertyTest) -> Parser PropertyTest
parsePropertyVal (Text -> PropertyTest
Prefix) [Token]
tokens
parsePropertySel (SubstringMatch:tokens :: [Token]
tokens) = (Text -> PropertyTest) -> Parser PropertyTest
parsePropertyVal (Text -> PropertyTest
Substring) [Token]
tokens
parsePropertySel (IncludeMatch:tokens :: [Token]
tokens) = (Text -> PropertyTest) -> Parser PropertyTest
parsePropertyVal (Text -> PropertyTest
Include) [Token]
tokens
parsePropertySel (DashMatch:tokens :: [Token]
tokens) = (Text -> PropertyTest) -> Parser PropertyTest
parsePropertyVal (Text -> PropertyTest
Dash) [Token]
tokens
parsePropertySel tokens :: [Token]
tokens = (PropertyTest
Exists, [Token] -> [Token]
skipBlock [Token]
tokens)

parsePropertyVal :: (Text -> PropertyTest) -> Parser PropertyTest
parsePropertyVal :: (Text -> PropertyTest) -> Parser PropertyTest
parsePropertyVal wrapper :: Text -> PropertyTest
wrapper (Ident val :: Text
val:RightSquareBracket:tokens :: [Token]
tokens) = (Text -> PropertyTest
wrapper Text
val, [Token]
tokens)
parsePropertyVal wrapper :: Text -> PropertyTest
wrapper (String val :: Text
val:RightSquareBracket:tokens :: [Token]
tokens) = (Text -> PropertyTest
wrapper Text
val, [Token]
tokens)
parsePropertyVal _ tokens :: [Token]
tokens = (PropertyTest
Exists, [Token] -> [Token]
skipBlock [Token]
tokens)