From 49f6288350a722837a316f86d1442c59d7ea8fc8 Mon Sep 17 00:00:00 2001
From: aarne <unknown>
Date: Thu, 25 Sep 2003 11:42:20 +0000
Subject: The new tree position annotation, and the corresponding command.

---
 src/GF/Data/Zipper.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

(limited to 'src/GF/Data')

diff --git a/src/GF/Data/Zipper.hs b/src/GF/Data/Zipper.hs
index d498c5a56..a696f1cae 100644
--- a/src/GF/Data/Zipper.hs
+++ b/src/GF/Data/Zipper.hs
@@ -100,6 +100,16 @@ goLast :: Loc a -> Err (Loc a)
 goLast = rep goAhead where
   rep f s = err (const (return s)) (rep f) (f s)
 
+goPosition :: [Int] -> Loc a -> Err (Loc a)
+goPosition p = go p . goRoot where
+  go []     s = return s
+  go (p:ps) s = goDown s >>= apply p goRight >>= go ps
+
+apply :: Monad m => Int -> (a -> m a) -> a -> m a
+apply n f a = case n of
+  0 -> return a
+  _ -> f a >>= apply (n-1) f
+
 -- added some utilities
 
 traverseCollect :: Path a -> [a]
-- 
cgit v1.2.3