fix more stuff

This commit is contained in:
Mirek Kratochvil 2020-09-27 11:14:41 +02:00
parent 36cf2ba36f
commit 8f4f4434b6
3 changed files with 25 additions and 33 deletions

View file

@ -16,7 +16,6 @@ import Data.List (groupBy, mapAccumL)
import Data.List.Extra (split, takeEnd) import Data.List.Extra (split, takeEnd)
import qualified Data.Vector as V import qualified Data.Vector as V
import qualified Data.Vector.Unboxed.Mutable as M import qualified Data.Vector.Unboxed.Mutable as M
import Debug.Trace
import Substr import Substr
import Types import Types
@ -36,8 +35,7 @@ data DiffEnv =
} }
deriving (Show) deriving (Show)
toksMatch x y DiffEnv {deT1 = t1, deT2 = t2} = toksMatch x y DiffEnv {deT1 = t1, deT2 = t2} = t1 V.! x == t2 V.! y
t1 V.! x == t2 V.! y
stripEqToks :: TV -> TV -> (Diff, Diff, TV, TV) stripEqToks :: TV -> TV -> (Diff, Diff, TV, TV)
stripEqToks t1 t2 = (pre, post, t1', t2') stripEqToks t1 t2 = (pre, post, t1', t2')
@ -50,7 +48,7 @@ stripEqToks t1 t2 = (pre, post, t1', t2')
b = firstDiff 0 b = firstDiff 0
lastDiff i lastDiff i
| l1 - i - 1 >= b && | l1 - i - 1 >= b &&
l2 - i - 1 >= b && t1 V.! (l1 - i - 1) == t2 V.! (l2 - i - 1)= l2 - i - 1 >= b && t1 V.! (l1 - i - 1) == t2 V.! (l2 - i - 1) =
lastDiff (i + 1) lastDiff (i + 1)
| otherwise = i | otherwise = i
e = lastDiff 0 e = lastDiff 0
@ -117,7 +115,7 @@ diffToks' :: DiffEnv -> Diff
diffToks' de@DiffEnv {deS = s, deE = e, deA = a, deB = b, deTrans = trans} = diffToks' de@DiffEnv {deS = s, deE = e, deA = a, deB = b, deTrans = trans} =
diff diff
where where
mid = (s + e) `div` 2 mid = quot (s + e) 2
vecSmid = vecS mid vecSmid = vecS mid
vecEmid = vecE mid vecEmid = vecE mid
extraScore i = extraScore i =
@ -263,12 +261,23 @@ diffToks' de@DiffEnv {deS = s, deE = e, deA = a, deB = b, deTrans = trans} =
diffToks' de {deS = mid, deVS = vecSmid, deA = opt} diffToks' de {deS = mid, deVS = vecSmid, deA = opt}
hunks :: Int -> Diff -> [Hunk] hunks :: Int -> Diff -> [Hunk]
hunks ctxt = hunks ctxt d =
map (stripNums . concat) . map (stripNums . map snd) .
split null . filter (not . null) . split fst . zip remove . addNums $
concat . check . map breakKeeps . groupBy ((==) `on` fst . snd) . addNums d
where where
edit (Keep, _) = 0
edit _ = 1
edits :: [Int]
edits = tail $ scanl (+) 0 (map edit d)
padEnd _ [] = []
padEnd i [a] = replicate i a
padEnd i (x:xs) = x : padEnd i xs
remove =
drop ctxt $
zipWith (<=) (padEnd ctxt edits) (replicate (1 + 2 * ctxt) 0 ++ edits)
addNums = snd . mapAccumL countTok (0, 0) addNums = snd . mapAccumL countTok (0, 0)
stripNums = (,) <$> fst . head <*> map snd
countTok x@(i, j) d@(op, _) = countTok x@(i, j) d@(op, _) =
(,) (,)
(case op of (case op of
@ -276,17 +285,3 @@ hunks ctxt =
Keep -> (i + 1, j + 1) Keep -> (i + 1, j + 1)
Add -> (i, j + 1)) Add -> (i, j + 1))
(x, d) (x, d)
stripNums = (,) <$> fst . head <*> map snd
breakKeeps ks@((_, (Keep, _)):_) =
let (a, b') = splitAt ctxt ks
(b, c) = splitAt ctxt b'
in if null c
then [ks]
else [a, [], takeEnd ctxt b']
breakKeeps a = [a]
check ([_, [], _]:[]) = []
check ([_, [], a]:xs) = [a] : checkLast xs
check a = checkLast a
checkLast [] = []
checkLast ([a, [], _]:[]) = [[a]]
checkLast (a:xs) = a:checkLast xs

View file

@ -11,21 +11,18 @@ import qualified Data.ByteString.Lazy as BL
import Data.String import Data.String
import Substr import Substr
pprHunkHdr i j = fromString $ "@@ -" ++ show i ++ " +" ++ show j ++ " @@" pprHunkHdr i j = fromString $ "@@ -" ++ show i ++ " +" ++ show j ++ " @@"
lineSep = fromString "\n" lineSep = fromString "\n"
pprHunks :: [Hunk] -> BS
pprHunks = B.concat . map pprHunk
pprHunk :: Hunk -> BS pprHunk :: Hunk -> BS
pprHunk ((i, j), toks) = pprHunk ((i, j), toks) = B.concat ((pprHunkHdr i j <> lineSep) : map pprDiff1 toks)
B.intercalate lineSep (pprHunkHdr i j : pprDiff toks)
pprHunks = B.intercalate lineSep . map pprHunk
pprDiff :: Diff -> [BS]
pprDiff = map pprDiff1
pprDiff1 (op, (tok, s)) = pprDiff1 (op, (tok, s)) =
fromString pfx <> escNewlines s fromString pfx <> escNewlines s <> lineSep
where where
pfx = pfx =
case (op, tok) of case (op, tok) of

View file

@ -114,5 +114,5 @@ main =
toks1 <- V.fromList <$> redfaTokenize redfa data1 toks1 <- V.fromList <$> redfaTokenize redfa data1
toks2 <- V.fromList <$> redfaTokenize redfa data2 toks2 <- V.fromList <$> redfaTokenize redfa data2
let hs = hunks (max 0 ctxt) $ diffToks toks1 toks2 let hs = hunks (max 0 ctxt) $ diffToks toks1 toks2
B8.putStrLn $ pprHunks hs B8.putStr $ pprHunks hs
CmdPatch {} -> putStrLn "not supported yet" CmdPatch {} -> putStrLn "not supported yet"