{-#LANGUAGE OverloadedStrings #-}
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)

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)

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

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

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)