views:

487

answers:

2

So I've been reading a bit about the Zipper pattern in Haskell (and other functional languages, I suppose) to traverse and modify a data structure, and I thought that this would be a good chance for me to hone my skills at creating type classes in Haskell, since the class could present a common traversal interface for me to write code to, independent of the data structure traversed.

I thought I'd probably need two classes - one for the root data structure, and one for the special data structure created to traverse the first:

module Zipper where

class Zipper z where
  go'up :: z -> Maybe z
  go'down :: z -> Maybe z
  go'left :: z -> Maybe z
  go'right :: z -> Maybe z

class Zippable t where
  zipper :: (Zipper z) => t -> z
  get :: (Zipper z) => z -> t
  put :: (Zipper z) => z -> t -> z

But when I tried these with some simple datastructures like a list:

-- store a path through a list, with preceding elements stored in reverse
data ListZipper a = ListZipper { preceding :: [a], following :: [a] }

instance Zipper (ListZipper a) where
  go'up ListZipper { preceding = [] } = Nothing
  go'up ListZipper { preceding = a:ps, following = fs } = 
      Just $ ListZipper { preceding = ps, following = a:fs }
  go'down ListZipper { following = [] } = Nothing
  go'down ListZipper { preceding = ps, following = a:fs } = 
      Just $ ListZipper { preceding = a:ps, following = fs }
  go'left _ = Nothing
  go'right _ = Nothing

instance Zippable ([a]) where
  zipper as = ListZipper { preceding = [], following = as }
  get = following
  put z as = z { following = as }

Or a binary tree:

-- binary tree that only stores values at the leaves
data Tree a = Node { left'child :: Tree a, right'child :: Tree a } | Leaf a
-- store a path down a Tree, with branches not taken stored in reverse
data TreeZipper a = TreeZipper { branches :: [Either (Tree a) (Tree a)], subtree :: Tree a }

instance Zipper (TreeZipper a) where
  go'up TreeZipper { branches = [] } = Nothing
  go'up TreeZipper { branches = (Left l):bs, subtree = r } =  
      Just $ TreeZipper { branches = bs, subtree = Node { left'child = l, right'child = r } }
  go'up TreeZipper { branches = (Right r):bs, subtree = l } =  
      Just $ TreeZipper { branches = bs, subtree = Node { left'child = l, right'child = r } }
  go'down TreeZipper { subtree = Leaf a } = Nothing
  go'down TreeZipper { branches = bs, subtree = Node { left'child = l, right'child = r } } =
      Just $ TreeZipper { branches = (Right r):bs, subtree = l }
  go'left TreeZipper { branches = [] } = Nothing
  go'left TreeZipper { branches = (Right r):bs } = Nothing
  go'left TreeZipper { branches = (Left l):bs, subtree = r } =
      Just $ TreeZipper { branches = (Right r):bs, subtree = l }
  go'right TreeZipper { branches = [] } = Nothing
  go'right TreeZipper { branches = (Left l):bs } = Nothing
  go'right TreeZipper { branches = (Right r):bs, subtree = l } =
      Just $ TreeZipper { branches = (Left l):bs, subtree = r }

instance Zippable (Tree a) where
  zipper t = TreeZipper { branches = [], subtree = t }
  get TreeZipper { subtree = s } = s
  put z s = z { subtree = s }

I couldn't get it to compile, I'd just get a lot of errors like this for each of my Zippable instance definitions:

Zipper.hs:28:14:
    Couldn't match expected type `z'
           against inferred type `ListZipper a'
      `z' is a rigid type variable bound by
          the type signature for `zipper' at Zipper.hs:10:20
    In the expression: ListZipper {preceding = [], following = as}
    In the definition of `zipper':
        zipper as = ListZipper {preceding = [], following = as}
    In the definition for method `zipper'

So I'm not sure where to go from here. I suspect that my issue is that I'm trying to bind these two instances together, when the (Zipper z) => declaration just wants z to be any Zipper.

+7  A: 

(Aside: your go'up naming scheme is... inventive. Haskell style is usually camelCase.)

You're on the right track. What you've written is equivalent to the below.

{-# LANGUAGE RankNTypes #-}
instance Zippable [a] where
    zipper = ... :: forall z. (Zipper z) => [a] -> z
    get = ... :: forall z. (Zipper z) => z -> [a]
    set = ... :: forall z. (Zipper z) => z -> [a] -> z

(For all types z, given Zipper z, there exists a zipper :: [a] -> z.)

You're tring to define zipper = ... :: [a] -> ListZipper a, which is clearly too restrictive.

Your code will typecheck with the following minimal changes:

{-# LANGUAGE MultiParamTypeClasses #-}
class (Zipper z) => Zippable z t where
    zipper :: t -> z
    get :: z -> t
    set :: z -> t -> z
instance Zippable (ListZipper a) [a] where
    ...
instance Zippable (TreeZipper a) (Tree a) where
    ...

See multi-parameter type classes. It's a post-Haskell'98 extension, but Haskell implementations widely support it.

ephemient
+1/accepted - thank you very much! I'm slowly learning Haskell, and really haven't learned the naming conventions yet, but I'll get there.
rampion
OT: when should I use the apostrophe in names?
rampion
I have only seen it used as "prime". Like in `let x' = x + 1`. It should be used to name values that are slight modifications of old values.
SealedSun
Following http://en.wikipedia.org/wiki/Prime_(symbol) usage in mathematics, the apostrophe is only used at the end of names, and is used to name a related value.
ephemient
It's not always used to name modified old values, although that is common. In the standard library, foldl' is a stricter variant of foldl.
ephemient
Probably it's a good idea to add a functional dependency t->z to Zippable. Otherwise you will run into type ambiguities when you try to use these classes... (see also http://www.haskell.org/haskellwiki/Functional_dependencies)
sth
@sth: What I provided was just a minimal change to get the existing code to typecheck, but yes, `class (Zipper z) => Zippable z t | t -> z` would make the code more usable. I was hoping that OP would follow the link to multi-parameter type classes and read "Without functional dependencies or associated types, these multi-parameter type classes may cause too much ambiguity to pass the type-checker", but perhaps it would have been better to be more explicit.
ephemient
Much thanks sth, that helped me get past the wall I was banging my head against.
rampion
+5  A: 

You can also use type synonym families instead of multi-parameter type classes and functional dependencies. In cases like these they offer a cleaner and easier-to-understand solution. In that case the class and instance would become:

class Zippable t where
  type ZipperType t :: *
  enter :: t -> ZipperType t
  focus :: ZipperType t -> t

instance Zippable [a] where
  type ZipperType [a] = ListZipper a
  enter = ...
  focus = ...

Fun with type functions is an excellent introduction to type synonym families for people already familiar with Haskell. I also wrote an article on how type synonym families can often be used instead of functional dependencies a while ago.

Hope this helps!

Martijn
Type families were introduced around GHC 6.10.1 or so? I've yet to actually make use of them, but they seem handy.
ephemient
Excellent, thanks very much!
rampion