# Zipper monad

### From HaskellWiki

The TravelTree Monad is a monad proposed and designed by Paolo Martini (xerox), and coded by David House (davidhouse). It is based on the State monad and is used for navigating around data structures, using the concept of Zipper.

As the only zipper currently available is for binary trees, this is what most of the article will be centred around.

## Contents |

## 1 Definition

newtype Travel t a = Travel { unT :: State t a } deriving (Functor, Monad, MonadState t) type TravelTree a = Travel (Loc a) (Tree a) -- for trees

data Tree a = Leaf a | Branch (Tree a) (Tree a) data Cxt a = Top | L (Cxt a) (Tree a) | R (Tree a) (Cxt a) deriving (Show) type Loc a = (Tree a, Cxt a)

## 2 Functions

### 2.1 Moving around

There are four main functions for stringing togetherleft, -- moves down a level, through the left branch right, -- moves down a level, through the right branch up, -- moves to the node's parent top -- moves to the top node :: TravelTree a

All four return the subtree at the new location.

### 2.2 Mutation

There are also functions available for changing the tree:

getTree :: TravelTree a putTree :: Tree a -> TravelTree a modifyTree :: (Tree a -> Tree a) -> TravelTree a

### 2.3 Exit points

To get out of the monad, usetraverse :: Tree a -> TravelTree a -> Tree a

## 3 Examples

The following examples use as the example tree:

t = Branch (Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 3)) (Branch (Leaf 4) (Leaf 5))

### 3.1 A simple path

This is a very simple example showing how to use the movement functions:

leftLeftRight :: TravelTree a leftLeftRight = do left left right

Result of evaluation:

*Tree> t `traverse` leftLeftRight Leaf 2

### 3.2 Tree reverser

This is a more in-depth example showingThe algorithm *reverses* the tree, in the sense that at every branch, the two subtrees are swapped over.

revTree :: Tree a -> Tree a revTree t = t `traverse` revTree' where revTree' :: TravelTree a revTree' = do t <- getTree case t of Branch _ _ -> do left l' <- revTree' up right r' <- revTree' up putTree $ Branch r' l' Leaf x -> return $ Leaf x -- without using the zipper: revTreeZipless :: Tree a -> Tree a revTreeZipless (Leaf x) = Leaf x revTreeZipless (Branch xs ys) = Branch (revTreeZipless ys) (revTreeZipless xs)

Result of evaluation:

*Tree> revTree $ Branch (Leaf 1) (Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 4)) Branch (Branch (Leaf 4) (Branch (Leaf 3) (Leaf 2))) (Leaf 1)

#### 3.2.1 Generalisation

Einar Karttunen (musasabi) suggested generalising this to a recursive tree combinator:

treeComb :: (a -> Tree a) -- what to put at leaves -> (Tree a -> Tree a -> Tree a) -- what to put at branches -> (Tree a -> Tree a) -- combinator function treeComb leaf branch = \t -> t `traverse` treeComb' where treeComb' = do t <- getTree case t of Branch _ _ -> do left l' <- treeComb' up right r' <- treeComb' up putTree $ branch l' r' Leaf x -> return $ leaf x

revTreeZipper :: Tree a -> Tree a revTreeZipper = treeComb Leaf (flip Branch)

sortSiblings :: Ord a => Tree a -> Tree a sortSiblings = treeComb Leaf minLeaves where minLeaves l@(Branch _ _) r@(Leaf _ ) = Branch r l minLeaves l@(Leaf _) r@(Branch _ _ ) = Branch l r minLeaves l@(Branch _ _) r@(Branch _ _ ) = Branch l r minLeaves l@(Leaf x) r@(Leaf y ) = Branch (Leaf $ min x y) (Leaf $ max x y)

Result of evaluation:

*Tree> sortSiblings t Branch (Branch (Leaf 3) (Branch (Leaf 1) (Leaf 2))) (Branch (Leaf 4) (Leaf 5))

## 4 Code

Here's the Zipper Monad in full:

module Zipper where -- A monad implementing The Zipper. -- http://haskell.org/haskellwiki/ZipperMonad -------------------------------------------------------------------------------- import Control.Monad.State import Control.Arrow (first, second) data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving (Show, Eq) data Cxt a = Top | L (Cxt a) (Tree a) | R (Tree a) (Cxt a) deriving (Show) type Loc a = (Tree a, Cxt a) newtype Travel t a = Travel { unT :: State t a } deriving (Functor, Monad, MonadState t) type TravelTree a = Travel (Loc a) (Tree a) -- Movement around the tree -- -- move down a level, through the left branch left :: TravelTree a left = modify left' >> liftM fst get where left' (Branch l r, c) = (l, L c r) -- move down a level, through the left branch right :: TravelTree a right = modify right' >> liftM fst get where right' (Branch l r, c) = (r, R l c) -- move to a node's parent up :: TravelTree a up = modify up' >> liftM fst get where up' (t, L c r) = (Branch t r, c) up' (t, R l c) = (Branch l t, c) -- move to the top node top :: TravelTree a top = modify (second $ const Top) >> liftM fst get -- Mutation of the tree -- -- modify the subtree at the current node modifyTree :: (Tree a -> Tree a) -> TravelTree a modifyTree f = modify (first f) >> liftM fst get -- put a new subtree at the current node putTree :: Tree a -> TravelTree a putTree t = modifyTree $ const t -- get the current node and its descendants getTree :: TravelTree a getTree = modifyTree id -- works because modifyTree returns the 'new' tree -- Exit points -- -- get out of the monad traverse :: Tree a -> TravelTree a -> Tree a traverse t tt = evalState (unT tt) (t, Top)