Ok, here is another piece of the three way merging puzzle.  The gzip3 function can do three
way merging when there are no conflicts that need to be resolved manually.  When there are
such conflicts we need a user interface which displays the common ancestor, the two alternative
edits, and provides a place to input the merged result.  For this we are using a generic
programming interface to formlets .  Formlets are members of class Applicative, so we can write
a function to turn a value into a formlet using a gmapA function (this is syb-with-class generics):

  type GenericA f ctx = forall a. (Applicative f, Data ctx a) => a -> f a

  gmapA :: (Applicative f) => Proxy ctx -> GenericA f ctx -> GenericA f ctx
  gmapA ctx f =
    gfoldl ctx k pure
    where k c x = c <*> (f x)

Then the formlet for a value is created using something like this:

  gmapA formletOfProxy (formletOfD dict) x

For three way merging, though, we need to turn three values of the same type into a formlet,
something like a gmap3A function:

  gmap3A formletOfProxy (formletOfD dict) ancestor variant1 variant2

Its this gmap3A function that I'm unable to create.  I'm hoping someone out there will find this
a piece of cake...

On Mon, Jun 1, 2009 at 3:40 PM, Ralf Laemmel <rlaemmel@gmail.com> wrote:

> Thank you!  What I have in mind is three way merging - you have two
> revisions based on the same original value, and you need to decide whether
> they can be merged automatically or they need to be merged by a user.  You
> only have a real conflict when both revisions differ from the original and
> from each other.

Here is the completed exercise.
For comparison, the two args versions are shown up-front.
There is gzipWithM3 needed for gzip3, and gzip3 itself.
I also made it so that the top-level gzip functions have the
appropriate polymorphism.
Say same type for the args rather than independent polymorphism.

{-# LANGUAGE RankNTypes #-}

import Prelude hiding (GT)
import Data.Generics

-- As originally defined: Twin map for transformation

gzipWithT2 :: GenericQ (GenericT) -> GenericQ (GenericT)
gzipWithT2 f x y = case gmapAccumT perkid funs y of
                   ([], c) -> c
                   _       -> error "gzipWithT2"
 where
 perkid a d = (tail a, unGT (head a) d)
 funs = gmapQ (\k -> GT (f k)) x


-- As originally defined: Twin map for transformation

gzipWithM2 :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
gzipWithM2 f x y = case gmapAccumM perkid funs y of
                   ([], c) -> c
                   _       -> error "gzipWithM"
 where
 perkid a d = (tail a, unGM (head a) d)
 funs = gmapQ (\k -> GM (f k)) x


-- As originally defined: generic zip

gzip2 ::
   (forall x. Data x => x -> x -> Maybe x)
 -> (forall x. Data x => x -> x -> Maybe x)

gzip2 f = gzip2' f'
 where
 f' :: GenericQ (GenericM Maybe)
 f' x y = cast x >>= \x' -> f x' y
 gzip2' :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe)
 gzip2' f x y =
   f x y
   `orElse`
   if toConstr x == toConstr y
     then gzipWithM2 (gzip2' f) x y
     else Nothing

-- For three args now

gzipWithT3 ::
   GenericQ (GenericQ (GenericT))
 -> GenericQ (GenericQ (GenericT))
gzipWithT3 f x y z =
   case gmapAccumT perkid funs z of
     ([], c) -> c
     _       -> error "gzipWithT3"
 where
 perkid a d = (tail a, unGT (head a) d)
 funs = case gmapAccumQ perkid' funs' y of
          ([], q) -> q
          _       -> error "gzipWithT3"
  where
   perkid' a d = (tail a, unGQ (head a) d)
   funs' = gmapQ (\k -> (GQ (\k' -> GT (f k k')))) x

gzipWithM3 :: Monad m
 => GenericQ (GenericQ (GenericM m))
 -> GenericQ (GenericQ (GenericM m))
gzipWithM3 f x y z =
   case gmapAccumM perkid funs z of
     ([], c) -> c
     _       -> error "gzipWithM3"
 where
 perkid a d = (tail a, unGM (head a) d)

 funs = case gmapAccumQ perkid' funs' y of
          ([], q) -> q

          _       -> error "gzipWithM3"

  where
   perkid' a d = (tail a, unGQ (head a) d)

   funs' = gmapQ (\k -> (GQ (\k' -> GM (f k k')))) x

gzip3 ::
   (forall x. Data x => x -> x -> x -> Maybe x)
 -> (forall x. Data x => x -> x -> x -> Maybe x)

gzip3 f = gzip3' f'
 where
 f' :: GenericQ (GenericQ (GenericM Maybe))
 f' x y z = cast x >>= \x' -> cast y >>= \y' -> f x' y' z
 gzip3' ::
      GenericQ (GenericQ (GenericM Maybe))
   -> GenericQ (GenericQ (GenericM Maybe))
 gzip3' f x y z =
   f x y z
   `orElse`
   if and [toConstr x == toConstr y, toConstr y == toConstr z]
     then gzipWithM3 (gzip3' f) x y z
     else Nothing