module Darcs.Diff( treeDiff ) where
import Darcs.Witnesses.Ordered ( FL(..), (+>+) )
import Darcs.Witnesses.Sealed ( Gap(..) )
import Darcs.Repository.Prefs ( FileType(..) )
import Darcs.Patch ( Prim, hunk, canonize, binary
, addfile, rmfile, adddir, rmdir, invert)
import Storage.Hashed.Tree( diffTrees, zipTrees, TreeItem(..), Tree
, readBlob, emptyBlob )
import Storage.Hashed.AnchoredPath( AnchoredPath, anchorPath )
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"
#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
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 <- mapM (uncurry diff) $ sortBy organise $ zipTrees getDiff from to
return $ foldr (joinGap (+>+)) (emptyGap NilFL) diffs
where
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
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)
diff p (Added (SubTree _)) =
return $ freeGap (adddir (anchorPath "" p) :>: NilFL)
diff p (Added b'@(File _)) =
do diff' <- diff p (Changed (File emptyBlob) b')
return $ joinGap (:>:) (freeGap (addfile (anchorPath "" p))) diff'
diff p (Removed a'@(File _)) =
do diff' <- diff p (Changed a' (File emptyBlob))
return $ joinGap (+>+) diff' (freeGap (rmfile (anchorPath "" p) :>: NilFL))
diff p (Changed (File a') (File b')) =
do a <- readBlob a'
b <- readBlob b'
let path = anchorPath "" p
case ft path of
TextFile | no_bin a && no_bin b ->
return $ text_diff path a b
_ -> 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
text_diff p a b
| BL.null a && BL.null b = emptyGap NilFL
| BL.null a = freeGap (diff_from_empty p b)
| BL.null b = freeGap (diff_to_empty p a)
| otherwise = freeGap (line_diff p (linesB a) (linesB b))
line_diff p a b = canonize (hunk p 1 a b)
diff_to_empty p x | BLC.last x == '\n' = line_diff p (init $ linesB x) []
| otherwise = line_diff p (linesB x) [BS.empty]
diff_from_empty p x = invert (diff_to_empty p x)
no_bin = not . isFunky . strict . BL.take 4096
linesB = map strict . BLC.split '\n'
strict = BS.concat . BL.toChunks