Merge branch 'refactor-alignment' into data-dot-adjoined

src/Alignment.hs

@@ -38,14 +38,14 @@ numberedRows = foldl' numberRows []
 hasChanges :: Line (SplitDiff leaf Info) -> Bool
 hasChanges = or . fmap (or . (True <$))
 
--- | Split a diff, which may span multiple lines, into rows of split diffs.
+-- | Split a diff, which may span multiple lines, into rows of split diffs paired with the Range of characters spanned by that Row on each side of the diff.
 splitDiffByLines :: Both (Source Char) -> Diff leaf Info -> [Row (SplitDiff leaf Info, Range)]
-splitDiffByLines sources = iter (\ (Annotated info syntax) -> (splitAnnotatedByLines sources) info syntax) . fmap (splitPatchByLines sources)
+splitDiffByLines sources = iter (\ (Annotated info syntax) -> splitAnnotatedByLines sources info syntax) . fmap (splitPatchByLines sources)
 
 -- | Split a patch, which may span multiple lines, into rows of split diffs.
 splitPatchByLines :: Both (Source Char) -> Patch (Term leaf Info) -> [Row (SplitDiff leaf Info, Range)]
 splitPatchByLines sources patch = zipWithDefaults makeRow (pure mempty) $ fmap (fmap (first (Pure . constructor patch))) <$> lines
-    where lines = (\ source -> maybe [] $ cata (splitAbstractedTerm (:<) source)) <$> sources <*> unPatch patch
+    where lines = maybe [] . cata . splitAbstractedTerm (:<) <$> sources <*> unPatch patch
           constructor (Replace _ _) = SplitReplace
           constructor (Insert _) = SplitInsert
           constructor (Delete _) = SplitDelete
@@ -60,10 +60,14 @@ splitAbstractedTerm makeTerm source (Info range categories) syntax = case syntax
   where adjoin = reverse . foldl' (adjoinLinesBy (openRangePair source)) []
 
         adjoinChildLines constructor children = let (lines, previous) = foldl' childLines ([], start range) children in
-          fmap (wrapLineContents (makeBranchTerm (\ info -> makeTerm info . constructor) categories previous)) . adjoin $ lines ++ (pure . (,) Nothing <$> actualLineRanges (Range previous $ end range) source)
+          fmap (wrapLineContents (makeBranchTerm (\ info -> makeTerm info . constructor) categories previous))
+            . adjoin $  lines
+                     ++ (pure . (,) Nothing <$> actualLineRanges (Range previous $ end range) source)
 
-        childLines (lines, previous) child = let childLines = copoint child in
-          (adjoin $ lines ++ (pure . (,) Nothing <$> actualLineRanges (Range previous $ start (unionLineRangesFrom (rangeAt previous) childLines)) source) ++ (fmap (flip (,) (unionLineRangesFrom (rangeAt previous) childLines) . Just . (<$ child)) <$> childLines), end (unionLineRangesFrom (rangeAt previous) childLines))
+        childLines (lines, previous) child = let childRange = unionLineRangesFrom (rangeAt previous) (copoint child) in
+          (adjoin $  lines
+                  ++ (pure . (,) Nothing <$> actualLineRanges (Range previous (start childRange)) source)
+                  ++ (fmap (flip (,) childRange . Just . (<$ child)) <$> copoint child), end childRange)
 
 -- | Split an annotated diff into rows of split diffs.
 splitAnnotatedByLines :: Both (Source Char) -> Both Info -> Syntax leaf [Row (SplitDiff leaf Info, Range)] -> [Row (SplitDiff leaf Info, Range)]
@@ -80,14 +84,18 @@ splitAnnotatedByLines sources infos syntax = case syntax of
 
         adjoinChildRows :: (Copointed f, Functor f) => ([f (SplitDiff leaf Info)] -> Syntax leaf (SplitDiff leaf Info)) -> [f [Row (SplitDiff leaf Info, Range)]] -> [Row (SplitDiff leaf Info, Range)]
         adjoinChildRows constructor children = let (rows, previous) = foldl' childRows ([], start <$> ranges) children in
-          fmap (wrapRowContents (makeBranchTerm (\ info -> Free . Annotated info . constructor) <$> categories <*> previous)) . adjoin $ rows ++ (zipWithDefaults makeRow (pure mempty) (fmap (pure . (,) Nothing) <$> (actualLineRanges <$> (Range <$> previous <*> (end <$> ranges)) <*> sources)))
+          fmap (wrapRowContents (makeBranchTerm (\ info -> Free . Annotated info . constructor) <$> categories <*> previous))
+            . adjoin $  rows
+                     ++ zipWithDefaults makeRow (pure mempty) (fmap (pure . (,) Nothing) <$> (actualLineRanges <$> (Range <$> previous <*> (end <$> ranges)) <*> sources))
 
         childRows :: (Copointed f, Functor f) => ([Row (Maybe (f (SplitDiff leaf Info)), Range)], Both Int) -> f [Row (SplitDiff leaf Info, Range)] -> ([Row (Maybe (f (SplitDiff leaf Info)), Range)], Both Int)
-        childRows (rows, previous) child = let childRows = copoint child in
+        childRows (rows, previous) child = let childRanges = unionLineRangesFrom <$> (rangeAt <$> previous) <*> sequenceA (unRow <$> copoint child) in
           -- We depend on source ranges increasing monotonically. If a child invalidates that, e.g. if it’s a move in a Keyed node, we don’t output rows for it in this iteration. (It will still show up in the diff as context rows.) This works around https://github.com/github/semantic-diff/issues/488.
-          if or $ (<) . start <$> (unionLineRangesFrom <$> (rangeAt <$> previous) <*> sequenceA (unRow <$> childRows)) <*> previous
+          if or $ (<) . start <$> childRanges <*> previous
             then (rows, previous)
-            else (adjoin $ rows ++ zipWithDefaults makeRow (pure mempty) (fmap (pure . (,) Nothing) <$> (actualLineRanges <$> (Range <$> previous <*> (start <$> (unionLineRangesFrom <$> (rangeAt <$> previous) <*> sequenceA (unRow <$> childRows)))) <*> sources)) ++ (fmap (first (Just . (<$ child))) <$> childRows), end <$> (unionLineRangesFrom <$> (rangeAt <$> previous) <*> sequenceA (unRow <$> childRows)))
+            else (adjoin $  rows
+                         ++ zipWithDefaults makeRow (pure mempty) (fmap (pure . (,) Nothing) <$> (actualLineRanges <$> (Range <$> previous <*> (start <$> childRanges)) <*> sources))
+                         ++ (fmap (first (Just . (<$ child))) <$> copoint child), end <$> childRanges)
 
 -- | Wrap a list of child terms in a branch.
 makeBranchTerm :: (Info -> [inTerm] -> outTerm) -> Set.Set Category -> Int -> [(Maybe inTerm, Range)] -> (outTerm, Range)
@@ -100,7 +108,7 @@ unionLineRangesFrom start lines = unionRangesFrom start (lines >>= (fmap Prelude
 
 -- | Returns the ranges of a list of Rows.
 rowRanges :: [Row (a, Range)] -> Both (Maybe Range)
-rowRanges rows = maybeConcat . join <$> (Both.unzip (fmap (fmap Prelude.snd . unLine) . unRow <$> rows))
+rowRanges rows = maybeConcat . join <$> Both.unzip (fmap (fmap Prelude.snd . unLine) . unRow <$> rows)
 
 -- | MaybeOpen test for (Range, a) pairs.
 openRangePair :: Source Char -> MaybeOpen (a, Range)