From 8e92e6e11d2b3b0bfb5ac9d68f347219493e6380 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kier=C3=A1n=20Meinhardt?= Date: Wed, 23 Sep 2020 17:44:40 +0200 Subject: split into library + executables --- src/Much/TreeZipperUtils.hs | 52 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 src/Much/TreeZipperUtils.hs (limited to 'src/Much/TreeZipperUtils.hs') diff --git a/src/Much/TreeZipperUtils.hs b/src/Much/TreeZipperUtils.hs new file mode 100644 index 0000000..5257c2f --- /dev/null +++ b/src/Much/TreeZipperUtils.hs @@ -0,0 +1,52 @@ +module Much.TreeZipperUtils where + +import Data.Maybe +import Data.Tree +import Data.Tree.Zipper + +-- Return loc (as parent-like structure) and parents. +path :: TreePos Full a -> [(Forest a, a, Forest a)] +path loc = toParent loc : parents loc + +-- Return parent stack compatible form of loc. +toParent :: TreePos Full a -> (Forest a, a, Forest a) +toParent loc = (before loc, label loc, after loc) + + +modifyFirstParentLabelWhere + :: (a -> Bool) + -> (a -> a) + -> TreePos Full a + -> TreePos Full a +modifyFirstParentLabelWhere p f loc0 = + case parent loc0 of + Nothing -> loc0 + Just loc0' -> go (byChildIndex loc0) loc0' + where + + go rewind loc = + if p (label loc) + then + rewind (modifyLabel f loc) + else + case parent loc of + Nothing -> rewind loc + Just loc' -> + go (rewind . byChildIndex loc) loc' + + -- generator for a rewind step + byChildIndex :: TreePos Full a -> (TreePos Full a -> TreePos Full a) + byChildIndex loc = + -- The use of fromJust is safe here because we're only modifying + -- labels and not the tree structure and thus the index is valid. + fromJust . childAt (childIndex loc) + + +-- XXX This could be named more general, like countPrevSiblings? +-- XXX Can we kill the recursion? +childIndex :: TreePos Full a -> Int +childIndex = + go 0 + where + go index = + maybe index (go $ index + 1) . prev -- cgit v1.2.3