<div class="gmail_quote">On Mon, Jun 1, 2009 at 3:40 PM, Ralf Laemmel <span dir="ltr"><<a href="mailto:rlaemmel@gmail.com">rlaemmel@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">
<div class="im">> Thank you! What I have in mind is three way merging - you have two<br>
> revisions based on the same original value, and you need to decide whether<br>
> they can be merged automatically or they need to be merged by a user. You<br>
> only have a real conflict when both revisions differ from the original and<br>
> 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 class="im"><br>
import Prelude hiding (GT)<br>
import Data.Generics<br>
<br>
-- As originally defined: Twin map for transformation<br>
<br>
gzipWithT2 :: GenericQ (GenericT) -> GenericQ (GenericT)<br>
gzipWithT2 f x y = case gmapAccumT perkid funs y of<br>
([], c) -> c<br>
_ -> error "gzipWithT2"<br>
where<br>
perkid a d = (tail a, unGT (head a) d)<br>
funs = gmapQ (\k -> GT (f k)) x<br>
<br>
<br>
-- As originally defined: Twin map for transformation<br>
<br>
</div>gzipWithM2 :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)<br>
gzipWithM2 f x y = case gmapAccumM perkid funs y of<br>
([], c) -> c<br>
_ -> error "gzipWithM"<br>
where<br>
perkid a d = (tail a, unGM (head a) d)<br>
funs = gmapQ (\k -> GM (f k)) x<br>
<br>
<br>
-- As originally defined: generic zip<br>
<br>
gzip2 ::<br>
(forall x. Data x => x -> x -> Maybe x)<br>
-> (forall x. Data x => x -> x -> Maybe x)<br>
<br>
gzip2 f = gzip2' f'<br>
where<br>
f' :: GenericQ (GenericM Maybe)<br>
f' x y = cast x >>= \x' -> f x' y<br>
gzip2' :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe)<br>
gzip2' f x y =<br>
f x y<br>
`orElse`<br>
if toConstr x == toConstr y<br>
then gzipWithM2 (gzip2' f) x y<br>
else Nothing<br>
<div class="im"><br>
<br>
-- For three args now<br>
<br>
gzipWithT3 ::<br>
GenericQ (GenericQ (GenericT))<br>
-> GenericQ (GenericQ (GenericT))<br>
gzipWithT3 f x y z =<br>
case gmapAccumT perkid funs z of<br>
([], c) -> c<br>
_ -> error "gzipWithT3"<br>
where<br>
perkid a d = (tail a, unGT (head a) d)<br>
funs = case gmapAccumQ perkid' funs' y of<br>
([], q) -> q<br>
_ -> error "gzipWithT3"<br>
where<br>
perkid' a d = (tail a, unGQ (head a) d)<br>
funs' = gmapQ (\k -> (GQ (\k' -> GT (f k k')))) x<br>
<br>
</div>gzipWithM3 :: Monad m<br>
=> GenericQ (GenericQ (GenericM m))<br>
-> GenericQ (GenericQ (GenericM m))<br>
gzipWithM3 f x y z =<br>
case gmapAccumM perkid funs z of<br>
([], c) -> c<br>
_ -> error "gzipWithM3"<br>
where<br>
perkid a d = (tail a, unGM (head a) d)<br>
<div class="im"> funs = case gmapAccumQ perkid' funs' y of<br>
([], q) -> q<br>
</div> _ -> error "gzipWithM3"<br>
<div class="im"> where<br>
perkid' a d = (tail a, unGQ (head a) d)<br>
</div> funs' = gmapQ (\k -> (GQ (\k' -> GM (f k k')))) x<br>
<br>
gzip3 ::<br>
(forall x. Data x => x -> x -> x -> Maybe x)<br>
-> (forall x. Data x => x -> x -> x -> Maybe x)<br>
<br>
gzip3 f = gzip3' f'<br>
where<br>
f' :: GenericQ (GenericQ (GenericM Maybe))<br>
f' x y z = cast x >>= \x' -> cast y >>= \y' -> f x' y' z<br>
gzip3' ::<br>
GenericQ (GenericQ (GenericM Maybe))<br>
-> GenericQ (GenericQ (GenericM Maybe))<br>
gzip3' 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' f) x y z<br>
else Nothing<br>
</blockquote></div><br>Ok, what I initially thought would work is not. I tried to do the three way merge as follows:<br><br>combine3 :: (Data a) => a -> a -> a -> Maybe a<br>combine3 original left right =<br>
gzip3 f original left right<br> where<br> f :: forall a. (Data a) => a -> a -> a -> Maybe a<br> f original left right<br> | geq original left = Just right<br> | geq original right = Just left<br>
| geq left right = Just left<br> | otherwise = Nothing<br><br>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.<br>