github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-01 09:15:01 +03:00
Code Issues Projects Releases Wiki Activity

Represent categories in Both.

Browse Source
This commit is contained in:
Rob Rix 2016-02-28 22:10:02 -05:00
parent c3039cd853
commit 0d77576a52
2 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Alignment.hs
View File

@ -29,7 +29,7 @@ splitDiffByLines diff (prevLeft, prevRight) sources = case diff of
Pure (Replace leftTerm rightTerm) -> let (leftLines, leftRange) = splitTermByLines leftTerm (fst $ runBoth sources)
(rightLines, rightRange) = splitTermByLines rightTerm (snd $ runBoth sources) in
(zipWithDefaults Row EmptyLine EmptyLine (fmap (Pure . SplitReplace) <$> leftLines) (fmap (Pure . SplitReplace) <$> rightLines), Both (leftRange, rightRange))
where categories (Info _ left, Info _ right) = (left, right)
where categories annotations = Diff.categories <$> Both annotations
ranges annotations = characterRange <$> Both annotations
-- | A functor that can return its content.
@ -68,9 +68,9 @@ splitTermByLines (Info range categories :< syntax) source = flip (,) range $ cas
(adjoin $ lines ++ (pure . Left <$> actualLineRanges (Range previous $ start childRange) source) ++ (fmap (Right . (<$ child)) <$> childLines), end childRange)
-- | Split a annotated diff into rows of split diffs.
splitAnnotatedByLines :: Both (Source Char) -> Both Range -> (Set.Set Category, 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)]
splitAnnotatedByLines sources ranges categories syntax = case syntax of
Leaf a -> wrapRowContents (Free . (`Annotated` Leaf a) . (`Info` fst categories) . unionRanges) (Free . (`Annotated` Leaf a) . (`Info` snd categories) . unionRanges) <$> contextRows ranges sources
Leaf a -> wrapRowContents (Free . (`Annotated` Leaf a) . (`Info` fst (runBoth categories)) . unionRanges) (Free . (`Annotated` Leaf a) . (`Info` snd (runBoth categories)) . unionRanges) <$> contextRows ranges sources
Indexed children -> adjoinChildRows (Indexed . fmap get) (Identity <$> children)
Fixed children -> adjoinChildRows (Fixed . fmap get) (Identity <$> children)
Keyed children -> adjoinChildRows (Keyed . Map.fromList) (Map.toList children)
@ -83,7 +83,7 @@ splitAnnotatedByLines sources ranges categories syntax = case syntax of
adjoinChildRows :: (Has f) => ([f (SplitDiff leaf Info)] -> Syntax leaf (SplitDiff leaf Info)) -> [f (Diff leaf Info)] -> [Row (SplitDiff leaf Info)]
adjoinChildRows constructor children = let (rows, previous) = foldl childRows ([], runBoth $ start <$> ranges) children in
fmap (wrapRowContents (wrap constructor (fst categories)) (wrap constructor (snd categories))) . adjoin $ rows ++ (fmap Left <$> contextRows (makeRanges previous (end <$> ranges)) sources)
fmap (wrapRowContents (wrap constructor (fst $ runBoth categories)) (wrap constructor (snd $ runBoth categories))) . adjoin $ rows ++ (fmap Left <$> contextRows (makeRanges previous (end <$> ranges)) sources)
wrap :: Has f => ([f (SplitDiff leaf Info)] -> Syntax leaf (SplitDiff leaf Info)) -> Set.Set Category -> [Either Range (f (SplitDiff leaf Info))] -> SplitDiff leaf Info
wrap constructor categories children = Free . Annotated (Info (unionRanges $ getRange <$> children) categories) . constructor $ rights children

8
test/AlignmentSpec.hs
View File

@ -43,22 +43,22 @@ spec = parallel $ do
describe "splitAnnotatedByLines" $ 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) (categories, categories) syntax `shouldBe` [
\ (source, info@(Info range categories), syntax) -> splitAnnotatedByLines (pure source) (pure range) (pure categories) syntax `shouldBe` [
Row (makeLine [ Free $ Annotated info $ Leaf source ]) (makeLine [ Free $ Annotated info $ Leaf 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)) (mempty, mempty) (Indexed [] :: Syntax String (Diff String Info)) `shouldBe` [
\ source -> splitAnnotatedByLines (pure source) (pure (getTotalRange source)) (pure mempty) (Indexed [] :: Syntax String (Diff String Info)) `shouldBe` [
Row (makeLine [ Free $ Annotated (Info (getTotalRange source) mempty) $ Indexed [] ]) (makeLine [ Free $ Annotated (Info (getTotalRange source) mempty) $ Indexed [] ]) ]
prop "preserves line counts in equal sources" $
\ source ->
length (splitAnnotatedByLines (pure source) (pure (getTotalRange source)) (mempty, mempty) (Indexed . fst $ foldl combineIntoLeaves ([], 0) source)) `shouldBe` length (filter (== '\n') $ toList source) + 1
length (splitAnnotatedByLines (pure source) (pure (getTotalRange source)) (pure mempty) (Indexed . fst $ foldl combineIntoLeaves ([], 0) source)) `shouldBe` length (filter (== '\n') $ toList source) + 1
prop "produces the maximum line count in inequal sources" $
\ sources ->
let (sourceA, sourceB) = runBoth sources in
length (splitAnnotatedByLines sources (getTotalRange <$> sources) (mempty, mempty) (Indexed $ zipWith (leafWithRangesInSources sourceA sourceB) (actualLineRanges (getTotalRange sourceA) sourceA) (actualLineRanges (getTotalRange sourceB) sourceB))) `shouldBe` max (length (filter (== '\n') $ toList sourceA) + 1) (length (filter (== '\n') $ toList sourceB) + 1)
length (splitAnnotatedByLines sources (getTotalRange <$> sources) (pure mempty) (Indexed $ zipWith (leafWithRangesInSources sourceA sourceB) (actualLineRanges (getTotalRange sourceA) sourceA) (actualLineRanges (getTotalRange sourceB) sourceB))) `shouldBe` max (length (filter (== '\n') $ toList sourceA) + 1) (length (filter (== '\n') $ toList sourceB) + 1)
describe "adjoinRowsBy" $ do
prop "is identity on top of no rows" $