{-#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 Any = (:[]) toAxis None = const [] toAxis (Append a b) = toAxis a >=> toAxis b -- @div@ toAxis (Elem name) = element name -- @a[...]@ toAxis (Attrib p) = checkAttrib p -- @a b@ toAxis Descendant = descendant -- @a>b@ toAxis Child = child -- @a~b@ toAxis Sibling = followingSibling -- @a+b@ toAxis NextSibling = take 1 . followingSibling -- @:first-child@ toAxis FirstChild = check (null . precedingSibling) -- @:last-child@ toAxis LastChild = check (null . followingSibling) -- @:nth-child(n)@; @:nth-last-child(-n)@ toAxis (NthChild i) | i > 0 = check ((== i - 1) . length . precedingSibling) | i < 0 = check ((== (-i) - 1) . length . followingSibling) | otherwise = error ":nth-child(0)" -- @a,b,...@ toAxis (Choice xs) = \c -> concatMap (\x -> toAxis x c) xs -- @a:has(b)@ toAxis (Having s) = check (descendant >=> toAxis s) -- @a:not(b)@ toAxis (Not s) = check (null . toAxis 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: -- -- > -- > -- > Foo -- > Foo -- > -- > -- -- ...the two @\@ 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 root = removeDoubles . (orSelf descendant >=> toAxis selector) $ root checkAttrib :: AttribSelector -> Axis checkAttrib asel = checkElement (checkElementAttribs asel . elementAttributes) checkElementAttribs :: AttribSelector -> Map Name Text -> Bool -- @[attr]@ checkElementAttribs (AttribExists n) attrs = Map.member n attrs -- @[attr=blah]@ checkElementAttribs (AttribIs n v) attrs = Map.lookup n attrs == Just v -- @[attr!=blah]@ checkElementAttribs (AttribIsNot n v) attrs = Map.lookup n attrs /= Just v -- @[attr^=blah]@ checkElementAttribs (AttribStartsWith n v) attrs = case Map.lookup n attrs of Just t -> v `Text.isPrefixOf` t Nothing -> False -- @[attr$=blah]@ checkElementAttribs (AttribEndsWith n v) attrs = case Map.lookup n attrs of Just t -> v `Text.isSuffixOf` t Nothing -> False -- @[attr*=blah]@ checkElementAttribs (AttribContains n v) attrs = case Map.lookup n attrs of Just t -> v `Text.isInfixOf` t Nothing -> False -- @[attr~=blah]@ checkElementAttribs (AttribContainsWord n v) attrs = case Map.lookup n attrs of Just t -> v `elem` Text.words t Nothing -> False -- @[attr|=blah]@ checkElementAttribs (AttribContainsPrefix n v) attrs = case Map.lookup n attrs of Just t -> t == v || (v <> "-") `Text.isPrefixOf` t Nothing -> False removeDoubles :: [Cursor] -> [Cursor] removeDoubles = nubBy isSameCursor isSameCursor :: Cursor -> Cursor -> Bool isSameCursor a b = cursorPath a == cursorPath b cursorPath :: Cursor -> [Node] cursorPath c = node c : map node (ancestor c)