-- | Description: Defunctionalized representation of selectors
module Text.XML.Selectors.Types
where

import Text.XML
import Text.XML.Cursor
import Data.Text (Text)
import qualified Data.Text as Text
import Control.Applicative

-- | Node-level selectors and combinators
data Selector
  = None
  | Any -- ^ @*@
  | Append Selector Selector -- ^ @ab@ (both a and b must match)
  | Elem Name -- ^ @div@
  | Attrib AttribSelector -- ^ @a[...]@
  | Descendant -- ^ @ @ (whitespace)
  | Child -- ^ @>@
  | Sibling -- ^ @~@
  | NextSibling -- ^ @+@
  | FirstChild -- ^ @:first-child@
  | LastChild -- ^ @:last-child@
  | NthChild Int -- ^ @:nth-child(n); :nth-last-child(-n)@
  | Choice [Selector] -- ^ @a,b,...@
  | Having Selector -- ^ @:has(b)@
  | Not Selector -- ^ @:not(b)@
  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)

selectorAppend :: Selector -> Selector -> Selector
selectorAppend :: Selector -> Selector -> Selector
selectorAppend Selector
Any Selector
x = Selector
x
selectorAppend Selector
x Selector
Any = Selector
x
selectorAppend Selector
a Selector
b = Selector -> Selector -> Selector
Append Selector
a Selector
b

-- | The 'Semigroup' of selectors combines selectors with 'Append'. @a <> b@
-- selects all nodes that match @a@ and also match @b@. Note however that the
-- '<>' operator culls redundant combinations with the 'Any' selector, e.g.
-- @Any <> Child <> Any@ is just @Child@, not @Append Any (Append Child Any)@.
instance Semigroup Selector where
  <> :: Selector -> Selector -> Selector
(<>) = Selector -> Selector -> Selector
selectorAppend

-- | The 'Monoid' instance, just like 'Semigroup', combines selectors with
-- 'Append'; the neutral value is, of course, 'Any'.
instance Monoid Selector where
  mappend :: Selector -> Selector -> Selector
mappend = Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Selector
mempty = Selector
Any

-- | An alternative semigroup of selectors, representing choice.
-- @a \<||\> b@ selects all nodes that match @a@ and also all nodes that match
-- @b@. In other words: @a \<||\> b@ == @Choice a b@. Note however that the
-- '<||>' operator culls redundant applications of 'Choice', e.g.,
-- @a \<||\> b \<||\> c@ becomes @Choice [a, b, c]@ rather than
-- @Choice [a, Choice [b, c]]@. This alternative semigroup could be extended
-- into a monoid, with the empty choice (@Choice []@) as the neutral value,
-- but we were far too lazy to add that.
(<||>) :: Selector -> Selector -> Selector
Choice [Selector]
xs <||> :: Selector -> Selector -> Selector
<||> Choice [Selector]
ys = [Selector] -> Selector
Choice ([Selector]
xs [Selector] -> [Selector] -> [Selector]
forall a. [a] -> [a] -> [a]
++ [Selector]
ys)
Choice [Selector]
xs <||> Selector
y = [Selector] -> Selector
Choice ([Selector]
xs [Selector] -> [Selector] -> [Selector]
forall a. [a] -> [a] -> [a]
++ [Selector
y])
Selector
x <||> Choice [Selector]
ys = [Selector] -> Selector
Choice (Selector
x Selector -> [Selector] -> [Selector]
forall a. a -> [a] -> [a]
: [Selector]
ys)
Selector
x <||> Selector
y = [Selector] -> Selector
Choice [Selector
x, Selector
y]
infixl 3 <||>

-- | Attribute-level selectors
data AttribSelector
  = AttribExists Name -- ^ @[attr]@
  | AttribIs Name Text -- ^ @[attr=blah]@
  | AttribIsNot Name Text -- ^ @[attr!=blah]@
  | AttribStartsWith Name Text -- ^ @[attr^=blah]@
  | AttribEndsWith Name Text -- ^ @[attr$=blah]@
  | AttribContains Name Text -- ^ @[attr*=blah]@
  | AttribContainsWord Name Text -- ^ @[attr~=blah]@
  | AttribContainsPrefix Name Text -- ^ @[attr|=blah]@
  deriving (Int -> AttribSelector -> ShowS
[AttribSelector] -> ShowS
AttribSelector -> String
(Int -> AttribSelector -> ShowS)
-> (AttribSelector -> String)
-> ([AttribSelector] -> ShowS)
-> Show AttribSelector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttribSelector] -> ShowS
$cshowList :: [AttribSelector] -> ShowS
show :: AttribSelector -> String
$cshow :: AttribSelector -> String
showsPrec :: Int -> AttribSelector -> ShowS
$cshowsPrec :: Int -> AttribSelector -> ShowS
Show, AttribSelector -> AttribSelector -> Bool
(AttribSelector -> AttribSelector -> Bool)
-> (AttribSelector -> AttribSelector -> Bool) -> Eq AttribSelector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttribSelector -> AttribSelector -> Bool
$c/= :: AttribSelector -> AttribSelector -> Bool
== :: AttribSelector -> AttribSelector -> Bool
$c== :: AttribSelector -> AttribSelector -> Bool
Eq)