exa/adiff
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

restructure diff3 a bit

Browse source
This commit is contained in:
Mirek Kratochvil 2020-12-29 19:45:21 +01:00
parent 23b62f6344
commit e19a00b6d8
1 changed files with 38 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

68
src/Diff3.hs
View file

@ -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)