1{-# LANGUAGE CPP #-}
2{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE QualifiedDo #-}
5{-# LANGUAGE RecordWildCards #-}
6
7-- | This module allows us to diff two 'Text' values.
8module Ormolu.Diff.Text
9  ( TextDiff,
10    diffText,
11    selectSpans,
12    printTextDiff,
13  )
14where
15
16import Control.Monad (unless, when)
17import Data.Algorithm.Diff qualified as D
18import Data.Foldable (for_)
19import Data.IntSet (IntSet)
20import Data.IntSet qualified as IntSet
21import Data.Maybe (listToMaybe)
22import Data.Text (Text)
23import Data.Text qualified as T
24import GHC.Types.SrcLoc
25import Ormolu.Terminal
26import Ormolu.Terminal.QualifiedDo qualified as Term
27#if !MIN_VERSION_base(4,20,0)
28import Data.List (foldl')
29#endif
30
31----------------------------------------------------------------------------
32-- Types
33
34-- | Result of diffing two 'Text's.
35data TextDiff = TextDiff
36  { -- | Path to the file that is being diffed
37    textDiffPath :: FilePath,
38    -- | The list of differences
39    textDiffDiffList :: DiffList,
40    -- | Selected lines. Only hunks that contain selected lines will be
41    -- displayed, unless 'textDiffSelectedLines' is empty, in which case the
42    -- whole diff will be displayed.
43    textDiffSelectedLines :: IntSet
44  }
45  deriving (Eq, Show)
46
47-- | List of lines tagged by 'D.Both', 'D.First', or 'D.Second'.
48type DiffList = [D.Diff [Text]]
49
50-- | Similar to 'DiffList', but with line numbers assigned.
51type DiffList' = [D.Diff [(Int, Int, Text)]]
52
53-- | Diff hunk.
54data Hunk = Hunk
55  { hunkFirstStartLine :: Int,
56    hunkFirstLength :: Int,
57    hunkSecondStartLine :: Int,
58    hunkSecondLength :: Int,
59    hunkDiff :: DiffList
60  }
61  deriving (Show)
62
63----------------------------------------------------------------------------
64-- API
65
66-- | Diff two texts and produce a 'TextDiff'.
67diffText ::
68  -- | Text before
69  Text ->
70  -- | Text after
71  Text ->
72  -- | Path to use
73  FilePath ->
74  -- | The resulting diff or 'Nothing' if the inputs are identical
75  Maybe TextDiff
76diffText a b path =
77  if all isBoth xs
78    then Nothing
79    else
80      Just
81        TextDiff
82          { textDiffPath = path,
83            textDiffDiffList = xs,
84            textDiffSelectedLines = IntSet.empty
85          }
86  where
87    xs = D.getGroupedDiff (lines' a) (lines' b)
88    isBoth = \case
89      D.Both _ _ -> True
90      D.First _ -> False
91      D.Second _ -> False
92    -- T.lines ignores trailing blank lines
93    lines' = T.splitOn "\n"
94
95-- | Select certain spans in the diff (line numbers are interpreted as
96-- belonging to the “before” state). Only selected spans will be printed.
97selectSpans :: [RealSrcSpan] -> TextDiff -> TextDiff
98selectSpans ss textDiff = textDiff {textDiffSelectedLines = xs}
99  where
100    xs = foldl' addOneSpan (textDiffSelectedLines textDiff) ss
101    addOneSpan linesSoFar s =
102      let start = srcSpanStartLine s
103          end = srcSpanEndLine s
104       in IntSet.union
105            linesSoFar
106            (IntSet.fromAscList [start .. end])
107
108-- | Print the given 'TextDiff' as a 'Term' action. This function tries to
109-- mimic the style of @git diff@.
110printTextDiff :: TextDiff -> Term
111printTextDiff TextDiff {..} = Term.do
112  (bold . put . T.pack) textDiffPath
113  newline
114  for_ (toHunks (assignLines textDiffDiffList)) $ \hunk@Hunk {..} ->
115    when (isSelectedLine textDiffSelectedLines hunk) $ Term.do
116      cyan $ Term.do
117        put "@@ -"
118        putShow hunkFirstStartLine
119        put ","
120        putShow hunkFirstLength
121        put " +"
122        putShow hunkSecondStartLine
123        put ","
124        putShow hunkSecondLength
125        put " @@"
126      newline
127      for_ hunkDiff $ \case
128        D.Both ys _ ->
129          for_ ys $ \y -> Term.do
130            unless (T.null y) $
131              put "  "
132            put y
133            newline
134        D.First ys ->
135          for_ ys $ \y -> red $ Term.do
136            put "-"
137            unless (T.null y) $
138              put " "
139            put y
140            newline
141        D.Second ys ->
142          for_ ys $ \y -> green $ Term.do
143            put "+"
144            unless (T.null y) $
145              put " "
146            put y
147            newline
148
149----------------------------------------------------------------------------
150-- Helpers
151
152-- | Assign lines to a 'DiffList'.
153assignLines :: DiffList -> DiffList'
154assignLines = go 1 1 id
155  where
156    go _ _ acc [] = acc []
157    go !firstLine !secondLine acc (x : xs) =
158      case x of
159        D.Both a b ->
160          let firstInc = length a
161              secondInc = length b
162              a' =
163                zip3
164                  (iterate (+ 1) firstLine)
165                  (iterate (+ 1) secondLine)
166                  a
167           in go
168                (firstLine + firstInc)
169                (secondLine + secondInc)
170                (acc . (D.Both a' a' :))
171                xs
172        D.First a ->
173          let firstInc = length a
174              a' =
175                zip3
176                  (iterate (+ 1) firstLine)
177                  (repeat secondLine)
178                  a
179           in go
180                (firstLine + firstInc)
181                secondLine
182                (acc . (D.First a' :))
183                xs
184        D.Second b ->
185          let secondInc = length b
186              b' =
187                zip3
188                  (repeat firstLine)
189                  (iterate (+ 1) secondLine)
190                  b
191           in go
192                firstLine
193                (secondLine + secondInc)
194                (acc . (D.Second b' :))
195                xs
196
197-- | Form 'Hunk's from a 'DiffList''.
198toHunks :: DiffList' -> [Hunk]
199toHunks = go 0 False id id []
200  where
201    -- How many lines of context (that is, lines present in both texts) to
202    -- show per hunk.
203    margin = 3
204    go ::
205      Int ->
206      Bool ->
207      ([Hunk] -> [Hunk]) ->
208      (DiffList' -> DiffList') ->
209      [(Int, Int, Text)] ->
210      DiffList' ->
211      [Hunk]
212    go !n gotChanges hunksAcc currentAcc bothHistory = \case
213      [] ->
214        if gotChanges
215          then
216            let currentAcc' = addBothAfter p currentAcc
217                p = take margin (reverse bothHistory)
218             in case formHunk (currentAcc' []) of
219                  Nothing -> hunksAcc []
220                  Just hunk -> hunksAcc [hunk]
221          else hunksAcc []
222      (x : xs) ->
223        case x of
224          D.Both a _ ->
225            let currentAcc' = addBothAfter p currentAcc
226                p = reverse (drop (n' - margin) bothHistory')
227                hunksAcc' =
228                  case formHunk (currentAcc' []) of
229                    Nothing -> hunksAcc
230                    Just hunk -> hunksAcc . (hunk :)
231                bothHistory' = reverse a ++ bothHistory
232                lena = length a
233                n' = n + lena
234             in if gotChanges && n' > margin * 2
235                  then go 0 False hunksAcc' id bothHistory' xs
236                  else go n' gotChanges hunksAcc currentAcc bothHistory' xs
237          piece ->
238            if gotChanges
239              then
240                let currentAcc' = currentAcc . addBothBefore p (piece :)
241                    p = reverse bothHistory
242                 in go 0 True hunksAcc currentAcc' [] xs
243              else
244                let currentAcc' = addBothBefore p (piece :)
245                    p = reverse (take margin bothHistory)
246                 in go 0 True hunksAcc currentAcc' [] xs
247    addBothBefore [] acc = acc
248    addBothBefore p acc = (D.Both p p :) . acc
249    addBothAfter [] acc = acc
250    addBothAfter p acc = acc . (D.Both p p :)
251
252-- | Form a 'Hunk'.
253formHunk :: DiffList' -> Maybe Hunk
254formHunk xsRaw = do
255  let xs = trimEmpty xsRaw
256  hunkFirstStartLine <- listToMaybe xs >>= firstStartLine
257  let hunkFirstLength = firstLength xs
258  hunkSecondStartLine <- listToMaybe xs >>= secondStartLine
259  let hunkSecondLength = secondLength xs
260      hunkDiff = mapDiff (fmap third) xs
261  return Hunk {..}
262
263-- | Trim empty “both” lines from beginning and end of a 'DiffList''.
264trimEmpty :: DiffList' -> DiffList'
265trimEmpty = go True id
266  where
267    go isFirst acc = \case
268      [] -> acc []
269      [D.Both x _] ->
270        let x' = reverse $ dropWhile (T.null . third) (reverse x)
271         in go False (acc . (D.Both x' x' :)) []
272      (D.Both x _ : xs) ->
273        let x' = dropWhile (T.null . third) x
274         in if isFirst
275              then go False (acc . (D.Both x' x' :)) xs
276              else go False (acc . (D.Both x x :)) xs
277      (x : xs) ->
278        go False (acc . (x :)) xs
279
280firstStartLine :: D.Diff [(Int, Int, a)] -> Maybe Int
281firstStartLine = \case
282  D.Both ((x, _, _) : _) _ -> Just x
283  D.First ((x, _, _) : _) -> Just x
284  D.Second ((x, _, _) : _) -> Just x
285  _ -> Nothing
286
287firstLength :: [D.Diff [(Int, Int, a)]] -> Int
288firstLength = go 0
289  where
290    go n [] = n
291    go !n (x : xs) = case x of
292      D.Both as _ -> go (n + length as) xs
293      D.First as -> go (n + length as) xs
294      D.Second _ -> go n xs
295
296secondStartLine :: D.Diff [(Int, Int, a)] -> Maybe Int
297secondStartLine = \case
298  D.Both ((_, x, _) : _) _ -> Just x
299  D.First ((_, x, _) : _) -> Just x
300  D.Second ((_, x, _) : _) -> Just x
301  _ -> Nothing
302
303secondLength :: [D.Diff [(Int, Int, a)]] -> Int
304secondLength = go 0
305  where
306    go n [] = n
307    go !n (x : xs) = case x of
308      D.Both as _ -> go (n + length as) xs
309      D.First _ -> go n xs
310      D.Second as -> go (n + length as) xs
311
312mapDiff :: (a -> b) -> [D.Diff a] -> [D.Diff b]
313mapDiff f = fmap $ \case
314  D.Both a b -> D.Both (f a) (f b)
315  D.First a -> D.First (f a)
316  D.Second b -> D.Second (f b)
317
318third :: (Int, Int, Text) -> Text
319third (_, _, x) = x
320
321isSelectedLine :: IntSet -> Hunk -> Bool
322isSelectedLine selected Hunk {..} =
323  -- If the set of selected lines is empty, everything is selected.
324  IntSet.null selected
325    || not (IntSet.disjoint selected hunkOriginalLines)
326  where
327    hunkOriginalLines =
328      IntSet.fromAscList (take hunkFirstLength [hunkFirstStartLine ..])