1
1
mirror of https://github.com/github/semantic.git synced 2024-12-24 15:35:14 +03:00

Pass the categories to wrap instead of closing over them.

This commit is contained in:
Rob Rix 2016-03-04 08:46:17 -05:00
parent ea21e16dae
commit 5aef110720

View File

@ -62,9 +62,9 @@ splitAbstractedTerm getInfo getSyntax makeTerm source term = case getSyntax term
where adjoin = reverse . foldl (adjoinLinesBy (openRangePair source)) []
adjoinChildLines constructor children = let (lines, previous) = foldl childLines ([], start (characterRange (getInfo term))) children in
fmap (wrapLineContents (wrap constructor makeTerm &&& (unionRanges . fmap Prelude.snd))) . adjoin $ lines ++ (pure . (,) Nothing <$> actualLineRanges (Range previous $ end (characterRange (getInfo term))) source)
fmap (wrapLineContents (wrap constructor makeTerm (Diff.categories (getInfo term)) &&& (unionRanges . fmap Prelude.snd))) . adjoin $ lines ++ (pure . (,) Nothing <$> actualLineRanges (Range previous $ end (characterRange (getInfo term))) source)
wrap constructor makeTerm children = (makeTerm $ Info (unionRanges $ Prelude.snd <$> children) (Diff.categories (getInfo term))) . constructor . catMaybes $ Prelude.fst <$> children
wrap constructor makeTerm categories children = (makeTerm $ Info (unionRanges $ Prelude.snd <$> children) categories) . constructor . catMaybes $ Prelude.fst <$> children
childLines (lines, previous) child = let childLines = splitAbstractedTerm getInfo getSyntax makeTerm source (copoint child) in
(adjoin $ lines ++ (pure . (,) Nothing <$> actualLineRanges (Range previous $ start (rangeForChildLines childLines)) source) ++ (fmap (flip (,) (rangeForChildLines childLines) . Just . (<$ child)) <$> childLines), end (rangeForChildLines childLines))