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 qualified Data.Vector as V | ||||
| import qualified Data.Vector.Unboxed.Mutable as M | ||||
| import Debug.Trace | ||||
| import Substr | ||||
| import Types | ||||
| 
 | ||||
|  | @ -36,8 +35,7 @@ data DiffEnv = | |||
|     } | ||||
|   deriving (Show) | ||||
| 
 | ||||
| toksMatch x y DiffEnv {deT1 = t1, deT2 = t2} = | ||||
|   t1 V.! x == t2 V.! y | ||||
| toksMatch x y DiffEnv {deT1 = t1, deT2 = t2} = t1 V.! x == t2 V.! y | ||||
| 
 | ||||
| stripEqToks :: TV -> TV -> (Diff, Diff, TV, TV) | ||||
| stripEqToks t1 t2 = (pre, post, t1', t2') | ||||
|  | @ -50,7 +48,7 @@ stripEqToks t1 t2 = (pre, post, t1', t2') | |||
|     b = firstDiff 0 | ||||
|     lastDiff i | ||||
|       | 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) | ||||
|       | otherwise = i | ||||
|     e = lastDiff 0 | ||||
|  | @ -117,7 +115,7 @@ diffToks' :: DiffEnv -> Diff | |||
| diffToks' de@DiffEnv {deS = s, deE = e, deA = a, deB = b, deTrans = trans} = | ||||
|   diff | ||||
|   where | ||||
|     mid = (s + e) `div` 2 | ||||
|     mid = quot (s + e) 2 | ||||
|     vecSmid = vecS mid | ||||
|     vecEmid = vecE mid | ||||
|     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} | ||||
| 
 | ||||
| hunks :: Int -> Diff -> [Hunk] | ||||
| hunks ctxt = | ||||
|   map (stripNums . concat) . | ||||
|   split null . | ||||
|   concat . check . map breakKeeps . groupBy ((==) `on` fst . snd) . addNums | ||||
| hunks ctxt d = | ||||
|   map (stripNums . map snd) . | ||||
|   filter (not . null) . split fst . zip remove . addNums $ | ||||
|   d | ||||
|   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) | ||||
|     stripNums = (,) <$> fst . head <*> map snd | ||||
|     countTok x@(i, j) d@(op, _) = | ||||
|       (,) | ||||
|         (case op of | ||||
|  | @ -276,17 +285,3 @@ hunks ctxt = | |||
|            Keep -> (i + 1, j + 1) | ||||
|            Add -> (i, j + 1)) | ||||
|         (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 Substr | ||||
| 
 | ||||
| pprHunkHdr i j = fromString $ "@@ -" ++ show i ++ " +" ++ show j ++ " @@" | ||||
| pprHunkHdr i j = fromString $ "@@ -" ++ show i ++ " +" ++ show j ++ " @@"  | ||||
| 
 | ||||
| lineSep = fromString "\n" | ||||
| 
 | ||||
| pprHunks :: [Hunk] -> BS | ||||
| pprHunks = B.concat . map pprHunk | ||||
| 
 | ||||
| pprHunk :: Hunk -> BS | ||||
| pprHunk ((i, j), toks) = | ||||
|   B.intercalate lineSep (pprHunkHdr i j : pprDiff toks) | ||||
| 
 | ||||
| pprHunks = B.intercalate lineSep . map pprHunk | ||||
| 
 | ||||
| pprDiff :: Diff -> [BS] | ||||
| pprDiff = map pprDiff1 | ||||
| pprHunk ((i, j), toks) = B.concat ((pprHunkHdr i j <> lineSep) : map pprDiff1 toks) | ||||
| 
 | ||||
| pprDiff1 (op, (tok, s)) = | ||||
|   fromString pfx <> escNewlines s | ||||
|   fromString pfx <> escNewlines s <> lineSep | ||||
|   where | ||||
|     pfx = | ||||
|       case (op, tok) of | ||||
|  |  | |||
|  | @ -114,5 +114,5 @@ main = | |||
|              toks1 <- V.fromList <$> redfaTokenize redfa data1 | ||||
|              toks2 <- V.fromList <$> redfaTokenize redfa data2 | ||||
|              let hs = hunks (max 0 ctxt) $ diffToks toks1 toks2 | ||||
|              B8.putStrLn $ pprHunks hs | ||||
|              B8.putStr $ pprHunks hs | ||||
|            CmdPatch {} -> putStrLn "not supported yet" | ||||
|  |  | |||
		Loading…
	
		Reference in a new issue