blob: 518c4d99c958922790f71767ec1b78f3b108b256 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
module TreeSearch where
import Data.Tree.Zipper
findTree :: (a -> Bool) -> TreePos Full a -> Maybe (TreePos Full a)
findTree p loc = if p (label loc)
then Just loc
else depthFirst loc >>= findTree p
depthFirst :: TreePos Full a -> Maybe (TreePos Full a)
depthFirst loc = case firstChild loc of
Just x -> Just x
Nothing -> case next loc of
Just x -> Just x
Nothing -> parentWithNext loc
where
parentWithNext x =
case parent x of
Nothing -> Nothing
Just x' -> case next x' of
Just x'' -> Just x''
Nothing -> parentWithNext x'
findNext :: TreePos Full a -> Maybe (TreePos Full a)
findNext = depthFirst
findPrev :: TreePos Full a -> Maybe (TreePos Full a)
findPrev loc =
case prev loc of
Just x -> trans_lastChild x
Nothing -> parent loc
where
trans_lastChild x =
case lastChild x of
Nothing -> Just x
Just x' -> trans_lastChild x'
findNextN :: Eq a => Int -> TreePos Full a -> TreePos Full a
findNextN n loc
| n <= 0 = loc
| otherwise =
maybe loc (findNextN $ n - 1) (skipSame findNext loc)
findPrevN :: Eq a => Int -> TreePos Full a -> TreePos Full a
findPrevN n loc
| n <= 0 = loc
| otherwise =
maybe loc (findPrevN $ n - 1) (skipSame findPrev loc)
findParent :: (a -> Bool) -> TreePos Full a -> Maybe (TreePos Full a)
findParent p loc =
if p (label loc)
then Just loc
else parent loc >>= findParent p
linearPos :: TreePos Full a -> Int
linearPos =
rec 0
where
rec i loc = case findPrev loc of
Just loc' -> rec (i + 1) loc'
Nothing -> i
skipSame
:: Eq a =>
(TreePos Full a -> Maybe (TreePos Full a)) ->
TreePos Full a ->
Maybe (TreePos Full a)
skipSame next' loc =
case next' loc of
Nothing -> Nothing
Just loc' ->
if label loc' == label loc
then skipSame next' loc'
else Just loc'
|
