diff options
| author | aarne <unknown> | 2005-06-11 19:27:05 +0000 |
|---|---|---|
| committer | aarne <unknown> | 2005-06-11 19:27:05 +0000 |
| commit | e2cc1184d40f1c4996143f205da8a9c23d2a87d4 (patch) | |
| tree | 4c48475e0852ac70cbb4e542606f8d327afc66b7 /src/GF/Data | |
| parent | 6a66fc5d71747c1009590e68887a9bbd6f44e598 (diff) | |
undo k and keep position in editor
Diffstat (limited to 'src/GF/Data')
| -rw-r--r-- | src/GF/Data/Zipper.hs | 20 |
1 files changed, 17 insertions, 3 deletions
diff --git a/src/GF/Data/Zipper.hs b/src/GF/Data/Zipper.hs index 66859f9ca..a4491f76e 100644 --- a/src/GF/Data/Zipper.hs +++ b/src/GF/Data/Zipper.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/21 16:22:11 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.8 $ +-- > CVS $Date: 2005/06/11 20:27:05 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.9 $ -- -- Gérard Huet's zipper (JFP 7 (1997)). AR 10\/8\/2001 ----------------------------------------------------------------------------- @@ -35,6 +35,8 @@ module GF.Data.Zipper (-- * types goRoot, goLast, goPosition, + getPosition, + keepPosition, -- * added some utilities traverseCollect, scanTree, @@ -160,6 +162,18 @@ goPosition p = go p . goRoot where go [] s = return s go (p:ps) s = goDown s >>= apply p goRight >>= go ps +getPosition :: Loc a -> [Int] +getPosition = reverse . getp where + getp (Loc (t,p)) = case p of + Top -> [] + Node (left,(p',v),_) -> length left : getp (Loc (Tr (v, []),p')) + +keepPosition :: (Loc a -> Err (Loc a)) -> (Loc a -> Err (Loc a)) +keepPosition f s = do + let p = getPosition s + s' <- f s + goPosition p s' + apply :: Monad m => Int -> (a -> m a) -> a -> m a apply n f a = case n of 0 -> return a |