I definitely think these functions should be added to syb.  I certainly could not have written them myself without hours, perhaps days, of study.<br><br><div class="gmail_quote">2009/6/2 José Pedro Magalhães <span dir="ltr">&lt;<a href="mailto:jpm@cs.uu.nl">jpm@cs.uu.nl</a>&gt;</span><br>
<blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">Hello,<br><br>Would there be interest in having this function added to the SYB library?<br><br>
<br>Thanks,<br>Pedro<br><br><div class="gmail_quote"><div><div></div><div class="h5">On Tue, Jun 2, 2009 at 00:40, Ralf Laemmel <span dir="ltr">&lt;<a href="mailto:rlaemmel@gmail.com" target="_blank">rlaemmel@gmail.com</a>&gt;</span> wrote:<br>


</div></div><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;"><div><div></div><div class="h5"><div>&gt; Thank you!  What I have in mind is three way merging - you have two<br>



&gt; revisions based on the same original value, and you need to decide whether<br>
&gt; they can be merged automatically or they need to be merged by a user.  You<br>
&gt; only have a real conflict when both revisions differ from the original and<br>
&gt; from each other.<br>
<br>
</div>Here is the completed exercise.<br>
For comparison, the two args versions are shown up-front.<br>
There is gzipWithM3 needed for gzip3, and gzip3 itself.<br>
I also made it so that the top-level gzip functions have the<br>
appropriate polymorphism.<br>
Say same type for the args rather than independent polymorphism.<br>
<br>
{-# LANGUAGE RankNTypes #-}<br>
<div><br>
import Prelude hiding (GT)<br>
import Data.Generics<br>
<br>
-- As originally defined: Twin map for transformation<br>
<br>
gzipWithT2 :: GenericQ (GenericT) -&gt; GenericQ (GenericT)<br>
gzipWithT2 f x y = case gmapAccumT perkid funs y of<br>
                    ([], c) -&gt; c<br>
                    _       -&gt; error &quot;gzipWithT2&quot;<br>
 where<br>
  perkid a d = (tail a, unGT (head a) d)<br>
  funs = gmapQ (\k -&gt; GT (f k)) x<br>
<br>
<br>
-- As originally defined: Twin map for transformation<br>
<br>
</div>gzipWithM2 :: Monad m =&gt; GenericQ (GenericM m) -&gt; GenericQ (GenericM m)<br>
gzipWithM2 f x y = case gmapAccumM perkid funs y of<br>
                    ([], c) -&gt; c<br>
                    _       -&gt; error &quot;gzipWithM&quot;<br>
 where<br>
  perkid a d = (tail a, unGM (head a) d)<br>
  funs = gmapQ (\k -&gt; GM (f k)) x<br>
<br>
<br>
-- As originally defined: generic zip<br>
<br>
gzip2 ::<br>
    (forall x. Data x =&gt; x -&gt; x -&gt; Maybe x)<br>
 -&gt; (forall x. Data x =&gt; x -&gt; x -&gt; Maybe x)<br>
<br>
gzip2 f = gzip2&#39; f&#39;<br>
 where<br>
  f&#39; :: GenericQ (GenericM Maybe)<br>
  f&#39; x y = cast x &gt;&gt;= \x&#39; -&gt; f x&#39; y<br>
  gzip2&#39; :: GenericQ (GenericM Maybe) -&gt; GenericQ (GenericM Maybe)<br>
  gzip2&#39; f x y =<br>
    f x y<br>
    `orElse`<br>
    if toConstr x == toConstr y<br>
      then gzipWithM2 (gzip2&#39; f) x y<br>
      else Nothing<br>
<div><br>
<br>
-- For three args now<br>
<br>
gzipWithT3 ::<br>
    GenericQ (GenericQ (GenericT))<br>
 -&gt; GenericQ (GenericQ (GenericT))<br>
gzipWithT3 f x y z =<br>
    case gmapAccumT perkid funs z of<br>
      ([], c) -&gt; c<br>
      _       -&gt; error &quot;gzipWithT3&quot;<br>
 where<br>
  perkid a d = (tail a, unGT (head a) d)<br>
  funs = case gmapAccumQ perkid&#39; funs&#39; y of<br>
           ([], q) -&gt; q<br>
           _       -&gt; error &quot;gzipWithT3&quot;<br>
   where<br>
    perkid&#39; a d = (tail a, unGQ (head a) d)<br>
    funs&#39; = gmapQ (\k -&gt; (GQ (\k&#39; -&gt; GT (f k k&#39;)))) x<br>
<br>
</div>gzipWithM3 :: Monad m<br>
 =&gt; GenericQ (GenericQ (GenericM m))<br>
 -&gt; GenericQ (GenericQ (GenericM m))<br>
gzipWithM3 f x y z =<br>
    case gmapAccumM perkid funs z of<br>
      ([], c) -&gt; c<br>
      _       -&gt; error &quot;gzipWithM3&quot;<br>
 where<br>
  perkid a d = (tail a, unGM (head a) d)<br>
<div>  funs = case gmapAccumQ perkid&#39; funs&#39; y of<br>
           ([], q) -&gt; q<br>
</div>           _       -&gt; error &quot;gzipWithM3&quot;<br>
<div>   where<br>
    perkid&#39; a d = (tail a, unGQ (head a) d)<br>
</div>    funs&#39; = gmapQ (\k -&gt; (GQ (\k&#39; -&gt; GM (f k k&#39;)))) x<br>
<br>
gzip3 ::<br>
    (forall x. Data x =&gt; x -&gt; x -&gt; x -&gt; Maybe x)<br>
 -&gt; (forall x. Data x =&gt; x -&gt; x -&gt; x -&gt; Maybe x)<br>
<br>
gzip3 f = gzip3&#39; f&#39;<br>
 where<br>
  f&#39; :: GenericQ (GenericQ (GenericM Maybe))<br>
  f&#39; x y z = cast x &gt;&gt;= \x&#39; -&gt; cast y &gt;&gt;= \y&#39; -&gt; f x&#39; y&#39; z<br>
  gzip3&#39; ::<br>
       GenericQ (GenericQ (GenericM Maybe))<br>
    -&gt; GenericQ (GenericQ (GenericM Maybe))<br>
  gzip3&#39; f x y z =<br>
    f x y z<br>
    `orElse`<br>
    if and [toConstr x == toConstr y, toConstr y == toConstr z]<br>
      then gzipWithM3 (gzip3&#39; f) x y z<br>
      else Nothing<br>
</div></div><div><div></div><div>_______________________________________________<br>
Haskell mailing list<br>
<a href="mailto:Haskell@haskell.org" target="_blank">Haskell@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell" target="_blank">http://www.haskell.org/mailman/listinfo/haskell</a><br>
</div></div></blockquote></div><br>
<br>_______________________________________________<br>
Haskell mailing list<br>
<a href="mailto:Haskell@haskell.org">Haskell@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell" target="_blank">http://www.haskell.org/mailman/listinfo/haskell</a><br>
<br></blockquote></div><br>