mirror of
https://github.com/github/semantic.git
synced 2024-12-01 09:15:01 +03:00
Row wraps a Both.
This commit is contained in:
parent
e26b4bacd5
commit
a8efcb539a
@ -23,12 +23,12 @@ splitDiffByLines :: Diff leaf Info -> Both Int -> Both (Source Char) -> ([Row (S
|
|||||||
splitDiffByLines diff previous sources = case diff of
|
splitDiffByLines diff previous sources = case diff of
|
||||||
Free (Annotated annotation syntax) -> (splitAnnotatedByLines sources (ranges annotation) (categories annotation) syntax, ranges annotation)
|
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
|
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
|
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
|
Pure (Replace leftTerm rightTerm) -> let Both ((leftLines, leftRange), (rightLines, rightRange)) = splitTermByLines <$> Both (leftTerm, rightTerm) <*> sources
|
||||||
(lines, ranges) = (Both (leftLines, rightLines), Both (leftRange, rightRange)) in
|
(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
|
where categories annotations = Diff.categories <$> Both annotations
|
||||||
ranges annotations = characterRange <$> Both annotations
|
ranges annotations = characterRange <$> Both annotations
|
||||||
(prevLeft, prevRight) = runBoth previous
|
(prevLeft, prevRight) = runBoth previous
|
||||||
@ -76,7 +76,7 @@ splitAnnotatedByLines sources ranges categories syntax = case syntax of
|
|||||||
Fixed children -> adjoinChildRows (Fixed . fmap get) (Identity <$> children)
|
Fixed children -> adjoinChildRows (Fixed . fmap get) (Identity <$> children)
|
||||||
Keyed children -> adjoinChildRows (Keyed . Map.fromList) (Map.toList children)
|
Keyed children -> adjoinChildRows (Keyed . Map.fromList) (Map.toList children)
|
||||||
where contextRows :: Both Range -> Both (Source Char) -> [Row Range]
|
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))
|
runBoth (fmap pure <$> (actualLineRanges <$> ranges <*> sources))
|
||||||
|
|
||||||
adjoin :: Has f => [Row (Either Range (f (SplitDiff leaf Info)))] -> [Row (Either Range (f (SplitDiff leaf Info)))]
|
adjoin :: Has f => [Row (Either Range (f (SplitDiff leaf Info)))] -> [Row (Either Range (f (SplitDiff leaf Info)))]
|
||||||
|
@ -39,7 +39,7 @@ changeLength change = mconcat $ (rowLength <$> context change) <> (rowLength <$>
|
|||||||
|
|
||||||
-- | The number of lines in the row, each being either 0 or 1.
|
-- | The number of lines in the row, each being either 0 or 1.
|
||||||
rowLength :: Row a -> Both (Sum Int)
|
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.
|
-- | The length of the line, being either 0 or 1.
|
||||||
lineLength :: Line a -> Sum Int
|
lineLength :: Line a -> Sum Int
|
||||||
@ -125,7 +125,7 @@ changeIncludingContext leadingContext rows = case changes of
|
|||||||
|
|
||||||
-- | Whether a row has changes on either side.
|
-- | Whether a row has changes on either side.
|
||||||
rowHasChanges :: Row (SplitDiff a Info) -> Bool
|
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.
|
-- | Whether a line has changes.
|
||||||
lineHasChanges :: Line (SplitDiff a Info) -> Bool
|
lineHasChanges :: Line (SplitDiff a Info) -> Bool
|
||||||
|
@ -88,7 +88,7 @@ split diff blobs = renderHtml
|
|||||||
-- | Add a row to list of tuples of ints and lines, where the ints denote
|
-- | 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.
|
-- | 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 :: [(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
|
where
|
||||||
leftCount [] = 0
|
leftCount [] = 0
|
||||||
leftCount ((x, _, _, _):_) = x
|
leftCount ((x, _, _, _):_) = x
|
||||||
|
35
src/Row.hs
35
src/Row.hs
@ -5,43 +5,48 @@ import Data.Functor.Both as Both
|
|||||||
import Line
|
import Line
|
||||||
|
|
||||||
-- | A row in a split diff, composed of a before line and an after 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)
|
deriving (Eq, Functor)
|
||||||
|
|
||||||
-- | Return a tuple of lines from the row.
|
makeRow :: Line a -> Line a -> Row a
|
||||||
unRow :: Row a -> Both (Line a)
|
makeRow a = Row . both a
|
||||||
unRow (Row a b) = Both (a, b)
|
|
||||||
|
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.
|
-- | Map over both sides of a row with the given functions.
|
||||||
wrapRowContents :: Both ([a] -> b) -> Row a -> Row b
|
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
|
-- | 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.
|
-- | 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 :: Both (MaybeOpen a) -> [Row a] -> Row a -> [Row a]
|
||||||
adjoinRowsBy _ [] row = [row]
|
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)
|
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
|
EmptyLine -> rest
|
||||||
_ -> Row EmptyLine right' : rest
|
_ -> makeRow EmptyLine right' : rest
|
||||||
where rest = Prelude.zipWith Row (lefts left') rights
|
where rest = Prelude.zipWith makeRow (lefts left') rights
|
||||||
(lefts, rights) = first (adjoinLinesBy f) . runBoth $ Both.unzip $ unRow <$> rows
|
(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
|
EmptyLine -> rest
|
||||||
_ -> Row left' EmptyLine : rest
|
_ -> makeRow left' EmptyLine : rest
|
||||||
where rest = Prelude.zipWith Row lefts (rights right')
|
where rest = Prelude.zipWith makeRow lefts (rights right')
|
||||||
(lefts, rights) = second (adjoinLinesBy g) . runBoth $ Both.unzip $ unRow <$> rows
|
(lefts, rights) = second (adjoinLinesBy g) . runBoth $ Both.unzip $ unRow <$> rows
|
||||||
|
|
||||||
adjoinRowsBy _ rows row = row : rows
|
adjoinRowsBy _ rows row = row : rows
|
||||||
|
|
||||||
|
|
||||||
instance Show a => Show (Row a) where
|
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
|
instance Applicative Row where
|
||||||
pure a = let a' = pure a in Row a' a'
|
pure = Row . pure . pure
|
||||||
Row f g <*> Row a b = Row (f <*> a) (g <*> b)
|
Row (Both (f, g)) <*> Row (Both (a, b)) = Row $ both (f <*> a) (g <*> b)
|
||||||
|
@ -23,8 +23,7 @@ instance Arbitrary a => Arbitrary (Both a) where
|
|||||||
arbitrary = pure (curry Both) <*> arbitrary <*> arbitrary
|
arbitrary = pure (curry Both) <*> arbitrary <*> arbitrary
|
||||||
|
|
||||||
instance Arbitrary a => Arbitrary (Row a) where
|
instance Arbitrary a => Arbitrary (Row a) where
|
||||||
arbitrary = oneof [
|
arbitrary = Row <$> arbitrary
|
||||||
Row <$> arbitrary <*> arbitrary ]
|
|
||||||
|
|
||||||
instance Arbitrary a => Arbitrary (Line a) where
|
instance Arbitrary a => Arbitrary (Line a) where
|
||||||
arbitrary = oneof [
|
arbitrary = oneof [
|
||||||
@ -44,12 +43,12 @@ spec = parallel $ do
|
|||||||
prop "outputs one row for single-line unchanged leaves" $
|
prop "outputs one row for single-line unchanged leaves" $
|
||||||
forAll (arbitraryLeaf `suchThat` isOnSingleLine) $
|
forAll (arbitraryLeaf `suchThat` isOnSingleLine) $
|
||||||
\ (source, info@(Info range categories), syntax) -> splitAnnotatedByLines (pure source) (pure range) (pure 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 ]) ]
|
makeRow (makeLine [ Free $ Annotated info $ Leaf source ]) (makeLine [ Free $ Annotated info $ Leaf source ]) ]
|
||||||
|
|
||||||
prop "outputs one row for single-line empty unchanged indexed nodes" $
|
prop "outputs one row for single-line empty unchanged indexed nodes" $
|
||||||
forAll (arbitrary `suchThat` (\ a -> filter (/= '\n') (toList a) == toList a)) $
|
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` [
|
\ 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" $
|
prop "preserves line counts in equal sources" $
|
||||||
\ source ->
|
\ source ->
|
||||||
@ -66,8 +65,8 @@ spec = parallel $ do
|
|||||||
|
|
||||||
prop "appends onto open rows" $
|
prop "appends onto open rows" $
|
||||||
forAll ((arbitrary `suchThat` isOpenBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isOpenBy openMaybe)) $
|
forAll ((arbitrary `suchThat` isOpenBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isOpenBy openMaybe)) $
|
||||||
\ (a@(Row a1 b1), b@(Row a2 b2)) ->
|
\ (a@(Row (Both (a1, b1))), b@(Row (Both (a2, b2)))) ->
|
||||||
adjoinRowsBy (pure openMaybe) [ a ] b `shouldBe` [ Row (makeLine $ unLine a1 ++ unLine a2) (makeLine $ unLine b1 ++ unLine 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" $
|
prop "does not append onto closed rows" $
|
||||||
forAll ((arbitrary `suchThat` isClosedBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isClosedBy openMaybe)) $
|
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" $
|
prop "does not promote elements through empty lines onto closed lines" $
|
||||||
forAll ((arbitrary `suchThat` isClosedBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isClosedBy openMaybe)) $
|
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" $
|
prop "promotes elements through empty lines onto open lines" $
|
||||||
forAll ((arbitrary `suchThat` isOpenBy openMaybe) >>= \ a -> (,) a <$> (arbitrary `suchThat` isOpenBy openMaybe)) $
|
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
|
describe "splitTermByLines" $ do
|
||||||
prop "preserves line count" $
|
prop "preserves line count" $
|
||||||
@ -106,9 +105,9 @@ spec = parallel $ do
|
|||||||
openTerm (fromList " \n") (Identity $ Info (Range 0 2) mempty :< Leaf "") `shouldBe` Nothing
|
openTerm (fromList " \n") (Identity $ Info (Range 0 2) mempty :< Leaf "") `shouldBe` Nothing
|
||||||
|
|
||||||
where
|
where
|
||||||
isOpenBy f (Row a b) = Maybe.isJust (openLineBy f [ a ]) && Maybe.isJust (openLineBy f [ b ])
|
isOpenBy f (Row lines) = and (Maybe.isJust . openLineBy f . pure <$> lines)
|
||||||
isClosedBy f (Row a@(Line _) b@(Line _)) = Maybe.isNothing (openLineBy f [ a ]) && Maybe.isNothing (openLineBy f [ b ])
|
isClosedBy f (Row lines@(Both (Line _, Line _))) = and (Maybe.isNothing . openLineBy f . pure <$> lines)
|
||||||
isClosedBy _ (Row _ _) = False
|
isClosedBy _ _ = False
|
||||||
|
|
||||||
isOnSingleLine (a, _, _) = filter (/= '\n') (toList a) == toList a
|
isOnSingleLine (a, _, _) = filter (/= '\n') (toList a) == toList a
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user