github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-03 13:02:37 +03:00
Code Issues Projects Releases Wiki Activity

fmap unLeft over rows directly.

Browse Source
This commit is contained in:
Rob Rix 2015-12-21 13:20:47 -05:00
parent 6e76f3e618
commit 7b0ea6678e
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Split.hs
View File

@ -228,22 +228,22 @@ maybeLast = foldl (flip $ const . Just) Nothing
adjoinRowsBy :: (a -> Maybe a) -> [Row a] -> Row a -> [Row a]
adjoinRowsBy _ [] row = [row]
adjoinRowsBy f rows (Row left' right') | Just _ <- openLineBy f $ leftLines rows, Just _ <- openLineBy f $ rightLines rows = zipWith Row lefts rights
where lefts = adjoinLinesBy f (leftLines rows) left'
adjoinRowsBy f rows (Row left' right') | Just _ <- openLineBy f $ unLeft <$> rows, Just _ <- openLineBy f $ rightLines rows = zipWith Row lefts rights
where lefts = adjoinLinesBy f (unLeft <$> rows) left'
rights = adjoinLinesBy f (rightLines rows) right'
adjoinRowsBy f rows (Row left' right') | Just _ <- openLineBy f $ leftLines rows = case right' of
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 rights
lefts = adjoinLinesBy f (leftLines rows) left'
lefts = adjoinLinesBy f (unLeft <$> rows) left'
rights = rightLines rows
adjoinRowsBy f rows (Row left' right') | Just _ <- openLineBy f $ rightLines rows = case left' of
EmptyLine -> rest
_ -> Row left' EmptyLine : rest
where rest = zipWith Row lefts rights
lefts = leftLines rows
lefts = unLeft <$> rows
rights = adjoinLinesBy f (rightLines rows) right'
adjoinRowsBy _ rows row = row : rows