fix more stuff
This commit is contained in:
parent
36cf2ba36f
commit
8f4f4434b6
41
src/Diff.hs
41
src/Diff.hs
|
@ -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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
Loading…
Reference in a new issue