diff --git a/xml-conduit/Text/XML/Cursor/Generic.hs b/xml-conduit/Text/XML/Cursor/Generic.hs index af442db5..aaa91b30 100644 --- a/xml-conduit/Text/XML/Cursor/Generic.hs +++ b/xml-conduit/Text/XML/Cursor/Generic.hs @@ -31,35 +31,67 @@ import Data.Maybe (maybeToList) import Data.List (foldl') import Control.Monad ((>=>)) -type DiffCursor node = [Cursor node] -> [Cursor node] +type DiffCursor node = [RecursiveCursor node] -> [RecursiveCursor node] type Axis node = Cursor node -> [Cursor node] --- | A cursor: contains an XML 'Node' and pointers to its children, ancestors and siblings. -data Cursor node = Cursor - { parent' :: Maybe (Cursor node) - , precedingSibling' :: DiffCursor node - , followingSibling' :: DiffCursor node +data RecursiveCursor node = RecursiveCursor + { _parent' :: Maybe (RecursiveCursor node) + , _precedingSibling' :: DiffCursor node + , _followingSibling' :: DiffCursor node -- | The child axis. XPath: -- /the child axis contains the children of the context node/. - , child :: [Cursor node] + , _child' :: [RecursiveCursor node] -- | The current node. - , node :: node + , _node' :: node } +-- | A cursor: contains an XML 'Node' and pointers to its children, ancestors and siblings. +data Cursor node = Cursor + { _parent :: Maybe (Cursor node) + , _preceding :: [Cursor node] + , _following :: [Cursor node] + , _children :: [Cursor node] + , _node :: node + } deriving (Eq, Ord) + +eval :: RecursiveCursor node -> Cursor node +eval cursor = Cursor + { _parent = eval <$> _parent' cursor + , _preceding = eval <$> _precedingSibling' cursor [] + , _following = eval <$> _followingSibling' cursor [] + , _children = eval <$> _child' cursor + , _node = _node' cursor + } + +child :: Axis node +child = _children + +node :: Cursor node -> node +node = _node + +instance Show node => Show (RecursiveCursor node) where + show RecursiveCursor { _node' = n } = "RecursiveCursor @ " ++ show n + instance Show node => Show (Cursor node) where - show Cursor { node = n } = "Cursor @ " ++ show n + show Cursor { _node = n } = "Cursor @ " ++ show n -toCursor :: (node -> [node]) -- ^ get children - -> node - -> Cursor node -toCursor cs = toCursor' cs Nothing id id +-- | Cursor smart constructor. This is where we launch the more convoluted +-- Recursive Cursor smart constructor from. +toCursor :: (node -> [node]) -> node -> Cursor node +toCursor getChildren = eval . toCursor' getChildren Nothing id id +-- | Recursive Cursor smart constructor. This is where we are building the expressions for +-- predecessors and followers. toCursor' :: (node -> [node]) - -> Maybe (Cursor node) -> DiffCursor node -> DiffCursor node -> node -> Cursor node + -> Maybe (RecursiveCursor node) + -> DiffCursor node + -> DiffCursor node + -> node + -> RecursiveCursor node toCursor' cs par pre fol n = me where - me = Cursor par pre fol chi n + me = RecursiveCursor par pre fol chi n chi' = cs n chi = go id chi' [] go _ [] = id @@ -75,23 +107,23 @@ toCursor' cs par pre fol n = -- Every node but the root element of the document has a parent. Parent nodes -- will always be 'NodeElement's. parent :: Axis node -parent = maybeToList . parent' +parent = maybeToList . _parent -- | The preceding-sibling axis. XPath: -- /the preceding-sibling axis contains all the preceding siblings of the context node [...]/. precedingSibling :: Axis node -precedingSibling = ($ []) . precedingSibling' +precedingSibling = _preceding -- | The following-sibling axis. XPath: -- /the following-sibling axis contains all the following siblings of the context node [...]/. followingSibling :: Axis node -followingSibling = ($ []) . followingSibling' +followingSibling = _following -- | The preceding axis. XPath: -- /the preceding axis contains all nodes in the same document as the context node that are before the context node in document order, excluding any ancestors and excluding attribute nodes and namespace nodes/. preceding :: Axis node preceding c = - go (precedingSibling' c []) (parent c >>= preceding) + go (_preceding c) (parent c >>= preceding) where go x y = foldl' (flip go') y x go' x rest = foldl' (flip go') (x : rest) (child x) @@ -100,9 +132,9 @@ preceding c = -- /the following axis contains all nodes in the same document as the context node that are after the context node in document order, excluding any descendants and excluding attribute nodes and namespace nodes/. following :: Axis node following c = - go (followingSibling' c) (parent c >>= following) + go (_following c) (parent c >>= following) where - go x z = foldr go' z (x []) + go x z = foldr go' z x go' x rest = x : foldr go' rest (child x) -- | The ancestor axis. XPath: