Clean up tree walking code

This commit is contained in:
Joscha 2020-02-09 16:00:29 +00:00
parent 51a63b9d5b
commit ee1346143d

View file

@ -89,6 +89,11 @@ getCurrent :: Tree -> Node
-- We rely on the invariant that the focused node always exists -- We rely on the invariant that the focused node always exists
getCurrent tree = fromJust $ applyPath (treeFocused tree) (treeNode tree) getCurrent tree = fromJust $ applyPath (treeFocused tree) (treeNode tree)
-- Warning: 'firstSibling' and 'lastSibling' do their job in a similar, but
-- slightly different way. This can be seen in the return types: 'firstSibling'
-- never returns the original node, 'lastSibling' does if it doesn't have any
-- children.
firstSibling :: Node -> Maybe Path firstSibling :: Node -> Maybe Path
firstSibling node = case mapChildren (,) node of firstSibling node = case mapChildren (,) node of
((nid,_):_) -> Just $ Path [nid] ((nid,_):_) -> Just $ Path [nid]
@ -110,22 +115,20 @@ surroundingSiblings node middle = do
-- | Attempt to find the path of the node that is above the input path. -- | Attempt to find the path of the node that is above the input path.
findPrevNode :: Node -> Path -> Maybe Path findPrevNode :: Node -> Path -> Maybe Path
findPrevNode _ (Path []) = Nothing findPrevNode _ (Path []) = Nothing
findPrevNode node (Path [x]) = do findPrevNode node (Path (x:xs)) = do
(maybePrev, _, _) <- surroundingSiblings node x (maybePrev, childNode, _) <- surroundingSiblings node x
case maybePrev of case findPrevNode childNode (Path xs) of
Just path -> pure $ Path [x] <> path
Nothing -> case maybePrev of
Nothing -> pure mempty Nothing -> pure mempty
Just (prevId, prev) -> pure $ Path [prevId] <> lastSibling prev Just (prevId, prev) -> pure $ Path [prevId] <> lastSibling prev
findPrevNode node (Path (x:xs)) = do
childNode <- applyId x node
prevPath <- findPrevNode childNode $ Path xs
pure $ Path [x] <> prevPath
-- | Attempt to find the path of the node that is below the input path. -- | Attempt to find the path of the node that is below the input path.
findNextNode :: Node -> Path -> Maybe Path findNextNode :: Node -> Path -> Maybe Path
findNextNode node (Path []) = firstSibling node findNextNode node (Path []) = firstSibling node
findNextNode node (Path (x:xs)) = do findNextNode node (Path (x:xs)) = do
(_, childNode, maybeNext) <- surroundingSiblings node x (_, childNode, maybeNext) <- surroundingSiblings node x
case findNextNode childNode $ Path xs of case findNextNode childNode (Path xs) of
Just path -> pure $ Path [x] <> path Just path -> pure $ Path [x] <> path
Nothing -> do Nothing -> do
(nextId, _) <- maybeNext (nextId, _) <- maybeNext
@ -176,12 +179,5 @@ applyFolds unfolded node
foldedChildren = Map.fromList $ mapChildren applyFoldsToChild node foldedChildren = Map.fromList $ mapChildren applyFoldsToChild node
applyFoldsToChild nid n = (nid, applyFolds (narrowSet nid unfolded) n) applyFoldsToChild nid n = (nid, applyFolds (narrowSet nid unfolded) n)
-- | Apply folds to a whole 'Tree' (see 'applyFolds').
withFolds :: Tree -> Tree
withFolds tree = newTree
(applyFolds (treeUnfolded tree) (treeNode tree))
(treeFocused tree)
(treeUnfolded tree)
exampleTree :: Tree exampleTree :: Tree
exampleTree = newTree exampleNode (Path ["hammer"]) Set.empty exampleTree = newTree exampleNode (Path ["hammer"]) Set.empty