[Haskell-cafe] Why is there no Zippable class? Would this work?
Johan Jeuring
johanj at cs.uu.nl
Fri Jul 17 01:35:15 EDT 2009
> Why is there no Zippable class? There is.
>
> You can use Data.Zippable from http://hackage.haskell.org/package/bff.
>
> It gives you a function
>
> tryZip :: Zippable k => k a -> k b -> Either String (k (a,b))
>
> The Either in the return type is to capture an error message in case
> the
> two structures are not of the same shape.
This functionality can also be obtained from the generic programming
library EMGM,
with the function
zip :: FRep3 ZipWith f => f a -> f b -> Maybe (f (a, b))
You can use Template Haskell to generate the necessary FRep3
instances. Once you have
those you get many other generic functions for free.
See
http://hackage.haskell.org/package/emgm
-- Johan Jeuring
> For example, for
>
> data Tree a = Leaf a | Node (Tree a) (Tree a)
>
> you would have:
>
> instance Zippable Tree where
> tryZip (Leaf a) (Leaf b) = Right (Leaf (a,b))
> tryZip (Node a1 a2) (Node b1 b2) = do z1 <- tryZip a1 b1
> z2 <- tryZip a2 b2
> return (Node z1 z2)
> tryZip _ _ = Left "Structure mismatch."
>
> Of course, you can get an "unsafe" zip by composing tryZip with a
> fromRight.
>
> What's more, the mentioned package contains an automatic Template
> Haskell deriver for Zippable instances, so you don't have to write the
> above instance definition yourself.
>
> The implementation is by Joachim Breitner.
>
> Ciao,
> Janis.
>
> --
> Dr. Janis Voigtlaender
> http://wwwtcs.inf.tu-dresden.de/~voigt/
> mailto:voigt at tcs.inf.tu-dresden.de
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list