This is for 2.5. The first patch is already in HEAD.

The third patch ("generalise the type of treeDiff") is somewhat
gratuitous as I make no use of the generalisation, but I just    
couldn't leave it ungeneralised once I noticed :-)

4 patches for repository http://darcs.net/releases/branch-2.5:

Tue Aug 10 18:34:48 BST 2010  Eric Kow <kowey@darcs.net>
  * Accept issue1913: buggy mapPrimFL.

Thu Aug 19 07:02:51 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * make issue1913 test actually fail

Thu Aug 19 07:41:52 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * generalise the type of treeDiff

Thu Aug 19 22:19:41 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * resolve issue1913: sort changes in treeDiff

Attachments

• accept-issue1913_-buggy-mapprimfl_.dpatch
• unnamed

Hi,

> Tue Aug 10 18:34:48 BST 2010  Eric Kow <kowey@darcs.net>
>   * Accept issue1913: buggy mapPrimFL.
> 
> Thu Aug 19 07:02:51 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
>   * make issue1913 test actually fail
> 
> Thu Aug 19 07:41:52 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
>   * generalise the type of treeDiff
> 
> Thu Aug 19 22:19:41 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
>   * resolve issue1913: sort changes in treeDiff

generalise the type of treeDiff
> hunk ./src/Darcs/Diff.hs 41
>  
>  #include "gadts.h"
>  
> -treeDiff :: Gap w => (FilePath -> FileType) -> Tree IO -> Tree IO -> IO (w (FL Prim))
> +treeDiff :: forall m w . (Functor m, Monad m, Gap w) => (FilePath -> FileType) -> Tree m -> Tree m -> m (w (FL Prim))
>  treeDiff ft t1 t2 = do
>    (from, to) <- diffTrees t1 t2
>    diffs <- sequence $ zipTrees diff from to
> hunk ./src/Darcs/Diff.hs 46
>    return $ foldr (joinGap (+>+)) (emptyGap NilFL) diffs
> -    where diff :: Gap w
> -               => AnchoredPath -> Maybe (TreeItem IO) -> Maybe (TreeItem IO)
> -               -> IO (w (FL Prim))
> +    where diff :: AnchoredPath -> Maybe (TreeItem m) -> Maybe (TreeItem m)
> +               -> m (w (FL Prim))
>            diff _ (Just (SubTree _)) (Just (SubTree _)) = return (emptyGap NilFL)
>            diff p (Just (SubTree _)) Nothing =
>                return $ freeGap (rmdir (anchorPath "" p) :>: NilFL)

OK (although it does make me wonder if you wrote some QC properties for this or
such)

resolve issue1913: sort changes in treeDiff
> move ./tests/failing-issue1913-diffing.sh ./tests/issue1913-diffing.sh
> hunk ./src/Darcs/Diff.hs 37
>  import qualified Data.ByteString.Lazy.Char8 as BLC
>  import qualified Data.ByteString as BS
>  import qualified Data.ByteString.Lazy as BL
> +import Data.List ( sortBy )
>  import ByteStringUtils( isFunky )
>  
>  #include "gadts.h"
> hunk ./src/Darcs/Diff.hs 41
> +#include "impossible.h"
> +
> +data Diff m = Added (TreeItem m) | Removed (TreeItem m) | Changed (TreeItem m) (TreeItem m)
> +
> +getDiff :: AnchoredPath -> Maybe (TreeItem m) -> Maybe (TreeItem m) -> (AnchoredPath, Diff m)
> +getDiff p Nothing (Just t) = (p, Added t)
> +getDiff p (Just from) (Just to) = (p, Changed from to)
> +getDiff p (Just t) Nothing = (p, Removed t)
> +getDiff p Nothing Nothing = impossible -- zipTrees should never return this
>  
>  treeDiff :: forall m w . (Functor m, Monad m, Gap w) => (FilePath -> FileType) -> Tree m -> Tree m -> m (w (FL Prim))
>  treeDiff ft t1 t2 = do
> hunk ./src/Darcs/Diff.hs 54
>    (from, to) <- diffTrees t1 t2
> -  diffs <- sequence $ zipTrees diff from to
> +  diffs <- mapM (uncurry diff) $ sortBy organise $ zipTrees getDiff from to
>    return $ foldr (joinGap (+>+)) (emptyGap NilFL) diffs
> hunk ./src/Darcs/Diff.hs 56
> -    where diff :: AnchoredPath -> Maybe (TreeItem m) -> Maybe (TreeItem m)
> -               -> m (w (FL Prim))
> -          diff _ (Just (SubTree _)) (Just (SubTree _)) = return (emptyGap NilFL)
> -          diff p (Just (SubTree _)) Nothing =
> +    where
> +          -- sort into removes, changes, adds, with removes in reverse-path order
> +          -- and everything else in forward order
> +          organise :: (AnchoredPath, Diff m) -> (AnchoredPath, Diff m) -> Ordering
> +
> +          organise (p1, Changed _ _ ) (p2, Changed _ _) = compare p1 p2
> +          organise (p1, Added _)      (p2, Added _)   = compare p1 p2
> +          organise (p1, Removed _)    (p2, Removed _) = compare p2 p1
> +
> +          organise (p1, Removed _) _ = LT
> +          organise _ (p1, Removed _) = GT
> +
> +          organise (p1, Changed _ _) _ = LT
> +          organise _ (p1, Changed _ _) = GT
Sorting the list of changes this way didn't quite occur to me. Looks OK.

