Skip to content

Instantly share code, notes, and snippets.

@llelf
Created April 2, 2013 07:15
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save llelf/5290470 to your computer and use it in GitHub Desktop.
Save llelf/5290470 to your computer and use it in GitHub Desktop.
{-# LANGUAGE DeriveDataTypeable #-}
import Data.Generics.Zipper
import Data.Data
-- | our tree def
data Tree a = Empty | Fork a (Tree a) (Tree a)
deriving (Typeable,Data)
-- | how we print it
instance Show a => Show (Tree a) where
show Empty = ""
show (Fork x l r) = show x ++ sub "L" l ++ sub "R" r
where sub _ Empty = ""
sub s t = "-" ++ s ++ "(" ++ show t ++ ")"
-- example
t :: Tree Int
t = Fork 0 (Fork 1 Empty Empty) (Fork 2 (Fork 3 Empty Empty) (Fork 4 Empty Empty))
-- zipper (by magic)
z = toZipper t
pp :: Maybe (Zipper (Tree Int)) -> Maybe (Tree Int)
pp (Just z) = getHole z
{- In interpreter:
H> pp $ Just z
Just 0-L(1)-R(2-L(3)-R(4))
H> pp $ Just z >>= down
Just 2-L(3)-R(4)
H> pp $ Just z >>= down >>= left
Just 1
H> pp $ Just z >>= down >>= left >>= right
Just 2-L(3)-R(4)
H> pp $ Just z >>= down >>= left >>= right >>= down
Just 4
H> pp $ Just z >>= down >>= left >>= right >>= down >>= left
Just 3
H> pp $ Just z >>= down >>= left >>= right >>= down >>= left >>= up
Just 2-L(3)-R(4)
H> pp $ Just z >>= down >>= left >>= right >>= down >>= left >>= up >>= left
Just 1
-}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment