github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-04 21:47:07 +03:00
Code Issues Projects Releases Wiki Activity

wrapRowContents applies Both functions to Row contents.

Browse Source
This commit is contained in:
Rob Rix 2016-02-29 08:38:58 -05:00
parent 2c4acfb14f
commit 8303fd08ad
2 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Alignment.hs
View File

@ -71,7 +71,7 @@ splitTermByLines (Info range categories :< syntax) source = flip (,) range $ cas
-- | Split a annotated diff into rows of split diffs.
splitAnnotatedByLines :: Both (Source Char) -> Both Range -> Both (Set.Set Category) -> Syntax leaf (Diff leaf Info) -> [Row (SplitDiff leaf Info)]
splitAnnotatedByLines sources ranges categories syntax = case syntax of
Leaf a -> wrapRowContents (Free . (`Annotated` Leaf a) . (`Info` fst (runBoth categories)) . unionRanges) (Free . (`Annotated` Leaf a) . (`Info` snd (runBoth categories)) . unionRanges) <$> contextRows ranges sources
Leaf a -> wrapRowContents (((Free . (`Annotated` Leaf a)) .) <$> ((. unionRanges) . flip Info <$> categories)) <$> contextRows ranges sources
Indexed children -> adjoinChildRows (Indexed . fmap get) (Identity <$> children)
Fixed children -> adjoinChildRows (Fixed . fmap get) (Identity <$> children)
Keyed children -> adjoinChildRows (Keyed . Map.fromList) (Map.toList children)
@ -84,7 +84,7 @@ splitAnnotatedByLines sources ranges categories syntax = case syntax of
adjoinChildRows :: Has f => ([f (SplitDiff leaf Info)] -> Syntax leaf (SplitDiff leaf Info)) -> [f (Diff leaf Info)] -> [Row (SplitDiff leaf Info)]
adjoinChildRows constructor children = let (rows, previous) = foldl childRows ([], start <$> ranges) children in
fmap (wrapRowContents (wrap constructor (fst $ runBoth categories)) (wrap constructor (snd $ runBoth categories))) . adjoin $ rows ++ (fmap Left <$> contextRows (makeRanges previous (end <$> ranges)) sources)
fmap (wrapRowContents (wrap constructor <$> categories)) . adjoin $ rows ++ (fmap Left <$> contextRows (makeRanges previous (end <$> ranges)) sources)
wrap :: Has f => ([f (SplitDiff leaf Info)] -> Syntax leaf (SplitDiff leaf Info)) -> Set.Set Category -> [Either Range (f (SplitDiff leaf Info))] -> SplitDiff leaf Info
wrap constructor categories children = Free . Annotated (Info (unionRanges $ getRange <$> children) categories) . constructor $ rights children

4
src/Row.hs
View File

@ -13,8 +13,8 @@ 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
wrapRowContents transformLeft transformRight (Row left right) = Row (wrapLineContents transformLeft left) (wrapLineContents transformRight right)
wrapRowContents :: Both ([a] -> b) -> Row a -> Row b
wrapRowContents transform row = uncurry Row . runBoth $ wrapLineContents <$> transform <*> unRow row
-- | 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.