1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +03:00

unRow returns Both.

This commit is contained in:
Rob Rix 2016-02-29 00:42:48 -05:00
parent 834b521e23
commit e606700b57

View File

@ -1,6 +1,7 @@
module Row where
import Control.Arrow
import Data.Functor.Both
import Line
-- | A row in a split diff, composed of a before line and an after line.
@ -8,8 +9,8 @@ data Row a = Row { unLeft :: !(Line a), unRight :: !(Line a) }
deriving (Eq, Functor)
-- | Return a tuple of lines from the row.
unRow :: Row a -> (Line a, Line a)
unRow (Row a b) = (a, b)
unRow :: Row a -> Both (Line a)
unRow (Row a b) = Both (a, b)
-- | Map over both sides of a row with the given functions.
wrapRowContents :: ([a] -> b) -> ([a] -> b) -> Row a -> Row b
@ -21,19 +22,19 @@ adjoinRowsBy :: MaybeOpen a -> MaybeOpen a -> [Row a] -> Row a -> [Row a]
adjoinRowsBy _ _ [] row = [row]
adjoinRowsBy f g rows (Row left' right') | Just _ <- openLineBy f $ unLeft <$> rows, Just _ <- openLineBy g $ unRight <$> rows = zipWith Row (lefts left') (rights right')
where (lefts, rights) = adjoinLinesBy f *** adjoinLinesBy g $ unzip $ unRow <$> rows
where (lefts, rights) = adjoinLinesBy f *** adjoinLinesBy g $ unzip $ runBoth . unRow <$> rows
adjoinRowsBy f _ rows (Row left' right') | Just _ <- openLineBy f $ unLeft <$> rows = case right' of
EmptyLine -> rest
_ -> Row EmptyLine right' : rest
where rest = zipWith Row (lefts left') rights
(lefts, rights) = first (adjoinLinesBy f) $ unzip $ unRow <$> rows
(lefts, rights) = first (adjoinLinesBy f) $ unzip $ runBoth . unRow <$> rows
adjoinRowsBy _ g rows (Row left' right') | Just _ <- openLineBy g $ unRight <$> rows = case left' of
EmptyLine -> rest
_ -> Row left' EmptyLine : rest
where rest = zipWith Row lefts (rights right')
(lefts, rights) = second (adjoinLinesBy g) $ unzip $ unRow <$> rows
(lefts, rights) = second (adjoinLinesBy g) $ unzip $ runBoth . unRow <$> rows
adjoinRowsBy _ _ rows row = row : rows