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

Rename adjoinRowsByR to adjoinRowsBy.

Browse Source
This commit is contained in:
Rob Rix 2016-03-07 19:36:16 -05:00
parent b1a6e4e232
commit f7b4ecc1c1
3 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Alignment.hs
View File

@ -77,7 +77,7 @@ splitAnnotatedByLines sources infos syntax = case syntax of
adjoinChildRows :: (Copointed f, Functor f) => ([f (SplitDiff leaf Info)] -> Syntax leaf (SplitDiff leaf Info)) -> [f [Row (SplitDiff leaf Info, Range)]] -> [Row (SplitDiff leaf Info, Range)]
adjoinChildRows constructor children = let (rows, next) = foldr childRows ([], end <$> ranges) children in
fmap (Row . (wrapLineContents <$> (makeBranchTerm (\ info -> Free . Annotated info . constructor) <$> categories <*> next) <*>) . unRow) . foldr (adjoinRowsByR (openRangePair <$> sources)) []
fmap (Row . (wrapLineContents <$> (makeBranchTerm (\ info -> Free . Annotated info . constructor) <$> categories <*> next) <*>) . unRow) . foldr (adjoinRowsBy (openRangePair <$> sources)) []
$ zipWithDefaults makeRow (pure mempty) (fmap (pure . (,) Nothing) <$> (actualLineRanges <$> (Range <$> (start <$> ranges) <*> next) <*> sources)) ++ rows
childRows :: (Copointed f, Functor f) => f [Row (SplitDiff leaf Info, Range)] -> ([Row (Maybe (f (SplitDiff leaf Info)), Range)], Both Int) -> ([Row (Maybe (f (SplitDiff leaf Info)), Range)], Both Int)

16
src/Row.hs
View File

@ -23,20 +23,20 @@ isOpenRowBy :: Both (MaybeOpen a) -> Row a -> Bool
isOpenRowBy f = runBothWith (&&) . (isOpenLineBy <$> f <*>) . unRow
-- | Merge open lines and prepend closed lines (as determined by a pair of functions) onto a list of rows.
adjoinRowsByR :: Both (MaybeOpen a) -> Row a -> [Row a] -> [Row a]
adjoinRowsByR _ (Row (Both (EmptyLine, EmptyLine))) rows = rows
adjoinRowsBy :: Both (MaybeOpen a) -> Row a -> [Row a] -> [Row a]
adjoinRowsBy _ (Row (Both (EmptyLine, EmptyLine))) rows = rows
adjoinRowsByR f row (nextRow : rows) | isOpenRowBy f row = Row ((<>) <$> unRow row <*> unRow nextRow) : rows
adjoinRowsBy f row (nextRow : rows) | isOpenRowBy f row = Row ((<>) <$> unRow row <*> unRow nextRow) : rows
adjoinRowsByR f (Row (Both (EmptyLine, right))) (Row (Both (nextLeft, nextRight)) : rows) | isOpenLineBy (fst f) nextLeft = makeRow nextLeft right : adjoinRowsByR f (makeRow mempty nextRight) rows
adjoinRowsBy f (Row (Both (EmptyLine, right))) (Row (Both (nextLeft, nextRight)) : rows) | isOpenLineBy (fst f) nextLeft = makeRow nextLeft right : adjoinRowsBy f (makeRow mempty nextRight) rows
adjoinRowsByR f (Row (Both (left, right))) (Row (Both (nextLeft, nextRight)) : rows) | isOpenLineBy (fst f) left = makeRow (left <> nextLeft) right : adjoinRowsByR f (makeRow mempty nextRight) rows
adjoinRowsBy f (Row (Both (left, right))) (Row (Both (nextLeft, nextRight)) : rows) | isOpenLineBy (fst f) left = makeRow (left <> nextLeft) right : adjoinRowsBy f (makeRow mempty nextRight) rows
adjoinRowsByR f (Row (Both (left, EmptyLine))) (Row (Both (nextLeft, nextRight)) : rows) | isOpenLineBy (snd f) nextRight = makeRow left nextRight : adjoinRowsByR f (makeRow nextLeft mempty) rows
adjoinRowsBy f (Row (Both (left, EmptyLine))) (Row (Both (nextLeft, nextRight)) : rows) | isOpenLineBy (snd f) nextRight = makeRow left nextRight : adjoinRowsBy f (makeRow nextLeft mempty) rows
adjoinRowsByR f (Row (Both (left, right))) (Row (Both (nextLeft, nextRight)) : rows) | isOpenLineBy (snd f) right = makeRow left (right <> nextRight) : adjoinRowsByR f (makeRow nextLeft mempty) rows
adjoinRowsBy f (Row (Both (left, right))) (Row (Both (nextLeft, nextRight)) : rows) | isOpenLineBy (snd f) right = makeRow left (right <> nextRight) : adjoinRowsBy f (makeRow nextLeft mempty) rows
adjoinRowsByR _ row rows = row : rows
adjoinRowsBy _ row rows = row : rows
instance Show a => Show (Row a) where
show (Row (Both (left, right))) = "\n" ++ show left ++ " | " ++ show right

