github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 18:23:44 +03:00
Code Issues Projects Releases Wiki Activity

Row wraps a Both.

Browse Source
This commit is contained in:
Rob Rix 2016-02-29 09:22:52 -05:00
parent e26b4bacd5
commit a8efcb539a
5 changed files with 37 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Alignment.hs
View File

@ -23,12 +23,12 @@ splitDiffByLines :: Diff leaf Info -> Both Int -> Both (Source Char) -> ([Row (S
splitDiffByLines diff previous sources = case diff of
Free (Annotated annotation syntax) -> (splitAnnotatedByLines sources (ranges annotation) (categories annotation) syntax, ranges annotation)
Pure (Insert term) -> let (lines, range) = splitTermByLines term (snd $ runBoth sources) in
(Row EmptyLine . fmap (Pure . SplitInsert) <$> lines, Both (Range prevLeft prevLeft, range))
(makeRow EmptyLine . fmap (Pure . SplitInsert) <$> lines, Both (Range prevLeft prevLeft, range))
Pure (Delete term) -> let (lines, range) = splitTermByLines term (fst $ runBoth sources) in
(flip Row EmptyLine . fmap (Pure . SplitDelete) <$> lines, Both (range, Range prevRight prevRight))
(flip makeRow EmptyLine . fmap (Pure . SplitDelete) <$> lines, Both (range, Range prevRight prevRight))
Pure (Replace leftTerm rightTerm) -> let Both ((leftLines, leftRange), (rightLines, rightRange)) = splitTermByLines <$> Both (leftTerm, rightTerm) <*> sources
(lines, ranges) = (Both (leftLines, rightLines), Both (leftRange, rightRange)) in
(uncurry (zipWithDefaults Row EmptyLine EmptyLine) . runBoth $ fmap (fmap (Pure . SplitReplace)) <$> lines, ranges)
(uncurry (zipWithDefaults makeRow EmptyLine EmptyLine) . runBoth $ fmap (fmap (Pure . SplitReplace)) <$> lines, ranges)
where categories annotations = Diff.categories <$> Both annotations
ranges annotations = characterRange <$> Both annotations
(prevLeft, prevRight) = runBoth previous
@ -76,7 +76,7 @@ splitAnnotatedByLines sources ranges categories syntax = case syntax of
Fixed children -> adjoinChildRows (Fixed . fmap get) (Identity <$> children)
Keyed children -> adjoinChildRows (Keyed . Map.fromList) (Map.toList children)
where contextRows :: Both Range -> Both (Source Char) -> [Row Range]
contextRows ranges sources = uncurry (zipWithDefaults Row EmptyLine EmptyLine) $
contextRows ranges sources = uncurry (zipWithDefaults makeRow EmptyLine EmptyLine) $
runBoth (fmap pure <$> (actualLineRanges <$> ranges <*> sources))
adjoin :: Has f => [Row (Either Range (f (SplitDiff leaf Info)))] -> [Row (Either Range (f (SplitDiff leaf Info)))]

4
src/Renderer/Patch.hs
View File

@ -39,7 +39,7 @@ changeLength change = mconcat $ (rowLength <$> context change) <> (rowLength <$>
-- | The number of lines in the row, each being either 0 or 1.
rowLength :: Row a -> Both (Sum Int)
rowLength (Row a b) = pure lineLength <*> Both (a, b)
rowLength = fmap lineLength . unRow
-- | The length of the line, being either 0 or 1.
lineLength :: Line a -> Sum Int
@ -125,7 +125,7 @@ changeIncludingContext leadingContext rows = case changes of
-- | Whether a row has changes on either side.
rowHasChanges :: Row (SplitDiff a Info) -> Bool
rowHasChanges (Row left right) = lineHasChanges left || lineHasChanges right
rowHasChanges (Row lines) = or (lineHasChanges <$> lines)
-- | Whether a line has changes.
lineHasChanges :: Line (SplitDiff a Info) -> Bool

2
src/Renderer/Split.hs
View File

@ -88,7 +88,7 @@ split diff blobs = renderHtml
-- | Add a row to list of tuples of ints and lines, where the ints denote
-- | how many non-empty lines exist on that side up to that point.
numberRows :: [(Int, Line a, Int, Line a)] -> Row a -> [(Int, Line a, Int, Line a)]
numberRows rows (Row left right) = (leftCount rows + valueOf left, left, rightCount rows + valueOf right, right) : rows
numberRows rows (Row (Both (left, right))) = (leftCount rows + valueOf left, left, rightCount rows + valueOf right, right) : rows
where
leftCount [] = 0
leftCount ((x, _, _, _):_) = x

35
src/Row.hs
View File

@ -5,43 +5,48 @@ import Data.Functor.Both as Both
import Line
-- | A row in a split diff, composed of a before line and an after line.
data Row a = Row { unLeft :: !(Line a), unRight :: !(Line a) }
newtype Row a = Row { unRow :: Both (Line a) }
deriving (Eq, Functor)
-- | Return a tuple of lines from the row.
unRow :: Row a -> Both (Line a)
unRow (Row a b) = Both (a, b)
makeRow :: Line a -> Line a -> Row a
makeRow a = Row . both a
unLeft :: Row a -> Line a
unLeft = fst . runBoth . unRow
unRight :: Row a -> Line a
unRight = snd . runBoth . unRow
-- | Map over both sides of a row with the given functions.
wrapRowContents :: Both ([a] -> b) -> Row a -> Row b
wrapRowContents transform row = uncurry Row . runBoth $ wrapLineContents <$> transform <*> unRow row
wrapRowContents transform row = Row $ wrapLineContents <$> transform <*> unRow row
-- | Given functions that determine whether an item is open, add a row to a
-- | first open, non-empty item in a list of rows, or add it as a new row.
adjoinRowsBy :: Both (MaybeOpen a) -> [Row a] -> Row a -> [Row a]
adjoinRowsBy _ [] row = [row]
adjoinRowsBy f rows (Row left' right') | Both (Just _, Just _) <- openLineBy <$> f <*> (Both.unzip $ unRow <$> rows) = Both.zipWith Row $ both <*> Both (left', right')
adjoinRowsBy f rows (Row bothLines) | Both (Just _, Just _) <- openLineBy <$> f <*> (Both.unzip $ unRow <$> rows) = Both.zipWith makeRow $ both <*> bothLines
where both = adjoinLinesBy <$> f <*> (Both.unzip $ unRow <$> rows)
adjoinRowsBy (Both (f, _)) rows (Row left' right') | Just _ <- openLineBy f $ unLeft <$> rows = case right' of
adjoinRowsBy (Both (f, _)) rows (Row (Both (left', right'))) | Just _ <- openLineBy f $ unLeft <$> rows = case right' of
EmptyLine -> rest
_ -> Row EmptyLine right' : rest
where rest = Prelude.zipWith Row (lefts left') rights
_ -> makeRow EmptyLine right' : rest
where rest = Prelude.zipWith makeRow (lefts left') rights
(lefts, rights) = first (adjoinLinesBy f) . runBoth $ Both.unzip $ unRow <$> rows
adjoinRowsBy (Both (_, g)) rows (Row left' right') | Just _ <- openLineBy g $ unRight <$> rows = case left' of
adjoinRowsBy (Both (_, g)) rows (Row (Both (left', right'))) | Just _ <- openLineBy g $ unRight <$> rows = case left' of
EmptyLine -> rest
_ -> Row left' EmptyLine : rest
where rest = Prelude.zipWith Row lefts (rights right')
_ -> makeRow left' EmptyLine : rest
where rest = Prelude.zipWith makeRow lefts (rights right')
(lefts, rights) = second (adjoinLinesBy g) . runBoth $ Both.unzip $ unRow <$> rows
adjoinRowsBy _ rows row = row : rows
instance Show a => Show (Row a) where
show (Row left right) = "\n" ++ show left ++ " | " ++ show right
show (Row (Both (left, right))) = "\n" ++ show left ++ " | " ++ show right
instance Applicative Row where
pure a = let a' = pure a in Row a' a'
Row f g <*> Row a b = Row (f <*> a) (g <*> b)
pure = Row . pure . pure
Row (Both (f, g)) <*> Row (Both (a, b)) = Row $ both (f <*> a) (g <*> b)

21
test/AlignmentSpec.hs
View File

@ -23,8 +23,7 @@ instance Arbitrary a => Arbitrary (Both a) where
arbitrary = pure (curry Both) <*> arbitrary <*> arbitrary
instance Arbitrary a => Arbitrary (Row a) where
arbitrary = oneof [
Row <$> arbitrary <*> arbitrary ]
arbitrary = Row <$> arbitrary
instance Arbitrary a => Arbitrary (Line a) where
arbitrary = oneof [
@ -44,12 +43,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` [
Row (makeLine [ Free $ Annotated info $ Leaf source ]) (makeLine [ Free $ Annotated info $ Leaf source ]) ]
makeRow (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)) (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 [] ]) ]
makeRow (makeLine [ Free $ Annotated (Info (getTotalRange source) mempty) $ Indexed [] ]) (makeLine [ Free $ Annotated (Info (getTotalRange source) mempty) $ Indexed [] ]) ]
prop "preserves line counts in equal sources" $
\ source ->
@ -66,8 +65,8 @@ spec = parallel $ do
prop "appends onto open rows" $
forAll ((arbitrary `suchThat` isOpenBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isOpenBy openMaybe)) $
\ (a@(Row a1 b1), b@(Row a2 b2)) ->
adjoinRowsBy (pure openMaybe) [ a ] b `shouldBe` [ Row (makeLine $ unLine a1 ++ unLine a2) (makeLine $ unLine b1 ++ unLine b2) ]
\ (a@(Row (Both (a1, b1))), b@(Row (Both (a2, b2)))) ->
adjoinRowsBy (pure openMaybe) [ a ] b `shouldBe` [ makeRow (makeLine $ unLine a1 ++ unLine a2) (makeLine $ unLine b1 ++ unLine b2) ]
prop "does not append onto closed rows" $
forAll ((arbitrary `suchThat` isClosedBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isClosedBy openMaybe)) $
@ -75,11 +74,11 @@ spec = parallel $ do
prop "does not promote elements through empty lines onto closed lines" $
forAll ((arbitrary `suchThat` isClosedBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isClosedBy openMaybe)) $
\ (a, b) -> adjoinRowsBy (pure openMaybe) [ Row EmptyLine EmptyLine, a ] b `shouldBe` [ b, Row EmptyLine EmptyLine, a ]
\ (a, b) -> adjoinRowsBy (pure openMaybe) [ makeRow EmptyLine EmptyLine, a ] b `shouldBe` [ b, makeRow EmptyLine EmptyLine, a ]
prop "promotes elements through empty lines onto open lines" $
forAll ((arbitrary `suchThat` isOpenBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isOpenBy openMaybe)) $
\ (a, b) -> adjoinRowsBy (pure openMaybe) [ Row EmptyLine EmptyLine, a ] b `shouldBe` Row EmptyLine EmptyLine : adjoinRowsBy (pure openMaybe) [ a ] b
\ (a, b) -> adjoinRowsBy (pure openMaybe) [ makeRow EmptyLine EmptyLine, a ] b `shouldBe` makeRow EmptyLine EmptyLine : adjoinRowsBy (pure openMaybe) [ a ] b
describe "splitTermByLines" $ do
prop "preserves line count" $
@ -106,9 +105,9 @@ spec = parallel $ do
openTerm (fromList " \n") (Identity $ Info (Range 0 2) mempty :< Leaf "") `shouldBe` Nothing
where
isOpenBy f (Row a b) = Maybe.isJust (openLineBy f [ a ]) && Maybe.isJust (openLineBy f [ b ])
isClosedBy f (Row a@(Line _) b@(Line _)) = Maybe.isNothing (openLineBy f [ a ]) && Maybe.isNothing (openLineBy f [ b ])
isClosedBy _ (Row _ _) = False
isOpenBy f (Row lines) = and (Maybe.isJust . openLineBy f . pure <$> lines)
isClosedBy f (Row lines@(Both (Line _, Line _))) = and (Maybe.isNothing . openLineBy f . pure <$> lines)
isClosedBy _ _ = False
isOnSingleLine (a, _, _) = filter (/= '\n') (toList a) == toList a