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

Add a type parameter for the elements of Sources.

Browse Source
This commit is contained in:
Rob Rix 2015-12-23 21:38:23 -05:00
parent 6a879d4967
commit 002147ac3e
1 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/Split.hs
View File

@ -19,15 +19,15 @@ import Data.Monoid
import qualified Data.Set as Set import qualified Data.Set as Set
type ClassName = String type ClassName = String
type Source = String type Source a = [a]
subsource :: Range -> Source -> Source subsource :: Range -> Source a -> Source a
subsource = substring subsource = substring
toString :: Source -> String toString :: Source Char -> String
toString source = source toString source = source
at :: Source -> Int -> Char at :: Source a -> Int -> a
at = (!!) at = (!!)
classifyMarkup :: Foldable f => f String -> Markup -> Markup classifyMarkup :: Foldable f => f String -> Markup -> Markup
@ -76,7 +76,7 @@ split diff before after = return . renderHtml
-- | A diff with only one side’s annotations. -- | A diff with only one side’s annotations.
type SplitDiff leaf annotation = Free (Annotated leaf annotation) (Term leaf annotation) type SplitDiff leaf annotation = Free (Annotated leaf annotation) (Term leaf annotation)
newtype Renderable a = Renderable (Source, a) newtype Renderable a = Renderable (Source Char, a)
instance ToMarkup f => ToMarkup (Renderable (Info, Syntax a (f, Range))) where instance ToMarkup f => ToMarkup (Renderable (Info, Syntax a (f, Range))) where
toMarkup (Renderable (source, (Info range categories, syntax))) = classifyMarkup categories $ case syntax of toMarkup (Renderable (source, (Info range categories, syntax))) = classifyMarkup categories $ case syntax of
@ -98,7 +98,7 @@ instance ToMarkup (Renderable (SplitDiff a Info)) where
where toMarkupAndRange :: Term a Info -> (Markup, Range) where toMarkupAndRange :: Term a Info -> (Markup, Range)
toMarkupAndRange term@(Info range _ :< _) = ((div ! A.class_ (stringValue "patch")) . toMarkup $ Renderable (source, term), range) toMarkupAndRange term@(Info range _ :< _) = ((div ! A.class_ (stringValue "patch")) . toMarkup $ Renderable (source, term), range)
splitDiffByLines :: Diff a Info -> (Int, Int) -> (Source, Source) -> ([Row (SplitDiff a Info)], (Range, Range)) splitDiffByLines :: Diff a Info -> (Int, Int) -> (Source Char, Source Char) -> ([Row (SplitDiff a Info)], (Range, Range))
splitDiffByLines diff (prevLeft, prevRight) sources = case diff of splitDiffByLines diff (prevLeft, prevRight) sources = case diff of
Free (Annotated annotation syntax) -> (splitAnnotatedByLines sources (ranges annotation) (categories annotation) syntax, ranges annotation) Free (Annotated annotation syntax) -> (splitAnnotatedByLines sources (ranges annotation) (categories annotation) syntax, ranges annotation)
Pure (Insert term) -> let (lines, range) = splitTermByLines term (snd sources) in Pure (Insert term) -> let (lines, range) = splitTermByLines term (snd sources) in
@ -112,7 +112,7 @@ splitDiffByLines diff (prevLeft, prevRight) sources = case diff of
ranges (Info left _, Info right _) = (left, right) ranges (Info left _, Info right _) = (left, right)
-- | Takes a term and a source and returns a list of lines and their range within source. -- | Takes a term and a source and returns a list of lines and their range within source.
splitTermByLines :: Term a Info -> Source -> ([Line (Term a Info)], Range) splitTermByLines :: Term a Info -> Source Char -> ([Line (Term a Info)], Range)
splitTermByLines (Info range categories :< syntax) source = flip (,) range $ case syntax of splitTermByLines (Info range categories :< syntax) source = flip (,) range $ case syntax of
Leaf a -> contextLines (:< Leaf a) range categories source Leaf a -> contextLines (:< Leaf a) range categories source
Indexed children -> adjoinChildLines Indexed children Indexed children -> adjoinChildLines Indexed children
@ -125,7 +125,7 @@ splitTermByLines (Info range categories :< syntax) source = flip (,) range $ cas
childLines constructor (lines, previous) child = let (childLines, childRange) = splitTermByLines child source in childLines constructor (lines, previous) child = let (childLines, childRange) = splitTermByLines child source in
(adjoin $ lines ++ contextLines (:< constructor) (Range previous $ start childRange) categories source ++ childLines, end childRange) (adjoin $ lines ++ contextLines (:< constructor) (Range previous $ start childRange) categories source ++ childLines, end childRange)
splitAnnotatedByLines :: (Source, Source) -> (Range, Range) -> (Set.Set Category, Set.Set Category) -> Syntax a (Diff a Info) -> [Row (SplitDiff a Info)] splitAnnotatedByLines :: (Source Char, Source Char) -> (Range, Range) -> (Set.Set Category, Set.Set Category) -> Syntax a (Diff a Info) -> [Row (SplitDiff a Info)]
splitAnnotatedByLines sources ranges categories syntax = case syntax of splitAnnotatedByLines sources ranges categories syntax = case syntax of
Leaf a -> contextRows (Leaf a) ranges categories sources Leaf a -> contextRows (Leaf a) ranges categories sources
Indexed children -> adjoinChildRows Indexed children Indexed children -> adjoinChildRows Indexed children
@ -144,25 +144,25 @@ splitAnnotatedByLines sources ranges categories syntax = case syntax of
ends (left, right) = (end left, end right) ends (left, right) = (end left, end right)
makeRanges (leftStart, rightStart) (leftEnd, rightEnd) = (Range leftStart leftEnd, Range rightStart rightEnd) makeRanges (leftStart, rightStart) (leftEnd, rightEnd) = (Range leftStart leftEnd, Range rightStart rightEnd)
contextLines :: (Info -> a) -> Range -> Set.Set Category -> Source -> [Line a] contextLines :: (Info -> a) -> Range -> Set.Set Category -> Source Char -> [Line a]
contextLines constructor range categories source = Line . (:[]) . constructor . (`Info` categories) <$> actualLineRanges range source contextLines constructor range categories source = Line . (:[]) . constructor . (`Info` categories) <$> actualLineRanges range source
openRange :: Source -> Range -> Maybe Range openRange :: Source Char -> Range -> Maybe Range
openRange source range = case (source `at`) <$> maybeLastIndex range of openRange source range = case (source `at`) <$> maybeLastIndex range of
Just '\n' -> Nothing Just '\n' -> Nothing
_ -> Just range _ -> Just range
openTerm :: Source -> Term a Info -> Maybe (Term a Info) openTerm :: Source Char -> Term a Info -> Maybe (Term a Info)
openTerm source term@(Info range _ :< _) = const term <$> openRange source range openTerm source term@(Info range _ :< _) = const term <$> openRange source range
openDiff :: Source -> SplitDiff a Info -> Maybe (SplitDiff a Info) openDiff :: Source Char -> SplitDiff a Info -> Maybe (SplitDiff a Info)
openDiff source diff@(Free (Annotated (Info range _) _)) = const diff <$> openRange source range openDiff source diff@(Free (Annotated (Info range _) _)) = const diff <$> openRange source range
openDiff source diff@(Pure term) = const diff <$> openTerm source term openDiff source diff@(Pure term) = const diff <$> openTerm source term
zipWithDefaults :: (a -> b -> c) -> a -> b -> [a] -> [b] -> [c] zipWithDefaults :: (a -> b -> c) -> a -> b -> [a] -> [b] -> [c]
zipWithDefaults f da db a b = take (max (length a) (length b)) $ zipWith f (a ++ repeat da) (b ++ repeat db) zipWithDefaults f da db a b = take (max (length a) (length b)) $ zipWith f (a ++ repeat da) (b ++ repeat db)
actualLines :: Source -> [Source] actualLines :: Source Char -> [Source Char]
actualLines "" = [""] actualLines "" = [""]
actualLines lines = case break (== '\n') lines of actualLines lines = case break (== '\n') lines of
(l, lines') -> case lines' of (l, lines') -> case lines' of
@ -170,6 +170,6 @@ actualLines lines = case break (== '\n') lines of
_:lines' -> (l ++ "\n") : actualLines lines' _:lines' -> (l ++ "\n") : actualLines lines'
-- | Compute the line ranges within a given range of a string. -- | Compute the line ranges within a given range of a string.
actualLineRanges :: Range -> Source -> [Range] actualLineRanges :: Range -> Source Char -> [Range]
actualLineRanges range = drop 1 . scanl toRange (Range (start range) (start range)) . actualLines . subsource range actualLineRanges range = drop 1 . scanl toRange (Range (start range) (start range)) . actualLines . subsource range
where toRange previous string = Range (end previous) $ end previous + length string where toRange previous string = Range (end previous) $ end previous + length string