mirror of
https://github.com/github/semantic.git
synced 2024-12-29 01:42:43 +03:00
Alignment returns ranged Rows.
This commit is contained in:
parent
6ecb1336b9
commit
0cf7ba393d
@ -37,17 +37,16 @@ hasChanges :: Line (SplitDiff leaf Info) -> Bool
|
||||
hasChanges = or . fmap (or . (True <$))
|
||||
|
||||
-- | Split a diff, which may span multiple lines, into rows of split diffs.
|
||||
splitDiffByLines :: Diff leaf Info -> Both Int -> Both (Source Char) -> ([Row (SplitDiff leaf Info)], Both Range)
|
||||
splitDiffByLines :: Diff leaf Info -> Both Int -> Both (Source Char) -> [Row (SplitDiff leaf Info, Range)]
|
||||
splitDiffByLines diff previous sources = case diff of
|
||||
Free (Annotated annotation syntax) -> (splitAnnotatedByLines sources (ranges annotation) (Diff.categories <$> annotation) syntax, ranges annotation)
|
||||
Free (Annotated annotation syntax) -> splitAnnotatedByLines sources (ranges annotation) (Diff.categories <$> annotation) syntax
|
||||
Pure patch -> splitPatchByLines patch previous sources
|
||||
where ranges annotations = characterRange <$> annotations
|
||||
|
||||
-- | Split a patch, which may span multiple lines, into rows of split diffs.
|
||||
splitPatchByLines :: Patch (Term leaf Info) -> Both Int -> Both (Source Char) -> ([Row (SplitDiff leaf Info)], Both Range)
|
||||
splitPatchByLines patch previous sources = (zipWithDefaults makeRow (pure mempty) $ fmap (fmap (Pure . constructor patch . Prelude.fst)) <$> lines, ranges)
|
||||
splitPatchByLines :: Patch (Term leaf Info) -> Both Int -> Both (Source Char) -> [Row (SplitDiff leaf Info, Range)]
|
||||
splitPatchByLines patch _ sources = zipWithDefaults makeRow (pure mempty) $ fmap (fmap (first (Pure . constructor patch))) <$> lines
|
||||
where lines = (maybe [] . splitAbstractedTerm copoint unwrap (:<) <$> sources) <*> unPatch patch
|
||||
ranges = unionRangesFrom . rangeAt <$> previous <*> ((>>= unLine . fmap Prelude.snd) <$> lines)
|
||||
constructor (Replace _ _) = SplitReplace
|
||||
constructor (Insert _) = SplitInsert
|
||||
constructor (Delete _) = SplitDelete
|
||||
@ -68,25 +67,25 @@ splitAbstractedTerm getInfo getSyntax makeTerm source term = case getSyntax term
|
||||
(adjoin $ lines ++ (pure . (,) Nothing <$> actualLineRanges (Range previous $ start (unionLineRanges childLines)) source) ++ (fmap (flip (,) (unionLineRanges childLines) . Just . (<$ child)) <$> childLines), end (unionLineRanges childLines))
|
||||
|
||||
-- | Split a annotated diff into rows of split diffs.
|
||||
splitAnnotatedByLines :: Both (Source Char) -> Both Range -> Both (Set.Set Category) -> Syntax leaf (Diff leaf Info) -> [Row (SplitDiff leaf Info)]
|
||||
splitAnnotatedByLines :: Both (Source Char) -> Both Range -> Both (Set.Set Category) -> Syntax leaf (Diff leaf Info) -> [Row (SplitDiff leaf Info, Range)]
|
||||
splitAnnotatedByLines sources ranges categories syntax = case syntax of
|
||||
Leaf a -> zipWithDefaults makeRow (pure mempty) $ fmap <$> (((pure . Free . (`Annotated` Leaf a)) .) . flip Info <$> categories) <*> (actualLineRanges <$> ranges <*> sources)
|
||||
Leaf a -> zipWithDefaults makeRow (pure mempty) $ fmap <$> ((\ categories range -> pure (Free (Annotated (Info range categories) (Leaf a)), range)) <$> categories) <*> (actualLineRanges <$> ranges <*> sources)
|
||||
Indexed children -> adjoinChildRows (Indexed . fmap copoint) (Identity <$> children)
|
||||
Fixed children -> adjoinChildRows (Fixed . fmap copoint) (Identity <$> children)
|
||||
Keyed children -> adjoinChildRows (Keyed . Map.fromList) (List.sortOn (diffRanges . Prelude.snd) $ Map.toList children)
|
||||
where adjoin :: [Row (Maybe (f (SplitDiff leaf Info)), Range)] -> [Row (Maybe (f (SplitDiff leaf Info)), Range)]
|
||||
adjoin = reverse . foldl (adjoinRowsBy (openRangePair <$> sources)) []
|
||||
|
||||
adjoinChildRows :: (Copointed f, Functor f) => ([f (SplitDiff leaf Info)] -> Syntax leaf (SplitDiff leaf Info)) -> [f (Diff leaf Info)] -> [Row (SplitDiff leaf Info)]
|
||||
adjoinChildRows :: (Copointed f, Functor f) => ([f (SplitDiff leaf Info)] -> Syntax leaf (SplitDiff leaf Info)) -> [f (Diff leaf Info)] -> [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)) . adjoin $ rows ++ zipWithDefaults makeRow (pure mempty) (fmap (pure . (,) Nothing) <$> (actualLineRanges <$> (makeRanges previous (end <$> ranges)) <*> sources))
|
||||
fmap (wrapRowContents ((\ categories -> makeBranchTerm (\ info -> Free . Annotated info . constructor) categories &&& unionRanges . fmap Prelude.snd) <$> categories)) . adjoin $ rows ++ (zipWithDefaults makeRow (pure mempty) (fmap (pure . (,) Nothing) <$> (actualLineRanges <$> (makeRanges previous (end <$> ranges)) <*> sources)))
|
||||
|
||||
childRows :: (Copointed f, Functor f) => ([Row (Maybe (f (SplitDiff leaf Info)), Range)], Both Int) -> f (Diff leaf Info) -> ([Row (Maybe (f (SplitDiff leaf Info)), Range)], Both Int)
|
||||
childRows (rows, previous) child = let (childRows, childRanges) = splitDiffByLines (copoint child) previous sources in
|
||||
childRows (rows, previous) child = let childRows = splitDiffByLines (copoint child) previous sources 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 <$> childRanges <*> previous
|
||||
if or $ (<) . start . unionLineRanges <$> sequenceA (unRow <$> childRows) <*> previous
|
||||
then (rows, previous)
|
||||
else (adjoin $ rows ++ zipWithDefaults makeRow (pure mempty) (fmap (pure . (,) Nothing) <$> (actualLineRanges <$> (makeRanges previous (start <$> childRanges)) <*> sources)) ++ (fmap (Just . (<$ child) &&& characterRange . getSplitAnnotation) <$> childRows), end <$> childRanges)
|
||||
else (adjoin $ rows ++ zipWithDefaults makeRow (pure mempty) (fmap (pure . (,) Nothing) <$> (actualLineRanges <$> (makeRanges previous (start . unionLineRanges <$> sequenceA (unRow <$> childRows))) <*> sources)) ++ (fmap (first (Just . (<$ child))) <$> childRows), end . unionLineRanges <$> sequenceA (unRow <$> childRows))
|
||||
|
||||
-- | Wrap a list of child terms in a branch.
|
||||
makeBranchTerm :: (Info -> [inTerm] -> outTerm) -> Set.Set Category -> [(Maybe inTerm, Range)] -> outTerm
|
||||
|
@ -28,14 +28,14 @@ import Term
|
||||
-- | Render a diff to a string representing its JSON.
|
||||
json :: Renderer a ByteString
|
||||
json diff sources = toLazyByteString . fromEncoding . pairs $
|
||||
"rows" .= annotateRows (Prelude.fst (splitDiffByLines diff (pure 0) (source <$> sources)))
|
||||
"rows" .= annotateRows (splitDiffByLines diff (pure 0) (source <$> sources))
|
||||
<> "oids" .= (oid <$> sources)
|
||||
<> "paths" .= (path <$> sources)
|
||||
where annotateRows = fmap (fmap NumberedLine) . Prelude.reverse . numberedRows
|
||||
|
||||
newtype NumberedLine a = NumberedLine (Int, Line a)
|
||||
|
||||
instance ToJSON (NumberedLine (SplitDiff leaf Info)) where
|
||||
instance ToJSON (NumberedLine (SplitDiff leaf Info, Range)) where
|
||||
toJSON (NumberedLine (n, a)) = object (lineFields n a)
|
||||
toEncoding (NumberedLine (n, a)) = pairs $ mconcat (lineFields n a)
|
||||
instance ToJSON Category where
|
||||
@ -59,11 +59,9 @@ instance ToJSON (Term leaf Info) where
|
||||
toJSON (info :< syntax) = object (termFields info syntax)
|
||||
toEncoding (info :< syntax) = pairs $ mconcat (termFields info syntax)
|
||||
|
||||
lineFields :: KeyValue kv => Int -> Line (SplitDiff leaf Info) -> [kv]
|
||||
lineFields :: KeyValue kv => Int -> Line (SplitDiff leaf Info, Range) -> [kv]
|
||||
lineFields _ EmptyLine = []
|
||||
lineFields n line = [ "number" .= n, "terms" .= unLine line, "range" .= unionRanges (getRange <$> line), "hasChanges" .= hasChanges line ]
|
||||
where getRange (Free (Annotated (Info range _) _)) = range
|
||||
getRange (Pure patch) = case getSplitTerm patch of Info range _ :< _ -> range
|
||||
lineFields n line = [ "number" .= n, "terms" .= unLine (Prelude.fst <$> line), "range" .= unionRanges (Prelude.snd <$> line), "hasChanges" .= hasChanges (Prelude.fst <$> line) ]
|
||||
|
||||
termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv]
|
||||
termFields (Info range categories) syntax = "range" .= range : "categories" .= categories : case syntax of
|
||||
|
@ -90,7 +90,7 @@ header blobs hunk = filepathHeader ++ blobOidHeader ++ maybeOffsetHeader
|
||||
-- | Render a diff as a series of hunks.
|
||||
hunks :: Renderer a [Hunk (SplitDiff a Info)]
|
||||
hunks _ blobs | Both (True, True) <- Source.null . source <$> blobs = [Hunk { offset = mempty, changes = [], trailingContext = [] }]
|
||||
hunks diff blobs = hunksInRows (Both (1, 1)) . Prelude.fst $ splitDiffByLines diff (pure 0) (source <$> blobs)
|
||||
hunks diff blobs = hunksInRows (Both (1, 1)) $ fmap Prelude.fst <$> splitDiffByLines diff (pure 0) (source <$> blobs)
|
||||
|
||||
-- | Given beginning line numbers, turn rows in a split diff into hunks in a
|
||||
-- | patch.
|
||||
|
@ -61,8 +61,7 @@ split diff blobs = renderHtml
|
||||
. mconcat $ numberedLinesToMarkup <$> reverse numbered
|
||||
where
|
||||
sources = Source.source <$> blobs
|
||||
rows = Prelude.fst (splitDiffByLines diff (pure 0) sources)
|
||||
numbered = numberedRows rows
|
||||
numbered = numberedRows (fmap Prelude.fst <$> splitDiffByLines diff (pure 0) sources)
|
||||
maxNumber = case numbered of
|
||||
[] -> 0
|
||||
(row : _) -> runBothWith max $ Prelude.fst <$> row
|
||||
|
@ -55,12 +55,12 @@ spec = parallel $ do
|
||||
prop "outputs one row for single-line unchanged leaves" $
|
||||
forAll (arbitraryLeaf `suchThat` isOnSingleLine) $
|
||||
\ (source, info@(Info range categories), syntax) -> splitAnnotatedByLines (pure source) (pure range) (pure categories) syntax `shouldBe` [
|
||||
makeRow (makeLine [ Free $ Annotated info $ Leaf source ]) (makeLine [ Free $ Annotated info $ Leaf source ]) ]
|
||||
makeRow (pure (Free $ Annotated info $ Leaf source, Range 0 (length source))) (pure (Free $ Annotated info $ Leaf source, Range 0 (length source))) ]
|
||||
|
||||
prop "outputs one row for single-line empty unchanged indexed nodes" $
|
||||
forAll (arbitrary `suchThat` (\ a -> filter (/= '\n') (toList a) == toList a)) $
|
||||
\ source -> splitAnnotatedByLines (pure source) (pure (getTotalRange source)) (pure mempty) (Indexed [] :: Syntax String (Diff String Info)) `shouldBe` [
|
||||
makeRow (makeLine [ Free $ Annotated (Info (getTotalRange source) mempty) $ Indexed [] ]) (makeLine [ Free $ Annotated (Info (getTotalRange source) mempty) $ Indexed [] ]) ]
|
||||
makeRow (pure (Free $ Annotated (Info (getTotalRange source) mempty) $ Indexed [], Range 0 (length source))) (pure (Free $ Annotated (Info (getTotalRange source) mempty) $ Indexed [], Range 0 (length source))) ]
|
||||
|
||||
prop "preserves line counts in equal sources" $
|
||||
\ source ->
|
||||
@ -98,7 +98,7 @@ spec = parallel $ do
|
||||
describe "splitPatchByLines" $ do
|
||||
prop "starts at initial indices" $
|
||||
\ patch sources -> let indices = length <$> sources in
|
||||
start <$> (Prelude.snd (splitPatchByLines (patchWithBoth patch (leafWithRangeInSource <$> sources <*> (Range <$> indices <*> ((2 *) <$> indices)))) indices ((Source.++) <$> sources <*> sources))) `shouldBe` indices
|
||||
fmap start . maybeFirst . Maybe.catMaybes <$> Both.unzip (fmap maybeFirst . unRow . fmap Prelude.snd <$> (splitPatchByLines (patchWithBoth patch (leafWithRangeInSource <$> sources <*> (Range <$> indices <*> ((2 *) <$> indices)))) indices ((Source.++) <$> sources <*> sources))) `shouldBe` (<$) <$> indices <*> unPatch patch
|
||||
|
||||
describe "openLineBy" $ do
|
||||
it "produces the earliest non-empty line in a list, if open" $
|
||||
|
Loading…
Reference in New Issue
Block a user