pez 0.0.4 → 0.1.0

raw patch · 7 files changed

+798/−628 lines, 7 filesdep +QuickCheckdep +failuredep +test-frameworkdep ~basedep ~fclabelsPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, failure, test-framework, test-framework-quickcheck2

Dependency ranges changed: base, fclabels

API changes (from Hackage documentation)

Files

• Data/Label/Zipper.hs +718/−0
• Data/Record/Label/Prelude.hs +0/−22
• Data/Typeable/Zipper.hs +0/−297
• EXAMPLES/Examples.lhs +0/−136
• PreludeLenses.hs +34/−0
• Tests.hs +0/−121
• pez.cabal +46/−52

@@ -0,0 +1,718 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeOperators, TemplateHaskell,+GADTs, DeriveDataTypeable, TupleSections,+MultiParamTypeClasses, +TypeFamilies, FlexibleContexts,+ExistentialQuantification #-}++{- |+PEZ is a generic zipper library. It uses lenses from the "fclabels" package to+reference a \"location\" to move to in the zipper. The zipper is restricted to+types in the 'Typeable' class, allowing the user to \"move up\" through complex +data structures such as mutually-recursive types, where the compiler could not +otherwise type-check the program.+.+Both the Typeable class and "fclabels" lenses can be derived in GHC, making it+easy for the programmer to use a zipper with a minimum of boilerplate.+-}++module Data.Label.Zipper (+    -- * Usage+    {- |+     First import the library, which brings in the Typeable and "fclabels" modules.+     You will also want to enable a few extensions:  +         @TemplateHaskell@, @DeriveDataTypeable@, @TypeOperators@+      +     > module Main where+     >+     > import Data.Label.Zipper++     Create a datatype, deriving an instance of the Typeable class, and generate a+     lens using Template Haskell functionality from "fclabels":++     > data Tree a = Node { +     >     _leftNode :: Tree a+     >   , _val      :: a +     >   , _rightNode :: Tree a }+     >   | Nil  +     >   deriving (Typeable,Show)+     >+     > $(mkLabels [''Tree])++     Now we can go crazy using Tree in a 'Zipper':++     > treeBCD = Node (Node Nil 'b' Nil) 'c' (Node Nil 'd' Nil)+     > +     > descendLeft :: (Typeable a)=> Zipper1 (Tree a) -> Zipper1 (Tree a)+     > descendLeft = moveFloor (to leftNode) -- stops at Nil constructor+     >+     > insertLeftmost :: (Typeable a)=> a -> Tree a -> Maybe (Tree a)+     > insertLeftmost a = close . setf newNode . descendLeft . zipper+     >     where newNode = Node Nil a Nil+     >+     > treeABCD = insertLeftmost 'a' treeBCD+      +     Because of the flexibility of "fclabels", this zipper library can be used to+     express moving about in reversible computations simply by defining such a lens,+     for instance:+      +     > stringRep :: (Show b, Read b) => b :-> String+     > stringRep = lens show (const . read)++     Another exciting possibility are zippers that can perform validation,+     refusing to 'close' if a field is rejected.+    -}++    -- * Zipper functionality+    Zipper() +    {- |+       /A note on failure in zipper operations:/++       Most operations on a 'Zipper' return a result in a 'Failure' class+       monad, throwing various types of failures. Here is a list of failure+       scenarios:++         - a 'move' Up arrives at a type that could not be cast to the type+           expected++         - a @move (Up 1)@ when already 'atTop', i.e. we cannot ascend anymore++         - a @move@ to a label (e.g. @foo :: FooBar :~> FooBar@) causes a+           failure in the getter function of the lens, usually because the +           'focus' was the wrong constructor for the lens++         - a @move (Up n)@ causes the /setter/ of the lens we used to arrive at+           the current focus to fail on the value of the current focus. This +           is not something that happens for normal lenses, but is desirable +           for structures that enforce extra-type-system constraints. ++         - a 'close' cannot re-build the structure because some setter failed,+           as above. Again, this does not occur for TH'generated lenses.++       See the "failure" package for details.+    -}+    -- ** Creating and closing Zippers+    , zipper , close+    -- ** Moving around+    , Motion(..) +    , Up(..) , UpCasting(..) , To() , to +    --, Flatten(..)+    -- *** Error types+    {- |+       Every defined 'Motion' has an associated error type, thrown in a+       'Failure' class monad (see "failure"). These types are also part of a+       small 'Exception' hierarchy.+    -}+    , ZipperException() , UpErrors(..) , ToErrors(..)+    -- *** Repeating movements+    , moveWhile+    , moveUntil+    , moveFloor+    -- ** The zipper focus+    -- | a "fclabels" lens for setting, getting, and modifying the zipper's+    -- focus. Note: a zipper may fail to 'close' if the lens used to reach the+    -- current focus performed some validation.+    , focus +    , viewf , setf , modf+    -- ** Querying Zippers and Motions+    , atTop , level+    , LevelDelta(..)+    -- ** Saving and recalling positions in a Zipper+    , save , closeSaving+    , restore , flatten   ++    -- * Convenience operators, types, and exports+    , Zipper1++    -- ** Re-exports+    {- | These re-exported functions should be sufficient for the most common+     - zipper functionality+     -}+    , Data.Typeable.Typeable(..)+    , Data.Label.mkLabels+    , (M.:~>)+    , Control.Failure.Failure(..)+    , Control.Exception.Exception(..)+) where++++{- + -   IMPLEMENTATION NOTES:+ -+ -   we use a Thrist to create a type-threaded stack of continuations+ -   allowing us to have a polymorphic history of where we've been.+ -   By using Typeable, we are able to "move up" by type casting in+ -   the Maybe monad. This means that the programmer has to know+ -   what type a move up will produce, or deal with unknowns.+ -+ -+ -   TODO NEXT:+ -   ----------+ -   - complete code coverage+ -   - make error types return more useful info: height above where constructor+ -     failed, typeRep of the failure,+ -   - implement focusValid, or a better solution.+ -   - can we define appropriate instances to allow, e.g. `move -2` ?+ -   - pure move functionality (either separate module/namespace or new+ -      function)+ -      - pureMove :: (PureMotion m)=>+ -   - re. above: also see note under CONVENIENCE: can we use a mechanism+ -      similar to what fclabels uses on generated zippers to force the use of+ -      e.g. focusSafe on a zipper where we have used 'To' with a failable lens,+ -      forcing a close function that would return Maybe, etc.+ -+ -      We should provide a function validate :: FallibleZipper -> ClosableZipper, which allows validation at any one time+ -      Then, moveFallible :: z -> FallibleZipper, move :: z -> z+ -+ -      But there is a real question with fclabels that has come up:+ -          1) basic lenses that can fail only ever fail (because of multiple+    -          constructors) on the getter, yet underlying type can fail in setter+ -             too. This adds needless fallability to our close function+ -          2) we might like (as we want in focusValid below) to have a lens+    -          that ONLY fails on a setter (does validation), but which always+ -             succeeds in a getter (has a single constructor for instance)+ -      + -+ -   - conversion from motions to fclabels (:~>)+ -   - add Flatten motion down that collapses history?+ -      - doesn't make sense for motion from top level. return Nothing?+ -   - other motion ideas:+ -      - Up to the nth level of specified type+ -      - up to the level of a specified type with focus matching predicate+ -      - Up to topmost level matching type:+ -      - repeat descend a :~> a (ToLast?)+ -      - motion down a :~> a, until matching pred.+ -   - look at Arrow instance for thrist (in module yet)+ -   - make To an instance if Iso (if possible)+ -   - Kleisli-wrapped arrow interface that works nicely with proc notation+ -+ -   PERFORMANCE TODO+ -   -----------------+ -   - consider instead of using section, use head form of parent with+ -     the child node set to undefined. Any performance difference?+ -   - actually look at how this performs in terms of space/time+ -+ -   ROADMAP:+ -    Particularly Elegant+ -    Pink Elephant+ -    Placebo Effect+ -    Patiently Expectant+ -    Probably ??+ -+ -}++ -- this is where the magic happens:+import Data.Label+import qualified Data.Label.Maybe as M+import Data.Typeable+import Data.Thrist++ -- for our accessors, which are a category:+import Control.Category         +import Prelude hiding ((.), id)+import Control.Applicative+import Control.Arrow(Kleisli(..))+import Control.Monad+import Control.Failure+import Control.Exception+++    -------------------------+    -- TYPES: the real heros+    ------------------------+++-- ZIPPER TYPE --+-----------------++{- *+ - It's interesting to note in our :~> lenses the setter also can fail, and can+ - fail based not only on the constructor 'f' but also for certain values of 'a'+ - This is kind of interesting; it lets lenses enforce constraints on a type+ - that the type system cannot, e.g. Foo Int, where Int must always be odd.+ -+ - So a module might export a type with hidden constructors and only lenses for+ - an interface. Our zipper could navigate around in the type, and all the+ - constraints would still be enforced on the unzippered type. Cool!+-}++ -- We store our history in a type-threaded list of pairs of lenses and+ -- continuations (parent data-types with a "hole" where the child fits), the+ -- lenses are kept around so that we can extract the "path" to the current+ -- focus and apply it to other data types. Use GADT to enforce Typeable.+data HistPair b a where +    H :: (Typeable a, Typeable b)=> +                { hLens :: (a M.:~> b)+                , hCont :: Kleisli Maybe b a -- see above+                } -> HistPair b a++type ZipperStack b a = Thrist HistPair b a++-- TODO: this could be a contravariant functor, no?:++-- | Encapsulates a data type @a@ at a focus @b@, supporting various 'Motion'+-- operations+data Zipper a b = Z { stack  :: ZipperStack b a+                    , _focus :: b                                  +                    } deriving (Typeable)+    +$(mkLabels [''Zipper])+++-- MOTION CLASSES --+--------------------++--TODO NOTE: this is the class we would like, however this causes a cycle+--because of superclass declaration of Motion. see this thread: +--    http://www.haskell.org/pipermail/glasgow-haskell-users/2011-July/020585.html+--class (Exception (ThrownBy mot), Motion (Returning mot))=> Motion mot where++-- | Types of the Motion class describe \"paths\" up or down (so to speak)+-- through a datatype. The exceptions thrown by each motion are enumerated in+-- the associated type @ThrownBy mot@. The @Motion@ type that will return the+-- focus to the last location after doing a 'moveSaving is given by @Returning mot@.+class (Exception (ThrownBy mot))=> Motion mot where+    type ThrownBy mot :: *+    type Returning mot :: * -> * -> *++    -- | Move to a new location in the zipper, either returning the new zipper,+    -- or throwing @err@ in some @Failure@ class type (from the "failure" pkg.)+    --+    -- The return type can be treated as @Maybe@ for simple exception handling+    -- or one can even use something like "control-monad-exception" to get +    -- powerful typed, checked exceptions.+    move :: (Typeable b, Typeable c, Failure (ThrownBy mot) m) => +                mot b c -> Zipper a b -> m (Zipper a c)+    move mot z = moveSaving mot z >>= return . snd++    -- | like 'move' but saves the @Motion@ that will return us back to the +    -- location we started from in the passed zipper.+    moveSaving :: (Typeable b, Typeable c, Failure (ThrownBy mot) m) => +                    mot b c -> Zipper a b -> m ((Returning mot) c b, Zipper a c)++++-- MOTIONS+-------------++-- | a 'Motion' upwards in the data type. e.g. @move (Up 2)@ would move up to+-- the grandparent level, as long as the type of the focus after moving is +-- @b@. Inline type signatures are often helpful to avoid ambiguity, e.g. +-- @(Up 2 :: Up Char (Tree Char))@ read as \"up two levels, from a focus of+-- type @Char@ to @Tree Char@\".+--+-- This 'Motion' type throws 'UpErrors'+newtype Up c b = Up { upLevel :: Int }+    deriving (Show,Num,Integral,Eq,Ord,Bounded,Enum,Real)++data UpErrors = CastFailed+              | LensSetterFailed+              | MovePastTop+              deriving (Show,Typeable,Eq)+++{-+--TODO: THIS IS PROBABLY NOT A GGOD IDEA UNLESS WE CAN DO IT RIGHT. AT THE+--MOMENT I DON'T UNDERSTAND HOW GHC DOES SOMETHING LIKE:+--      [-1,-2..-3] :: [ Up Int Int]+-- BUT THE FOLLOWING CODE ISN'T ENOUGH. FOR NOW DERIVE NUMERIC CLASSES ABOVE AND+-- DO NOT DOCUMENT USING `move 3`.+-- | 'fromInteger' gets defined as @Up . abs@, so @move (Up 2)@ is equivalent to+-- @move (-2)@.+instance Num (Up a b) where+    (Up a) + (Up b) = Up $ a+b+    (Up a) - (Up b) = Up $ a-b+    (Up a) * (Up b) = Up $ a*b+    abs (Up n)      = Up $ abs n+    signum (Up n)   = Up $ signum n+    fromInteger n   = Up $ fromInteger $ abs n++instance Integral (Up a b) where+    toInteger (Up n) = toInteger $ negate $ abs n+    quotRem (Up a) (Up b) = (Up $ quot a b, Up $ rem a b)++-- also need fromEnum and fromIntegral?+-}++instance Category Up where+    (Up m) . (Up n) = Up (m+n)+    id              = 0++instance Motion Up where+    type ThrownBy Up = UpErrors+    type Returning Up = To++    move (Up 0)  z = +        maybeThrow CastFailed $ gcast z+    move (Up n) (Z (Cons (H _ k) stck) c) = +        maybeThrow LensSetterFailed (runKleisli k c) >>= +        move (Up (n-1)) . Z stck+    move _ _ = +        failure MovePastTop++    -- TODO: it makes more sense to define 'move' and 'saveFromAbove' in terms+    -- of moveSaving below, but we ran into some type weirdness, so...+    moveSaving p z = liftM2 (,) (saveFromAbove p z) (move p z)+++-- | indicates a 'Motion' upwards in the zipper until we arrive at a type which+-- we can cast to @b@, otherwise throwing 'UpErrors'+data UpCasting c b = UpCasting+    deriving(Show,Typeable,Eq)+++instance Motion UpCasting where+    type ThrownBy UpCasting = UpErrors+    type Returning UpCasting = To++    moveSaving _ z = do +        when (atTop z) $ failure MovePastTop+        firstSuccess $ map (flip ms z) [Up 1 ..]+        where ms = moveSaving :: (Typeable b, Typeable c)=>Up c b -> Zipper a c -> Either UpErrors (To b c, Zipper a b)+              firstSuccess []                            = failure CastFailed+               -- this would be raised on each of it's ancestors: +              firstSuccess ((Left LensSetterFailed):_) = failure LensSetterFailed+               -- if cast failed, skip:+              firstSuccess ((Left CastFailed):zms)     = firstSuccess zms+              firstSuccess ((Right (m,z')):_)          = return (m,z')+              firstSuccess _ = error "bug in move UpCasting"+++-- | A 'Motion' type describing an incremental path \"down\" through a data+-- structure. Use 'to' to move to a location specified by a "fclabels" lens.+--+-- Use 'restore' to return to a previously-visited location in a zipper, with+-- previous history intact, so:+--+-- > (\(l,ma)-> move l <$> ma) (closeSaving z)  ==  Just z+--+-- Use 'flatten' to turn this into a standard fclabels lens, flattening the+-- incremental move steps.+--+-- Throws errors of type 'ToErrors':+newtype To a b = S { savedLenses :: Thrist TypeableLens a b } +    deriving (Typeable, Category)++-- We need another GADT here to enforce the Typeable constraint within the+-- hidden types in our thrist of lenses above:+data TypeableLens a b where+    TL :: (Typeable a,Typeable b)=> { tLens :: (a M.:~> b)+                                    } -> TypeableLens a b++-- TODO: we might store some info here re. at what level the error occured:+data ToErrors = LensGetterFailed+    deriving(Show,Typeable,Eq)++instance Motion To where+    type ThrownBy To = ToErrors+    type Returning To = Up++    move mot z = maybeThrow LensGetterFailed $ +        foldMThrist pivot z $ savedLenses mot++    moveSaving p z = do z' <- move p z+                        let motS = Up $ lengthThrist $ savedLenses p+                        return (motS,z')++-- | use a "fclabels" label to define a Motion \"down\" into a data type.+to :: (Typeable a, Typeable b)=> (a M.:~> b) -> To a b+to = S . flip Cons Nil . TL++++{-  TODO for next version+-- | a 'Motion' \"down\" that squashes the saved history of the motion, so for+-- instance:+--+-- > level $ move (Flatten l) z  ==  level z+--+-- and:+--+-- > move (Up 1) z  ==  move (Up 1) $ move (Flatten l) z+newtype Flatten a b = Flatten (To a b) +    deriving (Typeable, Category)++instance Motion Flatten where+    move m z = undefined --flip (foldMThrist pivot) . savedLenses  +-}++--------------- REPEATED MOTIONS -----------------++-- | Apply the given Motion to a zipper until the Motion fails, returning the+-- last location visited. For instance @moveFloor (to left) z@ might return+-- the left-most node of a 'zipper'ed tree @z@.+-- +-- > moveFloor m z = maybe z (moveFloor m) $ move m z+moveFloor :: (Motion m,Typeable a, Typeable b)=> +                 m b b -> Zipper a b -> Zipper a b+moveFloor m z = maybe z (moveFloor m) (move m z)++-- | Apply a motion each time the focus matches the predicate, raising an error+-- in @m@ otherwise+moveWhile :: (Failure (ThrownBy mot) m, Motion mot, Typeable c) =>+              (c -> Bool) -> mot c c -> Zipper a c -> m (Zipper a c)+moveWhile p m z | p $ viewf z = move m z >>= moveWhile p m+                | otherwise   = return z++{-+-- THIS SEEMS NOT TERRIBLY USEFUL, AND WAS CONFUSING EVEN ME+--+-- | Apply a motion one or more times until the predicate applied to the focus+-- returns @True@, otherwise raising an error in @m@ if a 'move' fails before+-- we reach a focus that matches.+moveUntil :: (Failure (ThrownBy mot) m, Motion mot, Typeable c) =>+              (c -> Bool) -> mot c c -> Zipper a c -> m (Zipper a c)+moveUntil p m z = move m z >>= maybeLoop+    where maybeLoop z' | p $ viewf z' = return z'+                       | otherwise    = moveUntil p m z'+-}+++-- | Apply a motion zero or more times until the focus matches the predicate+--+-- > moveUntil p = moveWhile (not . p)+moveUntil :: (Failure (ThrownBy mot) m, Motion mot, Typeable c) =>+              (c -> Bool) -> mot c c -> Zipper a c -> m (Zipper a c)+moveUntil p = moveWhile (not . p)+++-- TODO: consider:+--     moveWhen+--     moveUnless++--------------- ++-- | create a zipper with the focus on the top level.+zipper :: a -> Zipper a a+zipper = Z Nil++++    ------------------------------+    -- ADVANCED ZIPPER FUNCTIONS:+    ------------------------------+++data ZipperLenses a c b = ZL { zlStack :: ZipperStack b a,+                               zLenses :: Thrist TypeableLens b c }++-- INTERNAL FOR NOW:+saveFromAbove :: (Typeable c, Typeable b, Failure UpErrors m) => +                    Up c b -> Zipper a c -> m (To b c)+saveFromAbove n = liftM (S . zLenses) . mvUpSavingL (upLevel n) . flip ZL Nil . stack+    where mvUpSavingL :: (Typeable b', Typeable b, Failure UpErrors m)=> +                          Int -> ZipperLenses a c b -> m (ZipperLenses a c b')+          mvUpSavingL 0 z = +              maybeThrow CastFailed $ gcast z+          mvUpSavingL n' (ZL (Cons (H l _) stck) ls) = +              mvUpSavingL (n'-1) (ZL stck $ Cons (TL l) ls)+          mvUpSavingL _ _ = failure MovePastTop+        ++-- | Close the zipper, returning the saved path back down to the zipper\'s+-- focus. See 'close'+closeSaving :: Zipper a b -> (To a b, Maybe a)+closeSaving (Z stck b) = (S ls, ma)+    where ls = getReverseLensStack stck+          kCont = compStack $ mapThrist hCont stck+          ma = runKleisli kCont b+++-- TODO: consider that if we stick with fclabels-generated lenses here, there+-- isn't any conceptual reason why such lenses whould have to fail on their+-- setters, and why 'close' should have to fail here:+-- I guess this would require an implementation of M.lens like:+--+--     lens :: (f -> Maybe a) -> (f -> Maybe (a -> f)) -> f :~> a+-- e.g. lLeft = lens lGet lSet where+--           lGet (Left a) = Just a+--           lGet _ = Nothing+--           lSet (Left a) = Just (\a'-> Left a') -- if the type had multiple params they would be preserved of course+--           lSet _ = Nothing+--+--        ...so is (Just $\a-> Left a) an arrow at this point? ++-- | re-assembles the data structure from the top level, returning @Nothing@ if+-- the structure cannot be re-assembled.+--+-- /Note/: For standard lenses produced with 'mkLabels' this will never fail.+-- However setters defined by hand with 'lens' can be used to enforce arbitrary+-- constraints on a data structure, e.g. that a type @Odd Int@ can only hold an+-- odd integer.  This function returns @Nothing@ in such cases, which+-- corresponds to the @LensSetterFailed@ constructor of 'UpErrors'+close :: Zipper a b -> Maybe a+close = snd . closeSaving++++-- | Return a path 'To' the current location in the 'Zipper'.+-- This lets you return to a location in your data type with 'restore'.+--+-- > save = fst . closeSaving+save :: Zipper a b -> To a b+save = fst . closeSaving+++-- TODO: consider making flatten polymorphic over: To, Zipper, etc. and change name to toLens++-- | Extract a composed lens that points to the location we saved. This lets +-- us modify, set or get a location that we visited with our 'Zipper', after +-- closing the Zipper, using "fclabels" @get@ and @set@.+flatten :: (Typeable a, Typeable b)=> To a b -> (a M.:~> b)+flatten = compStack . mapThrist tLens . savedLenses+++-- | Enter a zipper using the specified 'Motion'.+--+-- Saving and restoring lets us for example: find some location within our +-- structure using a 'Zipper', save the location, 'fmap' over the entire structure,+-- and then return to where we were safely, even if the \"shape\" of our+-- structure has changed.+--+-- > restore s = move s . zipper+restore :: (Typeable a, Typeable b, Failure ToErrors m)=> To a b -> a -> m (Zipper a b)+restore s = move s . zipper+++-- | returns 'True' if 'Zipper' is at the top level of the data structure:+atTop :: Zipper a b -> Bool+atTop = nullThrist . stack+++-- | Return our zero-indexed depth in the 'Zipper'. +-- if 'atTop' zipper then @'level' zipper == 0@+level :: Zipper a b -> Int+level = lengthThrist . stack++-- | Motion types which alter a Zipper by a knowable integer quantity.+-- Concretly, the following should hold:+--+-- > level (move m z) == level z + delta m+--+-- For motions upwards this returns a negative value.+class (Motion m)=> LevelDelta m where+    delta :: (Typeable a, Typeable b)=>m a b -> Int++instance LevelDelta Up where+    delta = negate . upLevel++instance LevelDelta To where+    delta = lengthThrist . savedLenses++{- TODO maybe in next version+instance LevelDelta Flatten where+    delta = const 0+-}++----------------------------------------------------------------------------+++    ----------------+    -- CONVENIENCE+    ----------------++-- TODO: we should at least export a lens 'focusM' or 'focusSafe'that fails+-- when the zipper fails validation (i.e. can't be closed) . There are probably+-- some clever polymorphic solutions similar to what fclabels itself does to+-- force use of focusSafe when we've moved with a failable lens, vs. a zipper+-- untainted by failable lenses in history (in which case 'close' will never+-- fail).+++-- | a view function for a Zipper\'s 'focus'.+--+-- > viewf = get focus+viewf :: Zipper a b -> b+viewf = get focus++-- | modify the Zipper\'s 'focus'.+--+-- > modf = modify focus+modf :: (b -> b) -> Zipper a b -> Zipper a b+modf = modify focus++-- | set the Zipper\'s 'focus'.+-- +-- > setf = set focus+setf :: b -> Zipper a b -> Zipper a b+setf = set focus++-- | a simple type synonym for a 'Zipper' where the type at the focus is the+-- same as the type of the outer (unzippered) type. Cleans up type signatures+-- for simple recursive types:+type Zipper1 a = Zipper a a++++    ------------+    -- HELPERS+    ------------++ -- The core of move To+pivot :: forall t t1 t2. Zipper t t1 -> TypeableLens t1 t2 -> Maybe (Zipper t t2)+pivot (Z t a) (TL l) = Z (Cons h t) <$> mb+    where h = H l (Kleisli c)+          c = flip (M.set l) a +          mb = M.get l a+++ -- fold a thrist into a single category by composing the stack with (.)+ -- Here 'cat' will be either (->) or (:->):+compStack :: (Category cat)=> Thrist cat b a -> cat b a+compStack = foldrThrist (flip(.)) id+++ -- Takes the zipper stack and extracts each lens segment, and recomposes+ -- them in reversed order, forming a lens from top to bottom of a data + -- structure:+getReverseLensStack :: ZipperStack b a -> Thrist TypeableLens a b+getReverseLensStack = unflip . foldlThrist revLocal (Flipped Nil)+-- MAKING THIS GLOBAL SHOULD PLEASE GHC 7.0 WITHOUT EXTRA EXTENSIONS. SEE:+--      http://hackage.haskell.org/trac/ghc/blog/LetGeneralisationInGhc7+revLocal :: forall t t1 t2.+               Flipped (Thrist TypeableLens) t t1+               -> HistPair t1 t2+               -> Flipped (Thrist TypeableLens) t t2+revLocal (Flipped t) (H l _) = Flipped $ Cons (TL l) t+++-- this would be useful in thrist+newtype IntB a b = IntB { getInt :: Int }+plusB :: IntB a b -> IntB b c -> IntB a c+plusB a b = IntB (getInt a + getInt b)++lengthThrist :: Thrist (+>) a b -> Int+lengthThrist = getInt . foldrThrist plusB (IntB 0) . mapThrist (const $ IntB 1)+++maybeThrow :: (Failure e m)=> e -> Maybe a -> m a+maybeThrow e = maybe (failure e) return+++    ----------------------+    -- EXCEPTION HIERARCHY+    ----------------------++-- NOTE: a 'Throws' hierarchy must be defined manually for c-m-e. Perhaps we+-- should create a separate package with those instances defined++-- | The root of the exception hierarchy for Zipper 'move' operations:+data ZipperException = forall e . Exception e => ZipperException e+     deriving (Typeable)++instance Show ZipperException where+    show (ZipperException e) = show e++instance Exception ZipperException++instance Exception UpErrors where+    toException = toException . ZipperException+    fromException x = do+        ZipperException a <- fromException x+        cast a++instance Exception ToErrors where+    toException = toException . ZipperException+    fromException x = do+        ZipperException a <- fromException x+        cast a

