diff --git a/Data/Typeable/Zipper.hs b/Data/Typeable/Zipper.hs --- a/Data/Typeable/Zipper.hs +++ b/Data/Typeable/Zipper.hs @@ -66,6 +66,7 @@ - ROADMAP: - Pink Elephant - Patiently Expectant + - Pretty Extraordinary - Probably ?? - -} @@ -177,6 +178,7 @@ -- | 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') @@ -288,6 +290,8 @@ -- 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 rev (Flipped Nil) - where rev (Flipped t) (H l _) = Flipped $ Cons (TL l) t - +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.hs b/EXAMPLES/Examples.hs deleted file mode 100644 --- a/EXAMPLES/Examples.hs +++ /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/EXAMPLES/Examples.lhs b/EXAMPLES/Examples.lhs new file mode 100644 --- /dev/null +++ b/EXAMPLES/Examples.lhs @@ -0,0 +1,136 @@ +> {-# 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/pez.cabal b/pez.cabal --- a/pez.cabal +++ b/pez.cabal @@ -1,5 +1,5 @@ Name: pez -Version: 0.0.3 +Version: 0.0.4 Synopsis: A Potentially-Excellent Zipper library Homepage: http://coder.bsimmons.name/blog/2011/04/pez-zipper-library-released/ @@ -71,7 +71,7 @@ -- Extra files to be distributed with the package, such as examples or -- a README. -Extra-source-files: EXAMPLES/Examples.hs, Tests.hs +Extra-source-files: EXAMPLES/Examples.lhs, Tests.hs -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.2.3