Hi,
> Tue Aug 10 18:34:48 BST 2010 Eric Kow <[email protected]>
> * Accept issue1913: buggy mapPrimFL.
>
> Thu Aug 19 07:02:51 BST 2010 Ganesh Sittampalam <[email protected]>
> * make issue1913 test actually fail
>
> Thu Aug 19 07:41:52 BST 2010 Ganesh Sittampalam <[email protected]>
> * generalise the type of treeDiff
>
> Thu Aug 19 22:19:41 BST 2010 Ganesh Sittampalam <[email protected]>
> * 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.
_______________________________________________
darcs-users mailing list
[email protected]
http://lists.osuosl.org/mailman/listinfo/darcs-users