@@ -1,22 +0,0 @@-{-# LANGUAGE TypeOperators #-}-module Data.Record.Label.Prelude-    where--import Data.Record.Label----- First class labels pre-defined for the standard types from haskell's prelude---- | [a]-lHead :: [a] :-> a-lHead = lens head (:)--lTail :: [a] :-> [a]-lTail = lens tail (\t-> (:t) . head)---- | (a,b)-lFst :: (a,b) :-> a-lFst = lens fst (\a (_,b)-> (a,b))--lSnd :: (a,b) :-> b-lSnd = lens snd (\b (a,_)-> (a,b))

@@ -1,297 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, TypeOperators, TemplateHaskell, -GADTs, DeriveDataTypeable #-}-module Data.Typeable.Zipper (--    -- * Basic Zipper functionality-      Zipper() -    -- ** Creating and closing Zippers-    , zipper , close-    -- ** Moving around-    , ZPath(..) , moveUp-    -- ** Querying-    , focus , viewf , atTop       --    -- * Advanced functionality-    -- ** Saving positions in a Zipper-    , SavedPath       -    , save        -    , saveFromAbove-    , savedLens   -    , closeSaving-    , moveUpSaving-    -- ** Recalling positions:-    , restore     --    -- * Convenience operators, types, and exports-    , Zipper1-    -- ** Operators-    , (.+) , (.>) , (.-) , (?+) , (?>) , (?-)-    -- ** Export Typeable class and fclabels package-    , module Data.Record.Label-    , Data.Typeable.Typeable     -) where--{- - -   DESCRIPTION:- -- -   we use a Thrist to create a type-threaded stack of continuations- -   allowing us to have a polymorphic history of where we've been.- -   by using Typeable, we are able to "move up" by type casting in- -   the Maybe monad. This means that the programmer has to know- -   what type a move up will produce, or deal with unknowns.- -- -- - TODO NOTES- -- -   - Include as part of package a module: Data.Record.Label.Prelude that- -   exports labels for haskell builtin types- -- -   - Create a 'moveUntil' function, or something else to capture the ugly:- -          descend z@(viewf -> Gong) = z- -          descend z                 = descend $ moveTo tock z- -    ...perhaps we can make something clever using property of pattern match- -     failure in 'do' block?- -- -   - When the 'fclabels' package supports failure handling a.la the code on- -   Github, then these functions will take advantage of that by returning- -   Nothing when a lens is applied to an invalid constructor:- -       * moveTo- -       * restore- -   - -   - consider instead of using section, use head form of parent with- -   the child node set to undefined. Any performance difference?- -- -   - actually look at how this performs in terms of space/time- -- -   ROADMAP:- -    Pink Elephant- -    Patiently Expectant- -    Pretty Extraordinary- -    Probably ??- -- -}-- -- this is where the magic happens:-import Data.Record.Label-import Data.Typeable-import Data.Thrist-- -- for our accessors, which are a category:-import Control.Category         -import Prelude hiding ((.), id) -- take these from Control.Category-import Control.Applicative---    --------------------------    -- TYPES: the real heros-    --------------------------- -- We store our history in a type-threaded list of pairs of lenses and- -- continuations (parent data-types with a "hole" where the child fits):- --    Use GADT to enforce Typeable constraint-data HistPair b a where -    H :: (Typeable a, Typeable b)=> { hLens :: (a :-> b),-                                      hCont :: (b -> a) } -> HistPair b a--type ZipperStack b a = Thrist HistPair b a--data Zipper a b = Z { stack  :: ZipperStack b a,-                      _focus :: b                                  -                    } deriving (Typeable)-    ---- | stores the path used to return to the same location in a data structure--- as the one we just exited. You can also extract a lens from a SavedPath that--- points to that location:-newtype SavedPath a b = S { savedLenses :: Thrist TypeableLens a b } -    deriving (Typeable, Category)---- We need another GADT here to enforce the Typeable constraint within the--- hidden types in our thrist of lenses above:-data TypeableLens a b where-    TL :: (Typeable a,Typeable b)=> {tLens :: (a :-> b)} -> TypeableLens a b------ TODO: TRY USING FUNDEPS ALA THE MONAD TRANSFORMER LIBRARIES FOR CLASS--- CONSTRAINTS HERE:---class (Typeable b, Typeable c) => ZPath p b c | p -> b, p -> c where------ | Types of the ZPath class act as references to "paths" down through a datatype.--- Currently lenses from 'fclabels' and SavedPath types are instances-class ZPath p where-    -- | Move down the structure to the label specified. Return Nothing if the-    -- label is not valid for the focus's constructor:-    moveTo :: (Typeable b, Typeable c) => p b c -> Zipper a b -> Zipper a c----    ----------------------------    -- Basic Zipper Functions:-    -------------------------------- | a fclabel lens for setting, getting, and modifying the zipper's focus:-$(mkLabelsNoTypes [''Zipper])---instance ZPath (:->) where-    moveTo = flip pivot . TL--instance ZPath SavedPath where-    moveTo = flip (foldlThrist pivot) . savedLenses  ----- | Move up n levels as long as the type of the parent is what the programmer--- is expecting and we aren't already at the top. Otherwise return Nothing.-moveUp :: (Typeable c, Typeable b)=> Int -> Zipper a c -> Maybe (Zipper a b)-moveUp 0  z                        = gcast z-moveUp n (Z (Cons (H _ f) stck) c) = moveUp (n-1) (Z stck $ f c)-moveUp _  _                        = Nothing  ---zipper :: a -> Zipper a a-zipper = Z Nil---close :: Zipper a b -> a-close = snd . closeSaving----    -------------------------------    -- ADVANCED ZIPPER FUNCTIONS:-    ----------------------------------- THIS FUNCTION GAVE ME THE MOST TROUBLE AND COULD PROBABLY BE SIMPLIFIED AND---- 'moveUP' DEFINED IN TERMS OF IT, BUT FOR NOW I AM HAPPY WITH SOMETHING THAT---- WORKS. ---- | Move up a level as long as the type of the parent is what the programmer--- is expecting and we aren't already at the top. Otherwise return Nothing.-moveUpSaving :: (Typeable c, Typeable b)=> Int -> Zipper a c -> Maybe (Zipper a b, SavedPath b c)-moveUpSaving n z = (,) <$> moveUp n z <*> saveFromAbove n z--data ZipperLenses a c b = ZL { zlStack :: ZipperStack b a,-                               zLenses :: Thrist TypeableLens b c }----- | return a SavedPath from n levels up to the current level-saveFromAbove :: (Typeable c, Typeable b) => Int -> Zipper a c -> Maybe (SavedPath b c)-saveFromAbove n = fmap (S . zLenses) . mvUpSavingL n . flip ZL Nil . stack-    where-        mvUpSavingL :: (Typeable b', Typeable b)=> Int -> ZipperLenses a c b -> Maybe (ZipperLenses a c b')-        mvUpSavingL 0 z                           = gcast z-        mvUpSavingL n (ZL (Cons (H l _) stck) ls) = mvUpSavingL (n-1) (ZL stck $ Cons (TL l) ls)-        mvUpSavingL _ _                           = Nothing----closeSaving :: Zipper a b -> (SavedPath a b, a)-closeSaving (Z stck b) = (S ls, a)-    where ls = getReverseLensStack stck-          a  = compStack (mapThrist hCont stck) b----- | Return a SavedPath type encapsulating the current location in the Zipper.--- This lets you return to a location in your data type after closing the --- Zipper.-save :: Zipper a b -> SavedPath a b-save = fst . closeSaving---- | Extract a composed lens that points to the location we SavedPath. This lets --- us modify, set or get a location that we visited with our Zipper after --- closing the Zipper.-savedLens :: (Typeable a, Typeable b)=> SavedPath a b -> (a :-> b)-savedLens = compStack . mapThrist tLens . savedLenses----- | Return to a previously SavedPath location within a data-structure. --- Saving and restoring lets us for example: find some location within our --- structure using a Zipper, save the location, fmap over the entire structure,--- and then return to where we were:-restore :: (ZPath p, Typeable a, Typeable b)=> p a b -> a -> Zipper a b-restore s = moveTo s  . zipper----- | returns True if Zipper is at the top level of the data structure:-atTop :: Zipper a b -> Bool-atTop = nullThrist . stack--{---- | Return our depth in the Zipper. if atTop z then level z == 0-level :: Zipper a b -> Int-level = foldlThrist (.) ...forgot how to do this :(--}--------------------------------------------------------------------------------    -----------------    -- CONVENIENCE-    -------------------- | a view function for a Zipper's focus. Defined simply as: `getL` focus-viewf :: Zipper a b -> b-viewf = getL focus---- | a simple type synonym for a Zipper where the type at the focus is the--- same as the type of the outer (unzippered) type. Cleans up type signatures--- for simple recursive types:-type Zipper1 a = Zipper a a----- bind higher than <$>. Is this acceptable?:-infixl 5 .+, .>, .-, ?+, ?>, ?----- | 'moveTo' with arguments flipped. Operator plays on the idea of addition of--- levels onto the focus.-(.+) :: (ZPath p, Typeable b, Typeable c)=> Zipper a b -> p b c -> Zipper a c-(.+) = flip moveTo---- | 'moveUp' with arguments flipped. Operator syntax comes from the idea of--- moving up as subtraction.-(.-) :: (Typeable c, Typeable b)=> Zipper a c -> Int -> Maybe (Zipper a b)-(.-) = flip moveUp---- | setL focus, with arguments flipped-(.>) :: Zipper a b -> b -> Zipper a b-(.>) = flip (setL focus)--(?+) :: (ZPath p, Typeable b, Typeable c)=> Maybe (Zipper a b) -> p b c -> Maybe (Zipper a c)-(?+)= flip (fmap . moveTo)--(?-) :: (Typeable c, Typeable b)=> Maybe (Zipper a c) -> Int -> Maybe (Zipper a b)-mz ?- n = mz >>= moveUp n--(?>) :: Maybe (Zipper a b) -> b -> Maybe (Zipper a b)-(?>) = flip (fmap . setL focus)---    -------------    -- HELPERS-    -------------- -- The core of our 'moveTo' function-pivot (Z t a') (TL l) = Z (Cons h t) b-    where h = H l (a' `missing` l)-          b = getL l a'-           --TODO: MAYBE GIVE THE GC SOME STRICTNESS HINTS HERE?:-          missing a l = flip (setL l) a--- -- fold a thrist into a single category by composing the stack with (.)- -- Here 'cat' will be either (->) or (:->):-compStack :: (Category cat)=> Thrist cat b a -> cat b a-compStack = foldrThrist (flip(.)) id--- -- Takes the zipper stack and extracts each lens segment, and recomposes- -- them in reversed order, forming a lens from top to bottom of a data - -- structure:-getReverseLensStack :: ZipperStack b a -> Thrist TypeableLens a b-getReverseLensStack = unflip . foldlThrist revLocal (Flipped Nil)-    --where rev (Flipped t) (H l _) = Flipped $ Cons (TL l) t--- MAKING THIS GLOBAL SHOULD PLEASE GHC 7.0 WITHOUT EXTRA EXTENSIONS. SEE:---      http://hackage.haskell.org/trac/ghc/blog/LetGeneralisationInGhc7-revLocal (Flipped t) (H l _) = Flipped $ Cons (TL l) t

@@ -1,136 +0,0 @@-> {-# LANGUAGE TemplateHaskell, DeriveDataTypeable, TypeOperators, ViewPatterns #-}--The first three extensions above are almost always required when using 'pez':-    - TemplateHaskell for generating lenses via Data.Record.Label-    - TypeOperators for infix (:->) from 'fclabels' package-    - DeriveDataTypeable for deriving Typeable on user-defined types--We also use ViewPatterns which are useful for pattern matching on our zipper's-focus.--> module Main->    where--    Import the 'pez' library (which also brings in Data.Record.Label and-Data.Typeable:--> import Data.Typeable.Zipper-> import Control.Applicative---    -------------------------------------       EXAMPLE 1: -           A binary tree-    ---------------------------------------    We define a simple binary search tree, deriving its Typeable instance.-Typeable "reify"s the type of some data, basically bringing some of the -type system into the world of data.-    Further, we create accessor functions starting with an underdash. This-will let the 'fclabels' package generate lenses for our tree. See below.--> data Tree a = Node { _leftNode :: Tree a, ->                      _val      :: a, ->                      _rightNode :: Tree a }->             | Nil  ->             deriving (Typeable,Show)-            --    Now we use some templete haskell provided by 'fclabels' to generate our-lenses. We use these lenses to refer to children nodes we would like to move-to.-    The code below will automatically create lenses named "leftNode", -"rightNode", and "val" at compile time. You can see their types in ghci.--> $(mkLabelsNoTypes [''Tree])---At this point we have everything we need to work with `Tree` in a Zipper! Let's -try it out on an example `Tree` that looks like...--                b-               / \-              a   c--> tree = Node (Node Nil 'a' Nil) 'b' (Node Nil 'c' Nil)--Let's use our zipper to apply a clockwise rotation (a rebalancing procedure) -on the leftmost node, which in the case of the tree above would produce...--              a-               \-                b-                 \-                  c---> rotateLeftmost :: Tree Char -> Maybe (Tree Char)-> rotateLeftmost = fmap close . (doRotation =<<) . moveUp 1 . descend . zipper->         -- travel down the left side of the tree, until reaching a Nil branch:->     where descend z@(viewf-> Nil) = z->           descend z               = descend $ moveTo leftNode z->->            -- use the Zipper1 type synonym for brevity when outer constructor->            -- is the same as the focus:->           doRotation :: Zipper1 (Tree Char) -> Maybe (Zipper1 (Tree Char))->           doRotation z1@(viewf->Node l1 a1 r1) = do->                -- navigate up one level in the zipper:->               z0 <- moveUp 1 $ setL focus Nil z1->                -- perform clockwise rotation:->               let (Node _  a0 r0) = viewf z0->                   z0' = setL focus (Node l1 a1 $ Node r1 a0 r0) z0->               return z0'---    -------------------------------------       EXAMPLE 1b: -           Monadic interface-    --------------------------------------  The code above would be a little less clunky if we used a State monad.-Specifically, we will use the State / Maybe monad transformer, and see how-the code above looks:--... > type ZipperState a = StateT (Zipper1 (Tree Char)) Maybe a-...todo when we finish the monadic interface---    -------------------------------------       EXAMPLE 2-           Mutually-recursive types-    --------------------------------------Typeable allows us to define 'moveUp' on mutually-recursive data types, when we-wouldn't otherwise be able to make such a function type-check. It falls on the-module user to make sure that a 'moveUp' will land us at the type we were-expecting. Here is an example:--> newtype Timer = Timer { tickTocks :: Tick } deriving Show->-> data Tick = Tick { _tock :: Tock }->           | Claaaannnnggg deriving (Show, Typeable)->-> data Tock = Tock { _tick :: Tick } deriving (Show, Typeable)->-> timer = Timer $ Tick $ Tock $ Tick $ Tock $ Claaaannnnggg--Once again we will generate the labels for the types we will pass through with-our zipper:--> $(mkLabelsNoTypes [''Tick, ''Tock])---Let's make a function that shortens the timer by one tick-tock pair. We'll also-demonstrate some of the convenience operators for moving and setting the focus,-these may change or disappear if I decide they are a bad idea:--> shortenTimer :: Timer -> Maybe Timer-> shortenTimer = fmap (Timer . close) . shortenTick . zipper . tickTocks->     where shortenTick z@(viewf-> Claaaannnnggg) = ->               z .- 2 ?> Claaaannnnggg->           shortenTick z = shortenTick (z .+ tock .+ tick)--The function above would have returned Nothing from 'moveUp' had the timer not -had at least one Tick-Tock pair, OR should we have arrived by moving up at a-type we were not expecting.

@@ -0,0 +1,34 @@+{-# LANGUAGE TypeOperators #-}+module PreludeLenses+    where++import Data.Label.Maybe+import qualified Data.Label.Abstract as A+import Control.Arrow+++-- First class labels pre-defined for the standard types from haskell's prelude++-- | [a]+lHead :: [a] :~> a+lHead = lens getHead (\h-> Just . (h:))+    where getHead (h:_) = Just h+          getHead []    = Nothing++lTail :: [a] :~> [a]+lTail = lens getTail setTail+    where setTail t (h:_) = Just $ h:t+          setTail t []    = Nothing++          getTail (_:t) = Just t+          getTail []    = Nothing++-- | (a,b)+--lFst :: (a,b) :~> a+--lFst = lens fst (\a (_,b)-> (a,b))+lFst :: Arrow (~>) => A.Lens (~>) (a,b) a+lFst = A.lens (arr fst) (arr $ \(a, (_,b))-> (a,b))++--lSnd :: (a,b) :-> b+lSnd :: Arrow (~>) => A.Lens (~>) (a,b) b+lSnd = A.lens (arr snd) (arr $ \(b, (a,_))-> (a,b))

@@ -1,121 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, ViewPatterns #-}-module Main-    where--import Test.QuickCheck-import Data.Typeable.Zipper-import Data.Record.Label.Prelude--{-- - These tests are vital, since with all the dynamic magic we're using, a- - function that compiles could very well not actually work- -}---- a linear, mutually recursive type:-data Tick = Tick { _tock :: Tock }-          | Gong -          deriving (Typeable, Eq, Show)--data Tock = LoudTock { _tick :: Tick }-          | SoftTock { _tick :: Tick }-          deriving (Typeable, Eq, Show)--newtype TickTock = TT { _tickTocks :: Tick }-                   deriving (Typeable, Eq, Show)--$(mkLabelsNoTypes [''TickTock, ''Tock, ''Tick])--instance Arbitrary TickTock where-    arbitrary = fmap TT arbTick where-        arbTick = do-            n <- choose (1,2) :: Gen Int-            case n of-                 1 -> fmap Tick arbTock-                 2 -> return Gong--        arbTock = do-            to <- elements [LoudTock, SoftTock]-            ti <- arbTick-            return $ to ti---{---- a simple binary tree:-data Tree a = Branch (Tree a) (Tree a) -            | Leaf a-            deriving (Typeable, Eq)--}---- we also test on simple lists -- -- Don't know the appropriate way to run batch job:-main = sequence_-        [ quickCheck prop_simple_creation-        , quickCheck prop_simple_recursive_movement-        , quickCheck prop_mutual_saving-        , quickCheck prop_simple_moveUp_past_top-        , quickCheck prop_moveUpSaving-        ]--prop_simple_creation :: [Char] -> Bool-prop_simple_creation a = -    let z = zipper a-        f = viewf z                           -        a' = close z                          -     in a == f && a == a'--prop_simple_recursive_movement i =-    let i' = abs i `mod` 50 :: Int-        l = replicate i' () -         -- test simple descending-        descend 0 z | null $ viewf z = maybe False atTop $  ascend i' z-                    | otherwise = False-        descend n z = descend (n-1) (moveTo lTail z)--         -- test ascending by two and one:-        ascend 0 z = return z-        ascend 1 z = moveUp 1 z-        ascend n z = moveUp 2 z >>= ascend (n-2)-     in descend i' $ zipper l---prop_mutual_saving :: TickTock -> Bool-prop_mutual_saving tt = checkSaving $ descend $ moveTo tickTocks $ zipper tt-    where descend z@(viewf -> Gong) = z-          descend z = descendTock $ moveTo tock z-          descendTock = descend . moveTo tick-          checkSaving z = -              let (p,a) = closeSaving z-                  z' = restore p a-                  lns = savedLens p-               -- closed zipper is equal to original, -               in a == tt && -               -- restoring brings us back to the end-                  viewf z' == Gong && -               -- lens rebuilt from SavedPath is equivalent-                  getL lns tt == Gong &&-               -- moving to rebuilt lens and moving up gets us back to top:-                  (maybe False ((==tt) . viewf) $ -                      moveUp 1 $ moveTo lns $ zipper tt)---- check moveUpSaving & Nothing returned from failed cast:-prop_moveUpSaving :: ((),((),(Int,Int))) -> Bool-prop_moveUpSaving = -   check . moveTo lSnd . moveTo lSnd . moveTo lSnd . zipper -       where check z = maybe False id $ do-                 (z', p') <- moveUpSaving 2 z-                 let n = viewf z -                     -- otherwise type is ambiguous:-                     typeofz' = z' :: Zipper ((),((),(Int,Int))) ((),(Int,Int))-                     n' = viewf $ moveTo p' z'-                 -- we successfully moved up and back down again?:-                 return $ n == n'------ test moveUp past top of Zipper, -prop_simple_moveUp_past_top :: [Int] -> Bool-prop_simple_moveUp_past_top = check . moveUp 2 . moveTo lTail . zipper where-    -- this sig required else type ambiguous:-    check :: Maybe (Zipper1 [Int]) -> Bool-    check = maybe True (const False)

@@ -1,59 +1,31 @@ Name:                pez-Version:             0.0.4-Synopsis:            A Potentially-Excellent Zipper library-Homepage:            http://coder.bsimmons.name/blog/2011/04/pez-zipper-library-released/+Version:             0.1.0+Synopsis:            A Pretty Extraordinary Zipper library+Homepage:            http://brandon.si/code/pez-zipper-library-released/ -Description:         PEZ is a generic zipper library. It uses lenses from the 'fclabels' package to-                     reference a "location" to move to in the zipper. The zipper is restricted to-                     types in the Typeable class, allowing the user to "move up" through complex data+Description:         PEZ is a generic zipper library. It uses lenses from the "fclabels" package to+                     reference a \"location\" to move to in the zipper. The zipper is restricted to+                     types in the 'Typeable' class, allowing the user to \"move up\" through complex data                      structures such as mutually-recursive types.                      .                      Both the Typeable class and fclabels lenses can be derived in GHC, making it                      easy for the programmer to use a zipper with a minimum of boilerplate.                      .-                     First import the library, which brings in the Typeable and fclabels modules.-                     You will also want to enable a few extensions:-                     .-                     > -- Put these in a LANGUAGE pragma:-                     > -- TemplateHaskell, DeriveDataTypeable, TypeOperators -                     > module Main where-                     >-                     > import Data.Typeable.Zipper-                     .-                     Create a datatype, deriving an instance of the Typeable class, and generate a-                     lens using functions from fclabels:-                     .-                     > data Tree a = Node { -                     >     _leftNode :: Tree a-                     >   , _val      :: a -                     >   , _rightNode :: Tree a }-                     >   | Nil  -                     >   deriving (Typeable,Show)-                     >-                     > $(mkLabelsNoTypes [''Tree])-                     .-                     Now we can go crazy using Tree in a Zipper:-                     .-                     > treeBCD = Node (Node Nil 'b' Nil) 'c' (Node Nil 'd' Nil)-                     > -                     > descendLeft :: Zipper1 (Tree a) -> Zipper1 (Tree a)-                     > descendLeft z = case (viewf z) of-                     >                      Nil -> z-                     >                      _   -> descendLeft $ moveTo leftNode z-                     >-                     > insertLeftmost :: a -> Tree a -> Tree a-                     > insertLeftmost x = close . setL focus x . descendLeft . zipper-                     >-                     > treeABCD = insertLeftmost 'a' treeBCD+                     Please send any feature requests or bug reports along.                      .-                     Because of the flexibility of fclabels, this zipper library can be used to-                     express moving about in reversible computations simply by defining such a lens,-                     for instance:+                     Changes 0.0.4 -> 0.1.0:                      .-                     > stringRep :: (Show b, Read b) => b :-> String-                     > stringRep = lens show (const . read)+                     >  - use fclabels 1.0+                     >  - module renamed Data.Label.Zipper+                     >  - 'ZPath' renamed 'Motion', define new Up type and instance+                     >  - fclabels lenses now require wrapping with 'to'+                     >  - 'moveTo' changed to 'move'+                     >  - savedLens renamed flatten+                     >  - SavedPath renamed To+                     >  - removed experimental operators+                     >  - using failure package for exceptions+                     >  - etc., etc.                      .-                     Please send any feature requests or bug reports along.    License:             BSD3@@ -71,26 +43,48 @@  -- Extra files to be distributed with the package, such as examples or -- a README.-Extra-source-files:  EXAMPLES/Examples.lhs, Tests.hs+--Extra-source-files:  EXAMPLES/Examples.lhs, PreludeLenses.hs+Extra-source-files:  PreludeLenses.hs  -- Constraint on the version of Cabal needed to build this package.-Cabal-version:       >=1.2.3+Cabal-version:       >=1.8 +source-repository head   +    type:     git+    location: https://github.com/jberryman/pez.git+    branch:   master ++Test-Suite zipper-tests+    Type:                 exitcode-stdio-1.0+    Main-is:              Tests.hs+    Build-depends:        base, QuickCheck, test-framework, test-framework-quickcheck2+    --GHC-Options:          -fhpc -hpcdir dist/test/ -fforce-recomp+    -- then run:+    --     $ hpc markup --hpcdir=dist/test/ --destdir=dist/hpc/ zipper-tests.tix++ Library   -- Modules exported by the library.-  Exposed-modules:     Data.Typeable.Zipper-  +  Exposed-modules:     Data.Label.Zipper+ +  GHC-Options:         -Wall+   -- Packages needed in order to build this package.   Build-depends:       base >= 4 && < 5-                     , fclabels >= 0.11.1.1 && < 0.12+                     , fclabels >= 1.0 && < 1.2                      , thrist >= 0.2 && < 0.3+                     , failure >= 0.1    Extensions:        GeneralizedNewtypeDeriving                    , TypeOperators                    , TemplateHaskell                    , GADTs                    , DeriveDataTypeable+                   , TupleSections+                   , FlexibleInstances+                   , MultiParamTypeClasses+                   , FunctionalDependencies      -- Modules not exported by this package.-  Other-modules:     Data.Record.Label.Prelude  +  --Other-modules:     Data.Record.Label.Prelude