blob: f170817762970842fd11c335dec4ccf081cd6cfd (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
{-# LANGUAGE DerivingStrategies #-}
module Patch
( Patch (..),
parse,
)
where
import Control.Exception (throw)
import Data.Binary (Binary (..))
import Data.Text qualified as T
import Exception qualified as E
import GHC.Generics (Generic)
import Prettyprinter (pretty)
import Render ((<<<))
import Render qualified as P
import Text.Diff.Extra ()
import Text.Diff.Parse qualified as D
import Text.Diff.Parse.Types qualified as D
newtype Patch = Patch
{ fileDeltas :: D.FileDeltas
}
deriving (Show, Generic)
deriving newtype (Binary)
parse :: T.Text -> Patch
parse = either (throw . E.InvalidDiff) Patch . D.parseDiff
instance P.Render Patch where
render = P.render . P.Detailed
instance P.Render (P.Detailed Patch) where
render (P.Detailed (Patch {..})) =
P.vsep (map prettyFileDelta fileDeltas) <<< ("\n" :: T.Text)
where
prettyFileDelta (D.FileDelta {..}) =
("diff --git " <> fileDeltaSourceFile <> " " <> fileDeltaDestFile <> "\n")
<<< (prettySourceFile fileDeltaSourceFile <<< ("\n" :: T.Text))
<<< (prettyDestFile fileDeltaDestFile <<< ("\n" :: T.Text))
<<< prettyContent fileDeltaContent
prettySourceFile file = P.styled [P.bold] $ ("---" :: T.Text) <<< file
prettyDestFile file = P.styled [P.bold] $ ("+++" :: T.Text) <<< file
prettyContent D.Binary = P.emptyDoc
prettyContent (D.Hunks hunks) = P.vsep (map prettyHunk hunks)
prettyHunk (D.Hunk {..}) =
P.styled [P.color P.Blue] $
(prettySourceRange hunkSourceRange hunkDestRange <<< ("\n" :: T.Text))
<<< P.vsep (map prettyLine hunkLines)
prettySourceRange srcRange dstRange =
("" :: T.Text) <<< ("@@ -" <> prettyRange srcRange <> " +" <> prettyRange dstRange <> " @@")
prettyRange (D.Range line lineNo) =
T.pack (show line) <> "," <> T.pack (show lineNo)
prettyLine (D.Line {..}) =
case lineAnnotation of
D.Added -> P.styled [P.color P.Green] $ P.plus @P.AnsiStyle <> pretty lineContent
D.Removed -> P.styled [P.color P.Red] $ P.minus @P.AnsiStyle <> pretty lineContent
D.Context -> P.styled [P.color P.White] $ P.space @P.AnsiStyle <> pretty lineContent
D.Comment -> P.styled [P.color P.White] $ P.hash @P.AnsiStyle <> pretty lineContent
|
