summaryrefslogtreecommitdiffstats
path: root/TreeSearch.hs
blob: 0a5df28dc3030bb2003a861c4a9f729fdf62ff33 (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
88
89
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 -> case parent loc of
            Just x -> Just x
            Nothing -> Nothing
  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'