{-#LANGUAGE OverloadedStrings #-}

-- | Description: Convert 'Selector's into 'Axis' functions.
module Text.XML.Selectors.ToAxis
where

import Text.XML
import Text.XML.Cursor
import Text.XML.Selectors.Types
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as Text
import Data.List (nubBy)

-- | Turn a 'Selector' into an 'Axis'.
toAxis :: Selector -> Axis
-- @*@
toAxis :: Selector -> Axis
toAxis Selector
Any =
  (Cursor -> [Cursor] -> [Cursor]
forall a. a -> [a] -> [a]
:[])
toAxis Selector
None =
  [Cursor] -> Axis
forall a b. a -> b -> a
const []
toAxis (Append Selector
a Selector
b) =
  Selector -> Axis
toAxis Selector
a Axis -> Axis -> Axis
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Selector -> Axis
toAxis Selector
b
-- @div@
toAxis (Elem Name
name) =
  Name -> Axis
element Name
name
-- @a[...]@
toAxis (Attrib AttribSelector
p) =
  AttribSelector -> Axis
checkAttrib AttribSelector
p
-- @a b@
toAxis Selector
Descendant =
  Axis
forall node. Axis node
descendant
-- @a>b@
toAxis Selector
Child =
  Axis
forall node. Axis node
child
-- @a~b@
toAxis Selector
Sibling =
  Axis
forall node. Axis node
followingSibling
-- @a+b@
toAxis Selector
NextSibling =
  Int -> [Cursor] -> [Cursor]
forall a. Int -> [a] -> [a]
take Int
1 ([Cursor] -> [Cursor]) -> Axis -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Axis
forall node. Axis node
followingSibling
-- @:first-child@
toAxis Selector
FirstChild =
  (Cursor -> Bool) -> Axis
forall b. Boolean b => (Cursor -> b) -> Axis
check ([Cursor] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Cursor] -> Bool) -> Axis -> Cursor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Axis
forall node. Axis node
precedingSibling)
-- @:last-child@
toAxis Selector
LastChild =
  (Cursor -> Bool) -> Axis
forall b. Boolean b => (Cursor -> b) -> Axis
check ([Cursor] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Cursor] -> Bool) -> Axis -> Cursor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Axis
forall node. Axis node
followingSibling)
-- @:nth-child(n)@; @:nth-last-child(-n)@
toAxis (NthChild Int
i)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (Cursor -> Bool) -> Axis
forall b. Boolean b => (Cursor -> b) -> Axis
check ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Bool) -> (Cursor -> Int) -> Cursor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cursor] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Cursor] -> Int) -> Axis -> Cursor -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Axis
forall node. Axis node
precedingSibling)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (Cursor -> Bool) -> Axis
forall b. Boolean b => (Cursor -> b) -> Axis
check ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Bool) -> (Cursor -> Int) -> Cursor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cursor] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Cursor] -> Int) -> Axis -> Cursor -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Axis
forall node. Axis node
followingSibling)
  | Bool
otherwise = [Char] -> Axis
forall a. HasCallStack => [Char] -> a
error [Char]
":nth-child(0)"
-- @a,b,...@
toAxis (Choice [Selector]
xs) =
  \Cursor
c -> (Selector -> [Cursor]) -> [Selector] -> [Cursor]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Selector
x -> Selector -> Axis
toAxis Selector
x Cursor
c) [Selector]
xs
-- @a:has(b)@
toAxis (Having Selector
s) =
  Axis -> Axis
forall b. Boolean b => (Cursor -> b) -> Axis
check (Axis
forall node. Axis node
descendant Axis -> Axis -> Axis
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Selector -> Axis
toAxis Selector
s)
-- @a:not(b)@
toAxis (Not Selector
s) =
  (Cursor -> Bool) -> Axis
forall b. Boolean b => (Cursor -> b) -> Axis
check ([Cursor] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Cursor] -> Bool) -> Axis -> Cursor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> Axis
toAxis Selector
s)

-- | Directly apply a 'Selector' to a 'Cursor', removing duplicates. Cursors
-- are considered duplicate iff their focus node /and/ ancestory are the same.
--
-- Due to the knot-tying of the 'Cursor' type, this is not perfect: we are not
-- considering the focus node's position within its parent, so any two nodes
-- that are exactly identical themselves and share ancestory will be considered
-- equal. E.g., in the following XML document:
--
-- > <root>
-- >   <parent>
-- >      <child>Foo</child>
-- >      <child>Foo</child>
-- >   </parent>
-- > </root>
--
-- ...the two @\<child/\>@ nodes will be considered equal, even though they are
-- two distinct nodes in the DOM.
--
-- Unlike 'toAxis', the 'match' function prepends an implicit
-- self-or-descendant 'Axis' to the selector in order to mimic the behavior of
-- actual CSS selectors.
match :: Selector -> Cursor -> [Cursor]
match :: Selector -> Axis
match Selector
selector Cursor
root =
  [Cursor] -> [Cursor]
