[Hs-Generics] Fwd: [Haskell] Data.Generics.gzip3 anyone?

[David Fox]

---------- Forwarded message ----------
From: David Fox <ddssff at gmail.com>
Date: Tue, Jun 2, 2009 at 1:13 PM
Subject: Re: [Haskell] Data.Generics.gzip3 anyone?
To: Ralf Laemmel <rlaemmel at gmail.com>
Cc: haskell at haskell.org


On Mon, Jun 1, 2009 at 3:40 PM, Ralf Laemmel <rlaemmel at 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.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/generics/attachments/20090602/bf64c849/attachment.html