diff --git a/src/PatchOutput.hs b/src/PatchOutput.hs index 9edb3f651..c0cd68645 100644 --- a/src/PatchOutput.hs +++ b/src/PatchOutput.hs @@ -69,7 +69,7 @@ showLine source line = Just . toString . (`slice` source) . unionRanges $ getRan -- | Return the range from a split diff. getRange :: SplitDiff leaf Info -> Range getRange (Free (Annotated (Info range _) _)) = range -getRange (Pure (Info range _ :< _)) = range +getRange (Pure (_, Info range _ :< _)) = range -- | Returns the header given two source blobs and a hunk. header :: (SourceBlob, SourceBlob) -> Hunk a -> String diff --git a/src/Split.hs b/src/Split.hs index 136e2c0ae..75c114f02 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -89,7 +89,7 @@ split diff (beforeBlob, afterBlob) = renderHtml valueOf _ = 1 -- | 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) (String, Term leaf annotation) -- | Something that can be rendered as markup. newtype Renderable a = Renderable (Source Char, a) @@ -111,20 +111,20 @@ instance ToMarkup (Renderable (Term a Info)) where instance ToMarkup (Renderable (SplitDiff a Info)) where toMarkup (Renderable (source, diff)) = fst $ iter (\ (Annotated info@(Info range _) syntax) -> (toMarkup $ Renderable (source, (info, syntax)), range)) $ toMarkupAndRange <$> diff - where toMarkupAndRange :: Term a Info -> (Markup, Range) - toMarkupAndRange term@(Info range _ :< _) = ((div ! A.class_ (stringValue "patch")) . toMarkup $ Renderable (source, term), range) + where toMarkupAndRange :: (String, Term a Info) -> (Markup, Range) + toMarkupAndRange (className, term@(Info range _ :< _)) = ((div ! A.class_ (stringValue $ "patch " ++ className)) . toMarkup $ Renderable (source, term), range) -- | Split a diff, which may span multiple lines, into rows of split diffs. splitDiffByLines :: Diff leaf Info -> (Int, Int) -> (Source Char, Source Char) -> ([Row (SplitDiff leaf Info)], (Range, Range)) splitDiffByLines diff (prevLeft, prevRight) sources = case diff of Free (Annotated annotation syntax) -> (splitAnnotatedByLines sources (ranges annotation) (categories annotation) syntax, ranges annotation) Pure (Insert term) -> let (lines, range) = splitTermByLines term (snd sources) in - (Row EmptyLine . fmap Pure <$> lines, (Range prevLeft prevLeft, range)) + (Row EmptyLine . fmap (Pure . (,) "insert") <$> lines, (Range prevLeft prevLeft, range)) Pure (Delete term) -> let (lines, range) = splitTermByLines term (fst sources) in - (flip Row EmptyLine . fmap Pure <$> lines, (range, Range prevRight prevRight)) + (flip Row EmptyLine . fmap (Pure . (,) "delete") <$> lines, (range, Range prevRight prevRight)) Pure (Replace leftTerm rightTerm) -> let (leftLines, leftRange) = splitTermByLines leftTerm (fst sources) (rightLines, rightRange) = splitTermByLines rightTerm (snd sources) in - (zipWithDefaults Row EmptyLine EmptyLine (fmap Pure <$> leftLines) (fmap Pure <$> rightLines), (leftRange, rightRange)) + (zipWithDefaults Row EmptyLine EmptyLine (fmap (Pure . (,) "replace") <$> leftLines) (fmap (Pure . (,) "replace") <$> rightLines), (leftRange, rightRange)) where categories (Info _ left, Info _ right) = (left, right) ranges (Info left _, Info right _) = (left, right) @@ -187,7 +187,7 @@ splitAnnotatedByLines sources ranges categories syntax = case syntax of getRange :: Has f => Either Range (f (SplitDiff leaf Info)) -> Range getRange (Right diff) = case get diff of - (Pure (Info range _ :< _)) -> range + (Pure (_, Info range _ :< _)) -> range (Free (Annotated (Info range _) _)) -> range getRange (Left range) = range @@ -221,7 +221,7 @@ openTerm source term = const term <$> openRange source (case get term of (Info r openDiff :: Has f => Source Char -> MaybeOpen (f (SplitDiff leaf Info)) openDiff source diff = const diff <$> case get diff of (Free (Annotated (Info range _) _)) -> openRange source range - (Pure (Info range _ :< _)) -> openRange source range + (Pure (_, Info range _ :< _)) -> openRange source range -- | Zip two lists by applying a function, using the default values to extend -- | the shorter list.