removeDoubles ([Cursor] -> [Cursor]) -> Axis -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Axis -> Axis
forall node. Axis node -> Axis node
orSelf Axis
forall node. Axis node
descendant Axis -> Axis -> Axis
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Selector -> Axis
toAxis Selector
selector) Axis -> Axis
forall a b. (a -> b) -> a -> b
$ Cursor
root

checkAttrib :: AttribSelector -> Axis
checkAttrib :: AttribSelector -> Axis
checkAttrib AttribSelector
asel = (Element -> Bool) -> Axis
forall b. Boolean b => (Element -> b) -> Axis
checkElement (AttribSelector -> Map Name Text -> Bool
checkElementAttribs AttribSelector
asel (Map Name Text -> Bool)
-> (Element -> Map Name Text) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Map Name Text
elementAttributes)

checkElementAttribs :: AttribSelector -> Map Name Text -> Bool
-- @[attr]@
checkElementAttribs :: AttribSelector -> Map Name Text -> Bool
checkElementAttribs (AttribExists Name
n) Map Name Text
attrs =
  Name -> Map Name Text -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Name
n Map Name Text
attrs
-- @[attr=blah]@
checkElementAttribs (AttribIs Name
n Text
v) Map Name Text
attrs =
  Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Text
attrs Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v
-- @[attr!=blah]@
checkElementAttribs (AttribIsNot Name
n Text
v) Map Name Text
attrs =
  Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Text
attrs Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v
-- @[attr^=blah]@
checkElementAttribs (AttribStartsWith Name
n Text
v) Map Name Text
attrs =
  case Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Text
attrs of
    Just Text
t -> Text
v Text -> Text -> Bool
`Text.isPrefixOf` Text
t
    Maybe Text
Nothing -> Bool
False
-- @[attr$=blah]@
checkElementAttribs (AttribEndsWith Name
n Text
v) Map Name Text
attrs =
  case Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Text
attrs of
    Just Text
t -> Text
v Text -> Text -> Bool
`Text.isSuffixOf` Text
t
    Maybe Text
Nothing -> Bool
False
-- @[attr*=blah]@
checkElementAttribs (AttribContains Name
n Text
v) Map Name Text
attrs =
  case Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Text
attrs of
    Just Text
t -> Text
v Text -> Text -> Bool
`Text.isInfixOf` Text
t
    Maybe Text
Nothing -> Bool
False
-- @[attr~=blah]@
checkElementAttribs (AttribContainsWord Name
n Text
v) Map Name Text
attrs =
  case Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Text
attrs of
    Just Text
t -> Text
v Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Text -> [Text]
Text.words Text
t
    Maybe Text
Nothing -> Bool
False
-- @[attr|=blah]@
checkElementAttribs (AttribContainsPrefix Name
n Text
v) Map Name Text
attrs =
  case Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Text
attrs of
    Just Text
t -> Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
v Bool -> Bool -> Bool
|| (Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-") Text -> Text -> Bool
`Text.isPrefixOf` Text
t
    Maybe Text
Nothing -> Bool
False

removeDoubles :: [Cursor] -> [Cursor]
removeDoubles :: [Cursor] -> [Cursor]
removeDoubles = (Cursor -> Cursor -> Bool) -> [Cursor] -> [Cursor]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy Cursor -> Cursor -> Bool
isSameCursor

isSameCursor :: Cursor -> Cursor -> Bool
isSameCursor :: Cursor -> Cursor -> Bool
isSameCursor Cursor
a Cursor
b = Cursor -> [Node]
cursorPath Cursor
a [Node] -> [Node] -> Bool
forall a. Eq a => a -> a -> Bool
== Cursor -> [Node]
cursorPath Cursor
b

cursorPath :: Cursor -> [Node]
cursorPath :: Cursor -> [Node]
cursorPath Cursor
c =
  Cursor -> Node
forall node. Cursor node -> node
node Cursor
c Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: (Cursor -> Node) -> [Cursor] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Cursor -> Node
forall node. Cursor node -> node
node (Axis
forall node. Axis node
ancestor Cursor
c)