diff --git a/src/Diff3.hs b/src/Diff3.hs index 8e4ca20..1139486 100644 --- a/src/Diff3.hs +++ b/src/Diff3.hs @@ -1,39 +1,47 @@ {-# LANGUAGE TupleSections #-} -module Diff3 where +module Diff3 + ( diff3Toks + ) where import Diff import Merge import Types +stable :: (Origin, a) -> Bool +stable (Stable, _) = True +stable _ = False + +applySplit :: (a -> Bool) -> ([a] -> [b]) -> ([a] -> [b]) -> [a] -> [b] +applySplit cond f g xs = f (takeWhile cond xs) ++ g (dropWhile cond xs) + +conflict :: MergeOpts -> [(Origin, (Op, Tok))] -> [(Op, Tok)] +conflict mo = go + where + go [] = [] + go as@(a:_) + | stable a = applySplit stable (map snd) go as + | otherwise = applySplit (not . stable) (merge mo) go as + +align :: Diff -> Diff -> [(Origin, (Op, Tok))] +align ((Keep, a):as) ((Keep, _):bs) = (Stable, (Keep, a)) : align as bs +align ((Add, a):as) ((Add, b):bs) = + (Mine, (Add, a)) : (Your, (Add, b)) : align as bs +align ((Remove, a):as) ((Remove, b):bs) = + (Mine, (Remove, a)) : (Your, (Remove, b)) : align as bs +align ((Add, a):as) bs@((Keep, _):_) = (Mine, (Add, a)) : align as bs +align as@((Keep, _):_) ((Add, b):bs) = (Your, (Add, b)) : align as bs +align ((Remove, a):as) ((Keep, b):bs) = + (Mine, (Remove, a)) : (Your, (Keep, b)) : align as bs +align ((Keep, a):as) ((Remove, b):bs) = + (Mine, (Keep, a)) : (Your, (Remove, b)) : align as bs +align ((Add, a):as) bs@((Remove, _):_) = (Mine, (Add, a)) : align as bs +align as@((Remove, _):_) ((Add, b):bs) = (Your, (Add, b)) : align as bs +align [] [] = [] +align as@((Add, _):_) [] = map (Mine, ) as +align [] bs@((Add, _):_) = map (Your, ) bs +align _ _ = error "Internal failure: diffstreams seem broken, cannot align" + diff3Toks :: MergeOpts -> TV -> TV -> TV -> Diff diff3Toks mo tMine tOrig tYour = - conflict $ align (diffToks tOrig tMine) (diffToks tOrig tYour) - where - align :: Diff -> Diff -> [(Origin, (Op, Tok))] - align ((Keep, a):as) ((Keep, _):bs) = (Stable, (Keep, a)) : align as bs - align ((Add, a):as) ((Add, b):bs) = - (Mine, (Add, a)) : (Your, (Add, b)) : align as bs - align ((Remove, a):as) ((Remove, b):bs) = - (Mine, (Remove, a)) : (Your, (Remove, b)) : align as bs - align ((Add, a):as) bs@((Keep, _):_) = (Mine, (Add, a)) : align as bs - align as@((Keep, _):_) ((Add, b):bs) = (Your, (Add, b)) : align as bs - align ((Remove, a):as) ((Keep, b):bs) = - (Mine, (Remove, a)) : (Your, (Keep, b)) : align as bs - align ((Keep, a):as) ((Remove, b):bs) = - (Mine, (Keep, a)) : (Your, (Remove, b)) : align as bs - align ((Add, a):as) bs@((Remove, _):_) = (Mine, (Add, a)) : align as bs - align as@((Remove, _):_) ((Add, b):bs) = (Your, (Add, b)) : align as bs - align [] [] = [] - align as@((Add, _):_) [] = map (Mine, ) as - align [] bs@((Add, _):_) = map (Your, ) bs - align _ _ = error "Internal failure: diffstreams seem broken, cannot align" - conflict :: [(Origin, (Op, Tok))] -> Diff - conflict [] = [] - conflict as@(a:_) - | stable a = applySplit stable (map snd) conflict as - | otherwise = applySplit (not . stable) (merge mo) conflict as - applySplit :: (a -> Bool) -> ([a] -> [b]) -> ([a] -> [b]) -> [a] -> [b] - applySplit cond f g xs = f (takeWhile cond xs) ++ g (dropWhile cond xs) - stable (Stable, _) = True - stable _ = False + conflict mo $ align (diffToks tOrig tMine) (diffToks tOrig tYour)