diff --git a/Data/Label/Zipper.hs b/Data/Label/Zipper.hs new file mode 100644 --- /dev/null +++ b/Data/Label/Zipper.hs @@ -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 diff --git a/Data/Record/Label/Prelude.hs b/Data/Record/Label/Prelude.hs deleted file mode 100644 --- a/Data/Record/Label/Prelude.hs +++ /dev/null @@ -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)) diff --git a/Data/Typeable/Zipper.hs b/Data/Typeable/Zipper.hs deleted file mode 100644 --- a/Data/Typeable/Zipper.hs +++ /dev/null @@ -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 diff --git a/EXAMPLES/Examples.lhs b/EXAMPLES/Examples.lhs deleted file mode 100644 --- a/EXAMPLES/Examples.lhs +++ /dev/null @@ -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. diff --git a/PreludeLenses.hs b/PreludeLenses.hs new file mode 100644 --- /dev/null +++ b/PreludeLenses.hs @@ -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)) diff --git a/Tests.hs b/Tests.hs deleted file mode 100644 --- a/Tests.hs +++ /dev/null @@ -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) diff --git a/pez.cabal b/pez.cabal --- a/pez.cabal +++ b/pez.cabal @@ -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