Add classnames into split diffs.

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

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.