12
test/AlignmentSpec.hs
View File

@ -74,26 +74,26 @@ spec = parallel $ do
describe "adjoinRowsBy" $ do
prop "is identity on top of no rows" $ forAll (arbitrary `suchThat` (not . isEmptyRow)) $
\ a -> adjoinRowsByR (pure openMaybe) a [] `shouldBe` [ a ]
\ a -> adjoinRowsBy (pure openMaybe) a [] `shouldBe` [ a ]
prop "prunes empty rows" $
\ a -> adjoinRowsByR (pure openMaybe) (makeRow EmptyLine EmptyLine) [ a ] `shouldBe` [ a ]
\ a -> adjoinRowsBy (pure openMaybe) (makeRow EmptyLine EmptyLine) [ a ] `shouldBe` [ a ]
prop "merges open rows" $
forAll ((arbitrary `suchThat` isOpenBy openMaybe) >>= \ a -> (,) a <$> arbitrary) $
\ (a, b) -> adjoinRowsByR (pure openMaybe) a [ b ] `shouldBe` [ Row (mappend <$> unRow a <*> unRow b) ]
\ (a, b) -> adjoinRowsBy (pure openMaybe) a [ b ] `shouldBe` [ Row (mappend <$> unRow a <*> unRow b) ]
prop "prepends closed rows" $
forAll ((arbitrary `suchThat` isClosedBy openMaybe) >>= \ a -> (,) a <$> arbitrary) $
\ (a, b) -> adjoinRowsByR (pure openMaybe) a [ b ] `shouldBe` [ a, b ]
\ (a, b) -> adjoinRowsBy (pure openMaybe) a [ b ] `shouldBe` [ a, b ]
prop "does not promote empty lines through closed rows" $
forAll ((arbitrary `suchThat` (not . isOpenLineBy openMaybe)) >>= \ a -> (,) a <$> arbitrary) $
\ (a, b) -> adjoinRowsByR (pure openMaybe) (makeRow EmptyLine a) [ makeRow a a, b ] `shouldBe` [ makeRow a a, b ]
\ (a, b) -> adjoinRowsBy (pure openMaybe) (makeRow EmptyLine a) [ makeRow a a, b ] `shouldBe` [ makeRow a a, b ]
prop "promotes empty lines through open rows" $
forAll ((arbitrary `suchThat` (\ (a, b) -> isOpenLineBy openMaybe a && not (isOpenLineBy openMaybe b))) >>= \ (a, b) -> (,,) a b <$> arbitrary) $
\ (open, closed, rest) -> adjoinRowsByR (pure openMaybe) (makeRow EmptyLine open) [ makeRow open closed, rest ] `shouldBe` [ makeRow open closed, makeRow EmptyLine open, rest ]
\ (open, closed, rest) -> adjoinRowsBy (pure openMaybe) (makeRow EmptyLine open) [ makeRow open closed, rest ] `shouldBe` [ makeRow open closed, makeRow EmptyLine open, rest ]
describe "splitAbstractedTerm" $ do
prop "preserves line count" $