> +          diff :: AnchoredPath -> Diff m -> m (w (FL Prim))
> +          diff _ (Changed (SubTree _) (SubTree _)) = return (emptyGap NilFL)
> +          diff p (Removed (SubTree _)) =
>                return $ freeGap (rmdir (anchorPath "" p) :>: NilFL)
> hunk ./src/Darcs/Diff.hs 75
> -          diff p Nothing (Just (SubTree _)) =
> +          diff p (Added (SubTree _)) =
>                return $ freeGap (adddir (anchorPath "" p) :>: NilFL)
> hunk ./src/Darcs/Diff.hs 77
> -          diff p Nothing b'@(Just (File _)) =
> -              do diff' <- diff p (Just (File emptyBlob)) b'
> +          diff p (Added b'@(File _)) =
> +              do diff' <- diff p (Changed (File emptyBlob) b')
>                   return $ joinGap (:>:) (freeGap (addfile (anchorPath "" p))) diff'
> hunk ./src/Darcs/Diff.hs 80
> -          diff p a'@(Just (File _)) Nothing =
> -              do diff' <- diff p a' (Just (File emptyBlob))
> +          diff p (Removed a'@(File _)) =
> +              do diff' <- diff p (Changed a' (File emptyBlob))
>                   return $ joinGap (+>+) diff' (freeGap (rmfile (anchorPath "" p) :>: NilFL))
> hunk ./src/Darcs/Diff.hs 83
> -          diff p (Just (File a')) (Just (File b')) =
> +          diff p (Changed (File a') (File b')) =
>                do a <- readBlob a'
>                   b <- readBlob b'
>                   let path = anchorPath "" p
> hunk ./src/Darcs/Diff.hs 93
>                     _ -> return $ if a /= b
>                                      then freeGap (binary path (strict a) (strict b) :>: NilFL)
>                                      else emptyGap NilFL
> -          diff p _ _ = fail $ "Missing case at path " ++ show p
> +          diff p _ = fail $ "Missing case at path " ++ show p
>            text_diff p a b
>                | BL.null a && BL.null b = emptyGap NilFL
>                | BL.null a = freeGap (diff_from_empty p b)
Just adapts diff to work on the new (sortable) representation. OK.

Since I don't have my laptop right now, it would be easier if someone could
make sure this passes testsuite and push. Thanks,

    Petr.

On Fri, 20 Aug 2010, me@mornfall.net wrote:

> generalise the type of treeDiff
>> hunk ./src/Darcs/Diff.hs 41
>>
>>  #include "gadts.h"
>>
>> -treeDiff :: Gap w => (FilePath -> FileType) -> Tree IO -> Tree IO -> IO (w (FL Prim))
>> +treeDiff :: forall m w . (Functor m, Monad m, Gap w) => (FilePath -> FileType) -> Tree m -> Tree m -> m (w (FL Prim))
>>  treeDiff ft t1 t2 = do
>>    (from, to) <- diffTrees t1 t2
>>    diffs <- sequence $ zipTrees diff from to
>> hunk ./src/Darcs/Diff.hs 46
>>    return $ foldr (joinGap (+>+)) (emptyGap NilFL) diffs
>> -    where diff :: Gap w
>> -               => AnchoredPath -> Maybe (TreeItem IO) -> Maybe (TreeItem IO)
>> -               -> IO (w (FL Prim))
>> +    where diff :: AnchoredPath -> Maybe (TreeItem m) -> Maybe (TreeItem m)
>> +               -> m (w (FL Prim))
>>            diff _ (Just (SubTree _)) (Just (SubTree _)) = return (emptyGap NilFL)
>>            diff p (Just (SubTree _)) Nothing =
>>                return $ freeGap (rmdir (anchorPath "" p) :>: NilFL)
>
> OK (although it does make me wonder if you wrote some QC properties for this or
> such)

No - but I should!

Ganesh

This patch bundle (with 4 patches) was just applied to the repository http://darcs.net/.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-c62ed8894ff7922237708dc9aceb4e9af22e4851

As Petr has reviewed this and it does pass the testsuite, I have pushed it 
to branch-2.5 and HEAD.

This patch bundle (with 4 patches) was just applied to the repository http://darcs.net/reviewed.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_reviewed.html#bundle-c62ed8894ff7922237708dc9aceb4e9af22e4851