{-#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 =
  (forall a. a -> [a] -> [a]
:[])
toAxis Selector
None =
  forall a b. a -> b -> a
const []
toAxis (Append Selector
a Selector
b) =
  Selector -> Axis
toAxis Selector
a 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 =
  forall node. Axis node
descendant
-- @a>b@
toAxis Selector
Child =
  forall node. Axis node
child
-- @a~b@
toAxis Selector
Sibling =
  forall node. Axis node
followingSibling
-- @a+b@
toAxis Selector
NextSibling =
  forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node. Axis node
followingSibling
-- @:first-child@
toAxis Selector
FirstChild =
  forall b. Boolean b => (Cursor -> b) -> Axis
check (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node. Axis node
precedingSibling)
-- @:last-child@
toAxis Selector
LastChild =
  forall b. Boolean b => (Cursor -> b) -> Axis
check (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node. Axis node
followingSibling)
-- @:nth-child(n)@; @:nth-last-child(-n)@
toAxis (NthChild Int
i)
  | Int
i forall a. Ord a => a -> a -> Bool
> Int
0 = forall b. Boolean b => (Cursor -> b) -> Axis
check ((forall a. Eq a => a -> a -> Bool
== Int
i forall a. Num a => a -> a -> a
- Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node. Axis node
precedingSibling)
  | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = forall b. Boolean b => (Cursor -> b) -> Axis
check ((forall a. Eq a => a -> a -> Bool
== (-Int
i) forall a. Num a => a -> a -> a
- Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node. Axis node
followingSibling)
  | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
":nth-child(0)"
-- @a,b,...@
toAxis (Choice [Selector]
xs) =
  \Cursor
c -> 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) =
  forall b. Boolean b => (Cursor -> b) -> Axis
check (forall node. Axis node
descendant 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) =
  forall b. Boolean b => (Cursor -> b) -> Axis
check (forall (t :: * -> *) a. Foldable t => t a -> Bool
null 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall node. Axis node -> Axis node
orSelf forall node. Axis node
descendant forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Selector -> Axis
toAxis Selector
selector) forall a b. (a -> b) -> a -> b
$ Cursor
root

checkAttrib :: AttribSelector -> Axis
checkAttrib :: AttribSelector -> Axis
checkAttrib AttribSelector
asel = forall b. Boolean b => (Element -> b) -> Axis
checkElement (AttribSelector -> Map Name Text -> Bool
checkElementAttribs AttribSelector
asel 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 =
  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 =
  forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Text
attrs forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
v
-- @[attr!=blah]@
checkElementAttribs (AttribIsNot Name
n Text
v) Map Name Text
attrs =
  forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Text
attrs forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Text
v
-- @[attr^=blah]@
checkElementAttribs (AttribStartsWith Name
n Text
v) Map Name Text
attrs =
  case 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 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 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 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 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 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 forall a. Eq a => a -> a -> Bool
== Text
v Bool -> Bool -> Bool
|| (Text
v 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 = 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 forall a. Eq a => a -> a -> Bool
== Cursor -> [Node]
cursorPath Cursor
b

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