From 93414f43adc2a76e28a83480009cc8c94db1ff98 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 14 Mar 2016 19:17:44 -0400 Subject: [PATCH] Diff entirely within Both. --- src/Alignment.hs | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/src/Alignment.hs b/src/Alignment.hs index 199e959ab..133134343 100644 --- a/src/Alignment.hs +++ b/src/Alignment.hs @@ -49,46 +49,47 @@ hasChanges = or . fmap (or . (True <$)) -- | 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 = fmap (bothWithDefault (Line [])) . toList . iter (\ (Annotated infos syntax) -> splitAbstractedTerm ((Free .) . Annotated) (justBoth sources) (justBoth infos) syntax) . fmap (splitPatchByLines sources) +splitDiffByLines sources = toList . iter (\ (Annotated infos syntax) -> splitAbstractedTerm ((Free .) . Annotated) sources infos 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) -> Adjoined (BothMaybe (Line (SplitDiff leaf Info, Range))) +splitPatchByLines :: Both (Source Char) -> Patch (Term leaf Info) -> Adjoined (Both (Line (SplitDiff leaf Info, Range))) splitPatchByLines sources patch = wrapTermInPatch <$> lines - where lines = sequenceL $ justBoth (splitAndFoldTerm <$> sources <*> maybeBothOfThese (unPatch patch)) - splitAndFoldTerm source (Just term) = (runIdentity <$> cata (splitAbstractedTerm (:<) (Identity source)) (Identity <$> term)) - splitAndFoldTerm _ _ = nil + where lines = splitAndFoldTerm (unPatch patch) + splitAndFoldTerm (This deleted) = modifyBoth (second (const $ Line [])) <$> cata (splitAbstractedTerm (:<) sources) (pure <$> deleted) + splitAndFoldTerm (That inserted) = modifyBoth (first (const $ Line [])) <$> cata (splitAbstractedTerm (:<) sources) (pure <$> inserted) + splitAndFoldTerm (These deleted inserted) = alignRows $ both (fst <$> splitAndFoldTerm (This deleted)) (snd <$> splitAndFoldTerm (That inserted)) wrapTermInPatch = fmap (fmap (first (Pure . constructor patch))) constructor (Replace _ _) = SplitReplace constructor (Insert _) = SplitInsert constructor (Delete _) = SplitDelete -- | Split a term comprised of an Info & Syntax up into one `outTerm` (abstracted by an alignment function & constructor) per line in `Source`. -splitAbstractedTerm :: (Applicative f, Coalescent (f (Line (Maybe (Identity outTerm), Range))), Coalescent (f (Line (Maybe (T.Text, outTerm), Range))), Crosswalk f, Foldable f) => (Info -> Syntax leaf outTerm -> outTerm) -> f (Source Char) -> f Info -> Syntax leaf (Adjoined (f (Line (outTerm, Range)))) -> Adjoined (f (Line (outTerm, Range))) +splitAbstractedTerm :: (Info -> Syntax leaf outTerm -> outTerm) -> Both (Source Char) -> Both Info -> Syntax leaf (Adjoined (Both (Line (outTerm, Range)))) -> Adjoined (Both (Line (outTerm, Range))) splitAbstractedTerm makeTerm sources infos syntax = case syntax of - Leaf a -> sequenceL $ fmap <$> ((\ categories -> fmap (\ range -> (makeTerm (Info range categories) (Leaf a), range))) <$> (Diff.categories <$> infos)) <*> (fmap fromList $ linesInRangeOfSource <$> (characterRange <$> infos) <*> sources) + Leaf a -> alignRows $ fmap <$> ((\ categories -> fmap (\ range -> (makeTerm (Info range categories) (Leaf a), range))) <$> (Diff.categories <$> infos)) <*> (fmap fromList $ linesInRangeOfSource <$> (characterRange <$> infos) <*> sources) Indexed children -> adjoinChildren sources infos (constructor (Indexed . fmap runIdentity)) (Identity <$> children) Fixed children -> adjoinChildren sources infos (constructor (Fixed . fmap runIdentity)) (Identity <$> children) Keyed children -> adjoinChildren sources infos (constructor (Keyed . Map.fromList)) (Map.toList children) where constructor with info = makeTerm info . with -- | Adjoin a branch term’s lines, wrapping children & context in branch nodes using a constructor. -adjoinChildren :: (Copointed c, Functor c, Applicative f, Coalescent (f (Line (Maybe (c a), Range))), Crosswalk f, Foldable f) => f (Source Char) -> f Info -> (Info -> [c a] -> outTerm) -> [c (Adjoined (f (Line (a, Range))))] -> Adjoined (f (Line (outTerm, Range))) +adjoinChildren :: (Copointed c, Functor c) => Both (Source Char) -> Both Info -> (Info -> [c a] -> outTerm) -> [c (Adjoined (Both (Line (a, Range))))] -> Adjoined (Both (Line (outTerm, Range))) adjoinChildren sources infos constructor children = wrap <$> leadingContext <> lines where (lines, next) = foldr (childLines sources) (mempty, end <$> ranges) children ranges = characterRange <$> infos categories = Diff.categories <$> infos - leadingContext = sequenceL $ fromList . fmap (fmap ((,) Nothing)) <$> (linesInRangeOfSource <$> (Range <$> (start <$> ranges) <*> next) <*> sources) + leadingContext = alignRows $ fromList . fmap (fmap ((,) Nothing)) <$> (linesInRangeOfSource <$> (Range <$> (start <$> ranges) <*> next) <*> sources) wrap = (wrapLineContents <$> (makeBranchTerm constructor <$> categories <*> next) <*>) makeBranchTerm constructor categories next children = let range = unionRangesFrom (rangeAt next) $ Prelude.snd <$> children in (constructor (Info range categories) . catMaybes . toList $ Prelude.fst <$> children, range) -- | Accumulate the lines of and between a branch term’s children. -childLines :: (Copointed c, Functor c, Applicative f, Coalescent (f (Line (Maybe (c a), Range))), Crosswalk f, Foldable f) => f (Source Char) -> c (Adjoined (f (Line (a, Range)))) -> (Adjoined (f (Line (Maybe (c a), Range))), f Int) -> (Adjoined (f (Line (Maybe (c a), Range))), f Int) +childLines :: (Copointed c, Functor c) => Both (Source Char) -> c (Adjoined (Both (Line (a, Range)))) -> (Adjoined (Both (Line (Maybe (c a), Range))), Both Int) -> (Adjoined (Both (Line (Maybe (c a), Range))), Both Int) -- 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. childLines sources child (followingLines, next) | or $ (>) . end <$> childRanges <*> next = (followingLines, next) | otherwise = ((placeChildAndRangeInContainer <$> copoint child) - <> sequenceL (fromList . pairWithNothing <$> trailingContextLines) + <> alignRows (fromList . pairWithNothing <$> trailingContextLines) <> followingLines, start <$> childRanges) where pairWithNothing = fmap (fmap ((,) Nothing)) placeChildAndRangeInContainer = fmap (fmap (first (Just . (<$ child))))