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

Ok, what I initially thought would work is not.  I tried to do the three way merge as follows:

combine3 :: (Data a) => a -> a -> a -> Maybe a
combine3 original left right =
    gzip3 f original left right
    where
      f :: forall a. (Data a) => a -> a -> a -> Maybe a
      f original left right
          | geq original left = Just right
          | geq original right = Just left
          | geq left right = Just left
          | otherwise = Nothing

However, what happens is that we usually reach the otherwise clause when processing the top level of the data structure, so you get nothing.  What really needs to happen is that it traverses down into the data structure and finds out that f is able to merge all the more primitive pieces of the data structure, in which case it combines those merged parts to yield a merged whole.  I'm not quite sure how to fit this operation into the generic framework.