fixplate 0.1 → 0.1.1

raw patch · 10 files changed

+381/−171 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/Generics/Fixplate.hs +3/−4
• Data/Generics/Fixplate/Attributes.hs +40/−10
• Data/Generics/Fixplate/Base.hs +1/−1
• Data/Generics/Fixplate/Misc.hs +7/−5
• Data/Generics/Fixplate/Morphisms.hs +2/−1
• Data/Generics/Fixplate/Open.hs +78/−0
• Data/Generics/Fixplate/Structure.hs +53/−47
• Data/Generics/Fixplate/Traversals.hs +21/−25
• Data/Generics/Fixplate/Zipper.hs +107/−17
• fixplate.cabal +69/−61

@@ -44,10 +44,10 @@ -- 
 -- This module re-exports all the functionality present in the library.
 --
--- The library is fully Haskell98 compatible, with the exception
+-- The library should be fully Haskell98 compatible, with the exception
 -- of the module "Data.Generics.Fixplate.Structure", which needs
--- the @Rank2Types@ extension. For compatibility, this functionality
--- of this module is at the moment only provided when compiled with GHC.
+-- the @Rank2Types@ extension. For compatibility, the functionality
+-- of this module is at the moment only provided when compiled with GHC or Hugs.
 --
 module Data.Generics.Fixplate 
   ( module Data.Generics.Fixplate.Base
@@ -73,4 +73,3 @@ import Data.Traversable
 
 --------------------------------------------------------------------------------
-

@@ -1,18 +1,21 @@ 
--- | Synthetising attributes, motivated by Attribute Grammars.
+-- | Synthetising attributes, partly motivated by Attribute Grammars.
 
 {-# LANGUAGE CPP #-}
 module Data.Generics.Fixplate.Attributes
-  ( toList
-  , Attrib(..)
+  ( Attrib(..)
+  , annMap
   -- * Synthetised attributes
   , synthetise , synthetise' , synthetiseList , synthetiseM
   -- * Inherited attributes
   , inherit , inherit'
   -- * Traversals
-  , synthAccumL  , synthAccumR
-  , synthAccumL_ , synthAccumR_
-  , numberNodes  , numberNodes_
+  , synthAccumL    , synthAccumR
+  , synthAccumL_   , synthAccumR_
+  , enumerateNodes , enumerateNodes_
+  -- * Stacking attributes
+  , annZip  , annZipWith
+  , annZip3 , annZipWith3  
 #ifdef WITH_QUICKCHECK
   -- * Tests
   , runtests_Attributes  
@@ -39,6 +42,14 @@ #endif 
 
 --------------------------------------------------------------------------------
+
+-- | Map over annotations 
+-- 
+-- > annMap f = unAttrib . fmap f . Attrib
+annMap :: Functor f => (a -> b) -> Attr f a -> Attr f b
+annMap h = unAttrib . fmap h . Attrib
+
+--------------------------------------------------------------------------------
 -- Synthetised attributes
 
 -- | /Synthetised/ attributes are created in a bottom-up manner. 
@@ -123,11 +134,30 @@ -- a left-to-right traversal fashion, where
 -- @n == length (universe tree)@ is the number of substructures,
 -- which is also returned.
-numberNodes :: Traversable f => Mu f -> (Int, Attr f Int)
-numberNodes tree = synthAccumL (\i _ -> (i+1,i)) 0 tree
+enumerateNodes :: Traversable f => Mu f -> (Int, Attr f Int)
+enumerateNodes tree = synthAccumL (\i _ -> (i+1,i)) 0 tree
 
-numberNodes_ :: Traversable f => Mu f -> Attr f Int
-numberNodes_ = snd . numberNodes
+enumerateNodes_ :: Traversable f => Mu f -> Attr f Int
+enumerateNodes_ = snd . enumerateNodes
+
+--------------------------------------------------------------------------------
+-- Stacking attributes
+
+-- | Merges two layers of annotations into a single one.
+annZip :: Functor f => Mu (Ann (Ann f a) b) -> Attr f (a,b)
+annZip (Fix (Ann y (Ann x t))) = Fix (Ann (x,y) (fmap annZip t))
+
+annZipWith :: Functor f => (a -> b -> c) -> Mu (Ann (Ann f a) b) -> Attr f c
+annZipWith h = go where 
+  go (Fix (Ann y (Ann x t))) = Fix (Ann (h x y) (fmap go t))
+
+-- | Merges three layers of annotations into a single one.
+annZip3 :: Functor f => Mu (Ann (Ann (Ann f a) b) c) -> Attr f (a,b,c)
+annZip3 (Fix (Ann z (Ann y (Ann x t)))) = Fix (Ann (x,y,z) (fmap annZip3 t))
+
+annZipWith3 :: Functor f => (a -> b -> c -> d) -> Mu (Ann (Ann (Ann f a) b) c) -> Attr f d
+annZipWith3 h = go where 
+  go (Fix (Ann z (Ann y (Ann x t)))) = Fix (Ann (h x y z) (fmap go t))
 
 --------------------------------------------------------------------------------
 -- Tests

@@ -41,7 +41,7 @@ --------------------------------------------------------------------------------
 
 -- | \"Functorised\" versions of standard type classes. 
--- If you have your own structure functor, for example
+-- If you have your a structure functor, for example
 --
 -- > Expr e 
 -- >   = Kst Int 

@@ -7,16 +7,18 @@ import Data.Traversable
 
 --------------------------------------------------------------------------------
-
-mapAccumL_ :: Traversable f => (a -> b -> (a, c)) -> a -> f b -> f c
-mapAccumL_ f x t = snd (mapAccumL f x t)
-
---------------------------------------------------------------------------------
         
 data Two a b 
   =  Empty 
   |  One a
   |  Two b
+  deriving Show
+  
+data Both a b 
+  =  None
+  |  First a
+  |  Both  a b
+  deriving Show
 
 --------------------------------------------------------------------------------
 

@@ -39,7 +39,8 @@ -- | An /anamorphism/ is simply an unfold.
 ana :: Functor f => (a -> f a) -> a -> Mu f
 ana h = go where
-  go x = Fix (fmap go (h x))
+  go = Fix . fmap go . h
+  -- go x = Fix (fmap go (h x))
 
 -- | A /hylomorphism/ is the composition of a catamorphism and an anamorphism.
 hylo :: Functor f => (f a -> a) -> (b -> f b) -> (b -> a) 

@@ -0,0 +1,78 @@+
+-- | \"Open\" functions, working on functors instead of trees.
+
+{-# LANGUAGE CPP #-}
+module Data.Generics.Fixplate.Open 
+  ( 
+    toList
+  -- * Accumulating maps
+  , mapAccumL  , mapAccumR
+  , mapAccumL_ , mapAccumR_
+  -- * Open functions
+  , holes , holesList
+  , apply , builder
+  -- * Enumerations
+  , enumerate
+  , enumerateWith
+  , enumerateWith_
+  )
+where
+
+--------------------------------------------------------------------------------
+
+import Control.Monad (liftM)
+import Data.Foldable
+import Data.Traversable ( Traversable(..) , mapAccumL , mapAccumR )
+import Prelude hiding (foldl,foldr,mapM,mapM_,concat,concatMap)
+
+import Data.Generics.Fixplate.Base 
+import Data.Generics.Fixplate.Misc
+
+--------------------------------------------------------------------------------
+-- Accumulating maps
+
+mapAccumL_ :: Traversable f => (a -> b -> (a, c)) -> a -> f b -> f c
+mapAccumL_ f x t = snd (mapAccumL f x t)
+
+mapAccumR_ :: Traversable f => (a -> b -> (a, c)) -> a -> f b -> f c
+mapAccumR_ f x t = snd (mapAccumR f x t)
+
+--------------------------------------------------------------------------------
+-- Open functions
+
+-- | The children together with functions replacing that particular child.    
+holes :: Traversable f => f a -> f (a, a -> f a)
+holes tree = mapAccumL_ ithHole 0 tree where
+  ithHole i x = (i+1, (x,h)) where          
+    h y = mapAccumL_ g 0 tree where         
+      g j z = (j+1, if i==j then y else z)  
+
+holesList :: Traversable f => f a -> [(a, a -> f a)]
+holesList = toList . holes
+
+-- | Apply the given function to each child in turn.
+apply :: Traversable f => (a -> a) -> f a -> f (f a)
+apply f tree = fmap g (holes tree) where
+  g (x,replace) = replace (f x)
+
+-- | Builds up a structure from a list of the children.
+builder :: Traversable f => f a -> [b] -> f b
+builder tree xs = mapAccumL_ g xs tree where
+  g (x:xs) _ = (xs,x)
+
+--------------------------------------------------------------------------------
+-- Enumerations
+
+-- | Enumerates children from the left to the right, starting with zero.
+-- Also returns the number of children. This is just a simple application
+-- of @mapAccumL@.
+enumerate :: Traversable f => f a -> (Int, f (Int, a))
+enumerate = mapAccumL (\i x -> (i+1,(i,x))) 0
+
+enumerateWith :: Traversable f => (Int -> a -> b) -> f a -> (Int, f b)
+enumerateWith h = mapAccumL (\i x -> (i+1, h i x)) 0
+
+enumerateWith_ :: Traversable f => (Int -> a -> b) -> f a -> f b
+enumerateWith_ h = snd . enumerateWith h
+  
+--------------------------------------------------------------------------------

@@ -1,47 +1,53 @@-
-{-# LANGUAGE CPP #-}
-#ifdef __GLASGOW_HASKELL__
-{-# LANGUAGE Rank2Types #-}
-#endif
-
--- | Changing the structure of a tree.
-module Data.Generics.Fixplate.Structure 
-  ( NatTrafo
-  , restructure
-  , liftAnn
-  )
-  where
---------------------------------------------------------------------------------
-
-import Data.Generics.Fixplate.Base
-
---------------------------------------------------------------------------------
-
-#ifdef __GLASGOW_HASKELL__
-
--- | The type of natural transformations.
-type NatTrafo f g = forall a. (f a -> g a)
-
--- | Changing the structure of a tree.
-restructure :: Functor f => NatTrafo f g -> Mu f -> Mu g
-restructure trafo = go where
-  go = Fix . trafo . fmap go . unFix
-
-#else  
-
-data NatTrafo f g = NatTrafo (f Int) (g Int)   -- fake and opaque data type
-
--- | Unfortunately, this function requires Rank2Types,
--- thus we only provide it for GHC.
-restructure :: Functor f => NatTrafo f g -> Mu f -> Mu g
-restructure = error "restructure: this operation requires Rank2Types"
-
-#endif
-  
---------------------------------------------------------------------------------
-
--- | Lifting natural transformations to annotations.
-liftAnn :: (f e -> g e) -> Ann f a e -> Ann g a e
-liftAnn trafo (Ann a x) = Ann a (trafo x)
-
---------------------------------------------------------------------------------
++{-# LANGUAGE CPP, Rank2Types #-}++-- it seems that older GHCs do not like multiple LANGUAGE pragmas?+-- {- LANGUAGE CPP -}+-- ifdef __GLASGOW_HASKELL__+-- {- LANGUAGE Rank2Types -}+-- endif++-- | Changing the structure of a tree.+module Data.Generics.Fixplate.Structure +  ( NatTrafo+  , restructure+  , liftAnn+  )+  where+  +--------------------------------------------------------------------------------++import Data.Generics.Fixplate.Base++--------------------------------------------------------------------------------++-- #ifdef __GLASGOW_HASKELL__++-- | The type of natural transformations.+type NatTrafo f g = forall a. (f a -> g a)++-- | Changing the structure of a tree.+restructure :: Functor f => NatTrafo f g -> Mu f -> Mu g+restructure trafo = go where+  go = Fix . trafo . fmap go . unFix++-- #else  ++{-+data NatTrafo f g = NatTrafo (f Int) (g Int)   -- fake and opaque data type++-- | Unfortunately, this function requires Rank2Types,+-- thus we only provide it for GHC.+restructure :: Functor f => NatTrafo f g -> Mu f -> Mu g+restructure = error "restructure: this operation requires Rank2Types"+-}++-- #endif+  +--------------------------------------------------------------------------------++-- | Lifting natural transformations to annotations.+liftAnn :: (f e -> g e) -> Ann f a e -> Ann g a e+liftAnn trafo (Ann a x) = Ann a (trafo x)++--------------------------------------------------------------------------------

@@ -12,6 +12,7 @@ import Prelude hiding (foldl,foldr,mapM,mapM_,concat,concatMap)
 
 import Data.Generics.Fixplate.Base 
+import Data.Generics.Fixplate.Open
 import Data.Generics.Fixplate.Misc
 
 #ifdef WITH_QUICKCHECK
@@ -27,7 +28,11 @@ children = foldr (:) [] . unFix
 
 -- | The list of all substructures. Together with list-comprehension syntax
--- this is a powerful query tool.
+-- this is a powerful query tool. For example the following is how you get
+-- the list of all variable names in an expression:
+--
+-- > variables expr = [ s | Fix (Var s) <- universe expr ]
+--
 universe :: Foldable f => Mu f -> [Mu f]
 universe x = x : concatMap universe (children x)
 
@@ -92,10 +97,19 @@ --------------------------------------------------------------------------------
 -- * Folds
 
--- | Left fold. Since @Mu f@ is not a functor, but a type, we cannot make
+-- | (Strict) left fold. Since @Mu f@ is not a functor, but a data type, we cannot make
 -- it an instance of the @Foldable@ type class.
 foldLeft :: Foldable f => (a -> Mu f -> a) -> a -> Mu f -> a
+#ifdef __GLASGOW_HASKELL__
 foldLeft h x0 t = go x0 t where
+  go !x !t = foldl go (h x t) (unFix t)
+#else           
+foldLeft h x0 t = go x0 t where
+  go x t = x `seq` t `seq` foldl go (h x t) (unFix t)
+#endif
+
+foldLeftLazy :: Foldable f => (a -> Mu f -> a) -> a -> Mu f -> a
+foldLeftLazy h x0 t = go x0 t where
   go x t = foldl go (h x t) $ unFix t
 
 foldRight :: Foldable f => (Mu f -> a -> a) -> a -> Mu f -> a
@@ -103,29 +117,6 @@   go t x = h t $ foldr go x $ unFix t 
 
 --------------------------------------------------------------------------------
--- * Open functions
-
--- | The children together with functions replacing that particular child.    
-holes :: Traversable f => f a -> f (a, a -> f a)
-holes tree = mapAccumL_ ithHole 1 tree where
-  ithHole i x = (i+1, (x,h)) where          
-    h y = mapAccumL_ g 1 tree where         
-      g j z = (j+1, if i==j then y else z)  
-
-holesList :: Traversable f => f a -> [(a, a -> f a)]
-holesList = toList . holes
-
--- | Apply the given function to each child in turn.
-apply :: Traversable f => (a -> a) -> f a -> f (f a)
-apply f tree = fmap g (holes tree) where
-  g (x,replace) = replace (f x)
-
--- | Builds up a structure from a list of the children.
-builder :: Traversable f => f a -> [b] -> f b
-builder tree xs = mapAccumL_ g xs tree where
-  g (x:xs) _ = (xs,x)
-
---------------------------------------------------------------------------------
 #ifdef WITH_QUICKCHECK
 -- * Tests
 
@@ -134,6 +125,7 @@ 
 runtests_Traversals = do
   quickCheck prop_leftFold
+  quickCheck prop_leftFoldLazy
   quickCheck prop_rightFold
   quickCheck prop_universe1
   quickCheck prop_universe2
@@ -148,6 +140,10 @@ prop_leftFold tree = 
   foldLeft (\xs (Fix (TreeF l s)) -> (l:xs)) [] tree == foldl (flip (:)) [] (fromFixT tree)
 
+prop_leftFoldLazy :: FixT Label -> Bool
+prop_leftFoldLazy tree = 
+  foldLeftLazy (\xs (Fix (TreeF l s)) -> (l:xs)) [] tree == foldl (flip (:)) [] (fromFixT tree)
+  
 prop_rightFold :: FixT Label -> Bool
 prop_rightFold tree = 
   foldRight (\(Fix (TreeF l s)) xs -> (l:xs)) [] tree == foldr (:) [] (fromFixT tree)

@@ -1,10 +1,11 @@ 
 {-# LANGUAGE CPP #-}
-#ifdef WITH_QUICKCHECK
-{-# LANGUAGE TypeSynonymInstances #-}
-#endif
 
--- | The Zipper.
+-- | The Zipper is a data structure which maintains a location in 
+-- a tree, and allows O(1) movement and local changes
+-- (to be more precise, in our case it is O(k) where k is the number
+-- of children of the node at question; typically this is a very small number).
+--
 module Data.Generics.Fixplate.Zipper where
 
 --------------------------------------------------------------------------------
@@ -18,11 +19,12 @@ import Text.Read 
 
 import Data.Generics.Fixplate.Base
+import Data.Generics.Fixplate.Open
 import Data.Generics.Fixplate.Misc
+import Data.Generics.Fixplate.Traversals
 
 #ifdef WITH_QUICKCHECK
 import Test.QuickCheck
-import Data.Generics.Fixplate.Traversals
 import Data.Generics.Fixplate.Attributes
 import Data.Generics.Fixplate.Test.Tools
 import Control.Monad (liftM)
@@ -31,11 +33,15 @@ --------------------------------------------------------------------------------
 -- * Types
 
+-- | A context node. 
 type Node f  =  Either (Mu f) (Path f)
 
+-- | The context or path type. The invariant we must respect is that there is exactly
+-- one child with the 'Right' constructor.
 data Path f  =  Top
              |  Path { unPath :: f (Node f) } 
                
+-- | The zipper type itself, which encodes a locations in thre tree @Mu f@.
 data Loc f   =  Loc { focus :: Mu f , path :: Path f } 
 
 --------------------------------------------------------------------------------
@@ -118,6 +124,16 @@     h  old  (Left   y)  =  (old     , y)
     h  _    (Right  p)  =  (Just p  , t)
 
+-- | We attribute all nodes with a zipper focused at that location.
+locations :: Traversable f => Mu f -> Attr f (Loc f)
+locations tree = go (root tree) tree where
+  go loc (Fix t) = Fix (Ann loc t') where
+    t' = enumerateWith_ (\j x -> go (unsafeMoveDown j loc) x) t
+
+-- | The list of all locations.
+locationsList :: Traversable f => Mu f -> [Loc f]
+locationsList = toList . Attrib . locations
+    
 -- | The zipper version of 'forget'.
 locForget :: Functor f => Loc (Ann f a) -> Loc f    
 locForget (Loc foc path) = Loc (forget foc) (go path) where
@@ -132,19 +148,22 @@ --------------------------------------------------------------------------------
 -- * Manipulating the subtree at focus
 
+-- | Extracts the subtree at focus. Synonym of 'focus'.
 extract :: Loc f -> Mu f
 extract = focus
 
+-- | Replaces the subtree at focus. 
 replace :: Mu f -> Loc f -> Loc f
 replace new loc = loc { focus = new }
 
+-- | Modifies the subtree at focus. 
 modify :: (Mu f -> Mu f) -> Loc f -> Loc f
 modify h loc = replace (h (focus loc)) loc
 
 --------------------------------------------------------------------------------
 -- * Safe movements
 
--- | Moves down the child with the given index.
+-- | Moves down to the child with the given index.
 -- The leftmost children has index @0@.
 moveDown :: Traversable f => Int -> Loc f -> Maybe (Loc f)
 moveDown pos (Loc foc path) = new where
@@ -156,7 +175,7 @@     then  ((Just x  , j+1),  Right  path  ) 
     else  ((old     , j+1),  Left   x     )      
 
--- | Moves down the leftmost child.
+-- | Moves down to the leftmost child.
 moveDownL :: Traversable f => Loc f -> Maybe (Loc f)
 moveDownL (Loc foc path) = new where
   new = case mfoc' of  
@@ -167,7 +186,7 @@     Nothing  -> (Just x  ,  Right  path  ) 
     _        -> (old     ,  Left   x     )      
 
--- | Moves down the rightmost child.
+-- | Moves down to the rightmost child.
 moveDownR :: Traversable f => Loc f -> Maybe (Loc f)
 moveDownR (Loc foc path) = new where
   new = case mfoc' of  
@@ -180,6 +199,7 @@     
 --------------------------------------------------------------------------------
 
+-- | Moves up.
 moveUp :: Traversable f => Loc f -> Maybe (Loc f)
 moveUp (Loc foc path) = case path of
   Top         -> Nothing
@@ -230,7 +250,7 @@ --------------------------------------------------------------------------------
 -- * Testing for borders
 
--- | Checks whether we are the top.
+-- | Checks whether we are at the top (root).
 isTop :: Loc f -> Bool
 isTop (Loc _ p) = case p of { Top -> True ; _ -> False }
 
@@ -252,13 +272,51 @@ moveTop = tillNothing moveUp
 
 -- | Moves left until it can.
+-- It should be faster than repeated left steps.
 leftmost :: Traversable f => Loc f -> Loc f
-leftmost = tillNothing moveLeft
+leftmost orig@(Loc foc path) = case path of
+  Top         -> orig
+  Path nodes  -> 
+    case both of
+      Both {}  -> Loc foc' (Path nodes')
+      _        -> error "leftmost: shouldn't happen"
+    where  
+      -- this tricky implementation uses lazyness 
+      -- so that we only need a single traversal
+      (foc',pnew) = case both of { Both f p -> (f,p) ; _ -> error "leftmost: shouldn't happen" }    
+      (both,nodes') = mapAccumL g None nodes 
+      g old ei = case old of
+        None -> case ei of
+          Left  x  -> (First x    , Right pnew)
+          Right p  -> (Both foc p , ei        )   -- we are already at the leftmost position
+        First f -> case ei of
+          Left  x  -> (old        , ei        )
+          Right p  -> (Both f p   , Left  foc )
+        Both {} -> (old, ei)
 
 -- | Moves right until it can.
+-- It should be faster than repeated right steps.
 rightmost :: Traversable f => Loc f -> Loc f
-rightmost = tillNothing moveRight
-
+rightmost orig@(Loc foc path) = case path of
+  Top         -> orig
+  Path nodes  -> 
+    case both of
+      Both {}  -> Loc foc' (Path nodes')
+      _        -> error "rightmost: shouldn't happen"
+    where  
+      -- this tricky implementation uses lazyness 
+      -- so that we only need a single traversal
+      (foc',pnew) = case both of { Both f p -> (f,p) ; _ -> error "rightmost: shouldn't happen" }    
+      (both,nodes') = mapAccumR g None nodes 
+      g old ei = case old of
+        None -> case ei of
+          Left  x  -> (First x    , Right pnew)
+          Right p  -> (Both foc p , ei        )   -- we are already at the rightmost position
+        First f -> case ei of
+          Left  x  -> (old        , ei        )
+          Right p  -> (Both f p   , Left  foc )
+        Both {} -> (old, ei)
+          
 --------------------------------------------------------------------------------
 -- * Unsafe movements
 
@@ -283,6 +341,7 @@ 
 type LocT a = Loc (TreeF a)
 
+{-
 data Step
   = StepUp
   | StepLeft
@@ -322,6 +381,7 @@ instance Arbitrary Walk where
   arbitrary = liftM Walk arbitrary
   shrink (Walk steps) = map Walk (shrink steps)
+-}
 
 -- | Assuming a left-to-right canonical numbering, we find the given
 -- location.
@@ -342,18 +402,18 @@     Nothing -> goUpR (unsafeMoveUp loc)
     Just zz -> go zz
 
---
+----
 tmp = treeF "root"
   [ treeF "a" [ treeF "a1" [] , treeF "a2" [] ]
   , treeF "b" []
   , treeF "c" [ treeF "c1" [] , treeF "c2" [] , treeF "c3" [] ]
   ]
---
+----
   
 instance Arbitrary a => Arbitrary (LocT a) where
   arbitrary = do
     tree <- arbitrary 
-    let (n,numbered) = numberNodes tree
+    let (n,numbered) = enumerateNodes tree
     k <- choose (0,n-1)
     return $ locForget $ findLoc k (root numbered)
 
@@ -370,8 +430,12 @@ runtests_Zipper = do
   quickCheck prop_ReadShowLoc
   quickCheck prop_findLoc
+  quickCheck prop_locationsList
   quickCheck prop_contextList
   quickCheck prop_Top
+  quickCheck prop_defocus
+  quickCheck prop_leftmost
+  quickCheck prop_rightmost
   quickCheck prop_DownLUp
   quickCheck prop_DownRUp
   quickCheck prop_UpDownL 
@@ -384,13 +448,26 @@ 
 ----------------------------------------
 
+leftmostNaive :: Traversable f => Loc f -> Loc f
+leftmostNaive = tillNothing moveLeft
+
+rightmostNaive :: Traversable f => Loc f -> Loc f
+rightmostNaive = tillNothing moveRight
+
+----------------------------------------
+
 prop_ReadShowLoc :: LocT Label -> Bool
 prop_ReadShowLoc loc = read (show loc) == loc
 
+prop_locationsList :: FixT Label -> Bool
+prop_locationsList tree = locationsList tree == [ locForget $ findLoc i top | i<-[0..n-1] ] where
+  top = root numbered
+  (n,numbered) = enumerateNodes tree
+
 prop_findLoc :: FixT Label -> Bool
 prop_findLoc tree = [0..n-1] == [ attribute $ focus $ findLoc i top | i<-[0..n-1] ] where
   top = root numbered
-  (n,numbered) = numberNodes tree
+  (n,numbered) = enumerateNodes tree
 
 prop_contextList :: FixT Label -> Bool  
 prop_contextList tree =
@@ -399,13 +476,26 @@   [ defocus $ modify (\(Fix (TreeF l ts)) -> Fix (TreeF (h l) ts) ) $ locForget $ findLoc i top | i<-[0..n-1] ]
   where
     top = root numbered
-    (n,numbered) = numberNodes tree
+    (n,numbered) = enumerateNodes tree
     h (Label xs) = Label ('_':xs)
   
 prop_Top :: LocT Label -> Bool
 prop_Top loc = root (defocus loc) == moveTop loc
 
+prop_defocus :: FixT Label -> Bool
+prop_defocus tree = 
+  Prelude.and [ defocus (findLoc i top) == numbered | i<-[0..n-1] ] 
+  where
+    top = root numbered
+    (n,numbered) = enumerateNodes tree
+
 ----------------------------------------
+    
+prop_leftmost :: LocT Label -> Bool
+prop_leftmost loc = leftmost loc == leftmostNaive loc
+
+prop_rightmost :: LocT Label -> Bool
+prop_rightmost loc = rightmost loc == rightmostNaive loc
     
 prop_DownLUp :: LocT Label -> Property
 prop_DownLUp loc = 

@@ -1,61 +1,69 @@-
-Name:                fixplate
-Version:             0.1
-Synopsis:            Uniplate-style generic traversals for fixed-point types, with some extras.
-Description:         Uniplate-style generic traversals for fixed-point types, which can be  
-                     optionally annotated with attributes. We also provide a generic zipper.
-                     See the module "Data.Generics.Fixplate" and then the individual modules
-                     for more detailed information.
-License:             BSD3
-License-file:        LICENSE
-Author:              Balazs Komuves
-Copyright:           (c) 2011 Balazs Komuves
-Maintainer:          bkomuves (plus) hackage (at) gmail (dot) com
-Homepage:            http://code.haskell.org/~bkomuves/
-Stability:           Experimental
-Category:            Generics
-Tested-With:         GHC == 7.0.3
-Cabal-Version:       >= 1.2
-Build-Type:          Simple
-
-Flag withQuickCheck
-  Description: Compile with the QuickCheck tests. 
-  default: False
-
-Flag base4
-  Description: Base v4
-  
-Library
-  if flag(base4)
-    Build-Depends:       base >= 4 && < 5
-    cpp-options:         -DBASE_VERSION=4
-  else 
-    Build-Depends:       base >= 3 && < 4
-    cpp-options:         -DBASE_VERSION=3
-
-  if flag(withQuickCheck)
-    Build-Depends:       QuickCheck > 2.4
-    cpp-options:         -DWITH_QUICKCHECK
-
-  Exposed-Modules:     Data.Generics.Fixplate
-                       Data.Generics.Fixplate.Base
-                       Data.Generics.Fixplate.Traversals
-                       Data.Generics.Fixplate.Morphisms
-                       Data.Generics.Fixplate.Attributes
-                       Data.Generics.Fixplate.Zipper
-                       Data.Generics.Fixplate.Structure
- 
-  Other-Modules:       Data.Generics.Fixplate.Misc
-
-  if flag(withQuickCheck)  
-    Exposed-Modules:     Data.Generics.Fixplate.Test.Tools
-                         Data.Generics.Fixplate.Test.Instances
-                         Data.Generics.Fixplate.Tests
- 
-  Extensions:          CPP
-
-  Hs-Source-Dirs:      .
-
-  ghc-options:         -Wall -fno-warn-unused-matches
-
-    ++Name:                fixplate+Version:             0.1.1+Synopsis:            Uniplate-style generic traversals for fixed-point types, with some extras.+Description:         Uniplate-style generic traversals for fixed-point types, which can be  +                     optionally annotated with attributes. We also provide a generic zipper.+                     See the module "Data.Generics.Fixplate" and then the individual modules+                     for more detailed information.+License:             BSD3+License-file:        LICENSE+Author:              Balazs Komuves+Copyright:           (c) 2011 Balazs Komuves+Maintainer:          bkomuves (plus) hackage (at) gmail (dot) com+Homepage:            http://code.haskell.org/~bkomuves/+Stability:           Experimental+Category:            Generics+Tested-With:         GHC == 7.0.3+Cabal-Version:       >= 1.2+Build-Type:          Simple++Flag withQuickCheck+  Description: Compile with the QuickCheck tests. +  default: False++Flag base4+  Description: Base v4+  +Library+  if flag(base4)+    Build-Depends:       base >= 4 && < 5+    cpp-options:         -DBASE_VERSION=4+  else +    Build-Depends:       base >= 3 && < 4+    cpp-options:         -DBASE_VERSION=3++  if flag(withQuickCheck)+    Build-Depends:       QuickCheck > 2.4+    cpp-options:         -DWITH_QUICKCHECK++  Exposed-Modules:     Data.Generics.Fixplate+                       Data.Generics.Fixplate.Base+                       Data.Generics.Fixplate.Open+                       Data.Generics.Fixplate.Traversals+                       Data.Generics.Fixplate.Morphisms+                       Data.Generics.Fixplate.Attributes+                       Data.Generics.Fixplate.Zipper+                       +  if impl(ghc)||impl(hugs)                     +    Exposed-Modules:     Data.Generics.Fixplate.Structure+    cpp-options:         -DHAS_RANK2TYPES++  Other-Modules:       Data.Generics.Fixplate.Misc++  if flag(withQuickCheck)  +    Exposed-Modules:     Data.Generics.Fixplate.Test.Tools+                         Data.Generics.Fixplate.Test.Instances+                         Data.Generics.Fixplate.Tests+    Extensions:          TypeSynonymInstances+ +  Extensions:          CPP++  if impl(ghc)+    Extensions:          BangPatterns++  Hs-Source-Dirs:      .++  ghc-options:         -Wall -fno-warn-unused-matches++