-- | Utilities for displaying diffs between definitions.
module Unison.Server.Backend.DefinitionDiff
  ( diffDisplayObjects,
    linewiseDiff,
    Paired (..),
    Changed (..),
  )
where

import Data.Algorithm.Diff qualified as Diff
import Data.Foldable qualified as Foldable
import Data.Function
import Data.List qualified as List
import Data.List.Extra qualified as List
import Data.List.NonEmpty qualified as NEL
import Data.Text qualified as Text
import Unison.Codebase.Editor.DisplayObject (DisplayObject (..))
import Unison.Prelude
import Unison.Server.Syntax (SyntaxText)
import Unison.Server.Syntax qualified as Syntax
import Unison.Server.Types (Changed (..), DisplayObjectDiff (..), LinewiseDiff (..), Paired (..), SemanticSyntaxDiff (..), swapPair)
import Unison.Util.AnnotatedText (AnnotatedText (..), Segment (..))
import Unison.Util.AnnotatedText qualified as AT
import Unison.Util.List qualified as ListUtil
import Unison.Util.Recursion qualified as Rec

diffDisplayObjects :: (HasCallStack) => DisplayObject SyntaxText SyntaxText -> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff
diffDisplayObjects :: HasCallStack =>
DisplayObject SyntaxText SyntaxText
-> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff
diffDisplayObjects DisplayObject SyntaxText SyntaxText
from DisplayObject SyntaxText SyntaxText
to = case (DisplayObject SyntaxText SyntaxText
from, DisplayObject SyntaxText SyntaxText
to) of
  (BuiltinObject SyntaxText
fromST, BuiltinObject SyntaxText
toST) -> DisplayObject
  (LinewiseDiff (SemanticSyntaxDiff Element))
  (LinewiseDiff (SemanticSyntaxDiff Element))
-> DisplayObjectDiff
DisplayObjectDiff (LinewiseDiff (SemanticSyntaxDiff Element)
-> DisplayObject
     (LinewiseDiff (SemanticSyntaxDiff Element))
     (LinewiseDiff (SemanticSyntaxDiff Element))
forall b a. b -> DisplayObject b a
BuiltinObject (SyntaxText
-> SyntaxText -> LinewiseDiff (SemanticSyntaxDiff Element)
semanticLinewiseDiff SyntaxText
fromST SyntaxText
toST))
  (MissingObject ShortHash
fromSH, MissingObject ShortHash
toSH)
    | ShortHash
fromSH ShortHash -> ShortHash -> Bool
forall a. Eq a => a -> a -> Bool
== ShortHash
toSH -> DisplayObject
  (LinewiseDiff (SemanticSyntaxDiff Element))
  (LinewiseDiff (SemanticSyntaxDiff Element))
-> DisplayObjectDiff
DisplayObjectDiff (ShortHash
-> DisplayObject
     (LinewiseDiff (SemanticSyntaxDiff Element))
     (LinewiseDiff (SemanticSyntaxDiff Element))
forall b a. ShortHash -> DisplayObject b a
MissingObject ShortHash
fromSH)
    | Bool
otherwise -> DisplayObject SyntaxText SyntaxText
-> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff
MismatchedDisplayObjects (ShortHash -> DisplayObject SyntaxText SyntaxText
forall b a. ShortHash -> DisplayObject b a
MissingObject ShortHash
fromSH) (ShortHash -> DisplayObject SyntaxText SyntaxText
forall b a. ShortHash -> DisplayObject b a
MissingObject ShortHash
toSH)
  (UserObject SyntaxText
fromST, UserObject SyntaxText
toST) -> DisplayObject
  (LinewiseDiff (SemanticSyntaxDiff Element))
  (LinewiseDiff (SemanticSyntaxDiff Element))
-> DisplayObjectDiff
DisplayObjectDiff (LinewiseDiff (SemanticSyntaxDiff Element)
-> DisplayObject
     (LinewiseDiff (SemanticSyntaxDiff Element))
     (LinewiseDiff (SemanticSyntaxDiff Element))
forall b a. a -> DisplayObject b a
UserObject (SyntaxText
-> SyntaxText -> LinewiseDiff (SemanticSyntaxDiff Element)
semanticLinewiseDiff SyntaxText
fromST SyntaxText
toST))
  (DisplayObject SyntaxText SyntaxText
l, DisplayObject SyntaxText SyntaxText
r) -> DisplayObject SyntaxText SyntaxText
-> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff
MismatchedDisplayObjects DisplayObject SyntaxText SyntaxText
l DisplayObject SyntaxText SyntaxText
r

-- We special-case situations where the name of a definition changed but its hash didn't;
-- and cases where the name didn't change but the hash did.
--
-- The diff algorithm only understands whether items are equal or not, so in order to add this special behavior we
-- treat these special cases as equal, then we can detect and expand them in a post-processing step.
syntaxElementDiffEq :: AT.Segment Syntax.Element -> AT.Segment Syntax.Element -> Bool
syntaxElementDiffEq :: Segment Element -> Segment Element -> Bool
syntaxElementDiffEq (AT.Segment {segment :: forall a. Segment a -> Text
segment = Text
fromSegment, annotation :: forall a. Segment a -> Maybe a
annotation = Maybe Element
fromAnnotation}) (AT.Segment {segment :: forall a. Segment a -> Text
segment = Text
toSegment, annotation :: forall a. Segment a -> Maybe a
annotation = Maybe Element
toAnnotation}) =
  Text
fromSegment Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
toSegment
    Bool -> Bool -> Bool
|| case (Maybe Element
fromAnnotation, Maybe Element
toAnnotation) of
      (Maybe Element
Nothing, Maybe Element
_) -> Bool
False
      (Maybe Element
_, Maybe Element
Nothing) -> Bool
False
      (Just Element
a, Just Element
b) ->
        case Element
a of
          -- The set of annotations we want to special-case
          Syntax.TypeReference {} -> Element
a Element -> Element -> Bool
forall a. Eq a => a -> a -> Bool
== Element
b
          Syntax.TermReference {} -> Element
a Element -> Element -> Bool
forall a. Eq a => a -> a -> Bool
== Element
b
          Syntax.DataConstructorReference {} -> Element
a Element -> Element -> Bool
forall a. Eq a => a -> a -> Bool
== Element
b
          Syntax.AbilityConstructorReference {} -> Element
a Element -> Element -> Bool
forall a. Eq a => a -> a -> Bool
== Element
b
          Syntax.HashQualifier {} -> Element
a Element -> Element -> Bool
forall a. Eq a => a -> a -> Bool
== Element
b
          Element
_ -> Bool
False

diffSegments ::
  forall f a.
  (Foldable f) =>
  (a -> a -> Bool) ->
  f a ->
  f a ->
  [Diff.PolyDiff [a] [a]]
diffSegments :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> f a -> [PolyDiff [a] [a]]
diffSegments a -> a -> Bool
diffEq f a
left f a
right =
  (a -> a -> Bool) -> [a] -> [a] -> [PolyDiff [a] [a]]
forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff [a] [b]]
Diff.getGroupedDiffBy
    a -> a -> Bool
diffEq
    (f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList f a
left)
    (f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList f a
right)

data DiffOrSame = Different | Same
  deriving (DiffOrSame -> DiffOrSame -> Bool
(DiffOrSame -> DiffOrSame -> Bool)
-> (DiffOrSame -> DiffOrSame -> Bool) -> Eq DiffOrSame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiffOrSame -> DiffOrSame -> Bool
== :: DiffOrSame -> DiffOrSame -> Bool
$c/= :: DiffOrSame -> DiffOrSame -> Bool
/= :: DiffOrSame -> DiffOrSame -> Bool
Eq, Eq DiffOrSame
Eq DiffOrSame =>
(DiffOrSame -> DiffOrSame -> Ordering)
-> (DiffOrSame -> DiffOrSame -> Bool)
-> (DiffOrSame -> DiffOrSame -> Bool)
-> (DiffOrSame -> DiffOrSame -> Bool)
-> (DiffOrSame -> DiffOrSame -> Bool)
-> (DiffOrSame -> DiffOrSame -> DiffOrSame)
-> (DiffOrSame -> DiffOrSame -> DiffOrSame)
-> Ord DiffOrSame
DiffOrSame -> DiffOrSame -> Bool
DiffOrSame -> DiffOrSame -> Ordering
DiffOrSame -> DiffOrSame -> DiffOrSame
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DiffOrSame -> DiffOrSame -> Ordering
compare :: DiffOrSame -> DiffOrSame -> Ordering
$c< :: DiffOrSame -> DiffOrSame -> Bool
< :: DiffOrSame -> DiffOrSame -> Bool
$c<= :: DiffOrSame -> DiffOrSame -> Bool
<= :: DiffOrSame -> DiffOrSame -> Bool
$c> :: DiffOrSame -> DiffOrSame -> Bool
> :: DiffOrSame -> DiffOrSame -> Bool
$c>= :: DiffOrSame -> DiffOrSame -> Bool
>= :: DiffOrSame -> DiffOrSame -> Bool
$cmax :: DiffOrSame -> DiffOrSame -> DiffOrSame
max :: DiffOrSame -> DiffOrSame -> DiffOrSame
$cmin :: DiffOrSame -> DiffOrSame -> DiffOrSame
min :: DiffOrSame -> DiffOrSame -> DiffOrSame
Ord, Int -> DiffOrSame -> ShowS
[DiffOrSame] -> ShowS
DiffOrSame -> String
(Int -> DiffOrSame -> ShowS)
-> (DiffOrSame -> String)
-> ([DiffOrSame] -> ShowS)
-> Show DiffOrSame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiffOrSame -> ShowS
showsPrec :: Int -> DiffOrSame -> ShowS
$cshow :: DiffOrSame -> String
show :: DiffOrSame -> String
$cshowList :: [DiffOrSame] -> ShowS
showList :: [DiffOrSame] -> ShowS
Show)

-- | Compute a line-wise diff between two lists of segments.
--
-- >>> let s a = Segment a Nothing
-- >>> let left = [s "line1", s "\n", s "line2", s "\n", s "line3", s "\n", s "line3"]
-- >>> let right = [s "line1", s "\n", s "lineX", s "\n", s "line3"]
-- >>> linewiseDiff (==) left right
-- LinewiseDiff {lhsLines = [Unchanged [Paired (Segment {segment = "line1", annotation = Nothing}) (Segment {segment = "line1", annotation = Nothing})],Changed [OneSided (Segment {segment = "line2", annotation = Nothing})],Changed [OneSided (Segment {segment = "line3", annotation = Nothing})],Unchanged [Paired (Segment {segment = "line3", annotation = Nothing}) (Segment {segment = "line3", annotation = Nothing})]], rhsLines = [Unchanged [Paired (Segment {segment = "line1", annotation = Nothing}) (Segment {segment = "line1", annotation = Nothing})],Changed [OneSided (Segment {segment = "lineX", annotation = Nothing})],Spacer,Unchanged [Paired (Segment {segment = "line3", annotation = Nothing}) (Segment {segment = "line3", annotation = Nothing})]]}
--
-- >>> let s a = Segment a Nothing
-- >>> let left = [s "line1", s "=\n", s "line2", s ",\n", s "line3", s "\n", s "line3"]
-- >>> let right = [s "line1", s "\n", s "lineX", s ",\n,\n,", s "line3"]
-- >>> linewiseDiff (==) left right
-- LinewiseDiff {lhsLines = [Changed [Paired (Segment {segment = "line1", annotation = Nothing}) (Segment {segment = "line1", annotation = Nothing}),OneSided (Segment {segment = "=", annotation = Nothing})],Changed [OneSided (Segment {segment = "line2", annotation = Nothing}),Paired (Segment {segment = ",", annotation = Nothing}) (Segment {segment = ",", annotation = Nothing})],Changed [OneSided (Segment {segment = "line3", annotation = Nothing})],Changed [Paired (Segment {segment = "line3", annotation = Nothing}) (Segment {segment = "line3", annotation = Nothing})]], rhsLines = [Changed [Paired (Segment {segment = "line1", annotation = Nothing}) (Segment {segment = "line1", annotation = Nothing})],Changed [OneSided (Segment {segment = "lineX", annotation = Nothing}),Paired (Segment {segment = ",", annotation = Nothing}) (Segment {segment = ",", annotation = Nothing})],Changed [OneSided (Segment {segment = ",", annotation = Nothing})],Changed [OneSided (Segment {segment = ",", annotation = Nothing}),Paired (Segment {segment = "line3", annotation = Nothing}) (Segment {segment = "line3", annotation = Nothing})]]}
linewiseDiff ::
  forall f a.
  (Foldable f, Eq a, Show a) =>
  (Segment a -> Segment a -> Bool) ->
  f (Segment a) ->
  f (Segment a) ->
  -- Returns a tuple of lists,
  -- Each list is the same length, when lines are present on both sides they're considered Equal.
  -- When lines are only present on one side, the other side has a Nothing in that position as padding.
  LinewiseDiff (Paired (Segment a))
linewiseDiff :: forall (f :: * -> *) a.
(Foldable f, Eq a, Show a) =>
(Segment a -> Segment a -> Bool)
-> f (Segment a)
-> f (Segment a)
-> LinewiseDiff (Paired (Segment a))
linewiseDiff Segment a -> Segment a -> Bool
diffEq f (Segment a)
left f (Segment a)
right =
  let leftLines :: [[Segment a]]
leftLines = [Segment a] -> [[Segment a]]
splitOnLines ([Segment a] -> [[Segment a]])
-> (f (Segment a) -> [Segment a]) -> f (Segment a) -> [[Segment a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Segment a) -> [Segment a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (f (Segment a) -> [[Segment a]]) -> f (Segment a) -> [[Segment a]]
forall a b. (a -> b) -> a -> b
$ f (Segment a)
left
      rightLines :: [[Segment a]]
rightLines = [Segment a] -> [[Segment a]]
splitOnLines ([Segment a] -> [[Segment a]])
-> (f (Segment a) -> [Segment a]) -> f (Segment a) -> [[Segment a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Segment a) -> [Segment a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (f (Segment a) -> [[Segment a]]) -> f (Segment a) -> [[Segment a]]
forall a b. (a -> b) -> a -> b
$ f (Segment a)
right
      groupedDiff :: [Diff [[Segment a]]]
groupedDiff = [[Segment a]] -> [[Segment a]] -> [Diff [[Segment a]]]
forall a. Eq a => [a] -> [a] -> [Diff [a]]
Diff.getGroupedDiff [[Segment a]]
leftLines [[Segment a]]
rightLines
      partitioned :: [(DiffOrSame,
  [Either
     ([[Segment a]], [[Segment a]])
     (Either [[Segment a]] [[Segment a]])])]
partitioned =
        [Diff [[Segment a]]]
groupedDiff
          [Diff [[Segment a]]]
-> ([Diff [[Segment a]]]
    -> [(DiffOrSame,
         [Either
            ([[Segment a]], [[Segment a]])
            (Either [[Segment a]] [[Segment a]])])])
-> [(DiffOrSame,
     [Either
        ([[Segment a]], [[Segment a]])
        (Either [[Segment a]] [[Segment a]])])]
forall a b. a -> (a -> b) -> b
& (Diff [[Segment a]]
 -> (DiffOrSame,
     Either
       ([[Segment a]], [[Segment a]])
       (Either [[Segment a]] [[Segment a]])))
-> [Diff [[Segment a]]]
-> [(DiffOrSame,
     [Either
        ([[Segment a]], [[Segment a]])
        (Either [[Segment a]] [[Segment a]])])]
forall (f :: * -> *) k a b.
(Foldable f, Eq k) =>
(a -> (k, b)) -> f a -> [(k, [b])]
ListUtil.groupMap
            ( \Diff [[Segment a]]
d ->
                case Diff [[Segment a]]
d of
                  Diff.Both [[Segment a]]
a [[Segment a]]
b -> (DiffOrSame
Same, ([[Segment a]], [[Segment a]])
-> Either
     ([[Segment a]], [[Segment a]]) (Either [[Segment a]] [[Segment a]])
forall a b. a -> Either a b
Left ([[Segment a]]
a, [[Segment a]]
b))
                  Diff.First [[Segment a]]
a -> (DiffOrSame
Different, Either [[Segment a]] [[Segment a]]
-> Either
     ([[Segment a]], [[Segment a]]) (Either [[Segment a]] [[Segment a]])
forall a b. b -> Either a b
Right (Either [[Segment a]] [[Segment a]]
 -> Either
      ([[Segment a]], [[Segment a]])
      (Either [[Segment a]] [[Segment a]]))
-> Either [[Segment a]] [[Segment a]]
-> Either
     ([[Segment a]], [[Segment a]]) (Either [[Segment a]] [[Segment a]])
forall a b. (a -> b) -> a -> b
$ [[Segment a]] -> Either [[Segment a]] [[Segment a]]
forall a b. a -> Either a b
Left [[Segment a]]
a)
                  Diff.Second [[Segment a]]
b -> (DiffOrSame
Different, Either [[Segment a]] [[Segment a]]
-> Either
     ([[Segment a]], [[Segment a]]) (Either [[Segment a]] [[Segment a]])
forall a b. b -> Either a b
Right (Either [[Segment a]] [[Segment a]]
 -> Either
      ([[Segment a]], [[Segment a]])
      (Either [[Segment a]] [[Segment a]]))
-> Either [[Segment a]] [[Segment a]]
-> Either
     ([[Segment a]], [[Segment a]]) (Either [[Segment a]] [[Segment a]])
forall a b. (a -> b) -> a -> b
$ [[Segment a]] -> Either [[Segment a]] [[Segment a]]
forall a b. b -> Either a b
Right [[Segment a]]
b)
            )
   in [(DiffOrSame,
  [Either
     ([[Segment a]], [[Segment a]])
     (Either [[Segment a]] [[Segment a]])])]
partitioned
        [(DiffOrSame,
  [Either
     ([[Segment a]], [[Segment a]])
     (Either [[Segment a]] [[Segment a]])])]
-> ([(DiffOrSame,
      [Either
         ([[Segment a]], [[Segment a]])
         (Either [[Segment a]] [[Segment a]])])]
    -> ([Changed [Paired (Segment a)]],
        [Changed [Paired (Segment a)]]))
-> ([Changed [Paired (Segment a)]], [Changed [Paired (Segment a)]])
forall a b. a -> (a -> b) -> b
& ((DiffOrSame,
  [Either
     ([[Segment a]], [[Segment a]])
     (Either [[Segment a]] [[Segment a]])])
 -> ([Changed [Paired (Segment a)]],
     [Changed [Paired (Segment a)]]))
-> [(DiffOrSame,
     [Either
        ([[Segment a]], [[Segment a]])
        (Either [[Segment a]] [[Segment a]])])]
-> ([Changed [Paired (Segment a)]], [Changed [Paired (Segment a)]])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
          (DiffOrSame
Same, [Either
   ([[Segment a]], [[Segment a]])
   (Either [[Segment a]] [[Segment a]])]
ds) ->
            [Either
   ([[Segment a]], [[Segment a]])
   (Either [[Segment a]] [[Segment a]])]
ds [Either
   ([[Segment a]], [[Segment a]])
   (Either [[Segment a]] [[Segment a]])]
-> ([Either
       ([[Segment a]], [[Segment a]])
       (Either [[Segment a]] [[Segment a]])]
    -> ([Changed [Paired (Segment a)]],
        [Changed [Paired (Segment a)]]))
-> ([Changed [Paired (Segment a)]], [Changed [Paired (Segment a)]])
forall a b. a -> (a -> b) -> b
& (Either
   ([[Segment a]], [[Segment a]]) (Either [[Segment a]] [[Segment a]])
 -> ([Changed [Paired (Segment a)]],
     [Changed [Paired (Segment a)]]))
-> [Either
      ([[Segment a]], [[Segment a]])
      (Either [[Segment a]] [[Segment a]])]
-> ([Changed [Paired (Segment a)]], [Changed [Paired (Segment a)]])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
              Left ([[Segment a]]
a, [[Segment a]]
b) -> do
                let ([[Paired (Segment a)]]
l, [[Paired (Segment a)]]
r) = [[Segment a]]
-> [[Segment a]]
-> ([[Paired (Segment a)]], [[Paired (Segment a)]])
forall x. [[x]] -> [[x]] -> ([[Paired x]], [[Paired x]])
pairLines [[Segment a]]
a [[Segment a]]
b
                 in ([Paired (Segment a)] -> Changed [Paired (Segment a)]
forall a. a -> Changed a
Unchanged ([Paired (Segment a)] -> Changed [Paired (Segment a)])
-> [[Paired (Segment a)]] -> [Changed [Paired (Segment a)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Paired (Segment a)]]
l, [Paired (Segment a)] -> Changed [Paired (Segment a)]
forall a. a -> Changed a
Unchanged ([Paired (Segment a)] -> Changed [Paired (Segment a)])
-> [[Paired (Segment a)]] -> [Changed [Paired (Segment a)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Paired (Segment a)]]
r)
              Right Either [[Segment a]] [[Segment a]]
_ -> String
-> ([Changed [Paired (Segment a)]], [Changed [Paired (Segment a)]])
forall a. HasCallStack => String -> a
error String
"impossible"
          (DiffOrSame
Different, [Either
   ([[Segment a]], [[Segment a]])
   (Either [[Segment a]] [[Segment a]])]
ds) ->
            -- When left and right are different, We do a subdiff on the chunk
            let ([[Segment a]]
lefts :: [[Segment a]], [[Segment a]]
rights :: [[Segment a]]) =
                  [Either
   ([[Segment a]], [[Segment a]])
   (Either [[Segment a]] [[Segment a]])]
ds
                    [Either
   ([[Segment a]], [[Segment a]])
   (Either [[Segment a]] [[Segment a]])]
-> ([Either
       ([[Segment a]], [[Segment a]])
       (Either [[Segment a]] [[Segment a]])]
    -> ([[Segment a]], [[Segment a]]))
-> ([[Segment a]], [[Segment a]])
forall a b. a -> (a -> b) -> b
& (Either
   ([[Segment a]], [[Segment a]]) (Either [[Segment a]] [[Segment a]])
 -> ([[Segment a]], [[Segment a]]))
-> [Either
      ([[Segment a]], [[Segment a]])
      (Either [[Segment a]] [[Segment a]])]
-> ([[Segment a]], [[Segment a]])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
                      Left ([[Segment a]], [[Segment a]])
_ -> String -> ([[Segment a]], [[Segment a]])
forall a. HasCallStack => String -> a
error String
"impossible"
                      Right (Left [[Segment a]]
a) -> ([[Segment a]]
a, [[Segment a]]
forall a. Monoid a => a
mempty)
                      Right (Right [[Segment a]]
b) -> ([[Segment a]]
forall a. Monoid a => a
mempty, [[Segment a]]
b)
             in (Segment a -> Segment a -> Bool)
-> [[Segment a]]
-> [[Segment a]]
-> ([Changed [Paired (Segment a)]], [Changed [Paired (Segment a)]])
forall a.
Eq a =>
(Segment a -> Segment a -> Bool)
-> [[Segment a]]
-> [[Segment a]]
-> ([Changed [Paired (Segment a)]], [Changed [Paired (Segment a)]])
diffChangeChunk Segment a -> Segment a -> Bool
diffEq [[Segment a]]
lefts [[Segment a]]
rights
        ([Changed [Paired (Segment a)]], [Changed [Paired (Segment a)]])
-> (([Changed [Paired (Segment a)]],
     [Changed [Paired (Segment a)]])
    -> LinewiseDiff (Paired (Segment a)))
-> LinewiseDiff (Paired (Segment a))
forall a b. a -> (a -> b) -> b
& \([Changed [Paired (Segment a)]]
lhsLines, [Changed [Paired (Segment a)]]
rhsLines) ->
          LinewiseDiff {[Changed [Paired (Segment a)]]
lhsLines :: [Changed [Paired (Segment a)]]
$sel:lhsLines:LinewiseDiff :: [Changed [Paired (Segment a)]]
lhsLines, [Changed [Paired (Segment a)]]
rhsLines :: [Changed [Paired (Segment a)]]
$sel:rhsLines:LinewiseDiff :: [Changed [Paired (Segment a)]]
rhsLines}
  where
    splitOnLines :: [Segment a] -> [[Segment a]]
    splitOnLines :: [Segment a] -> [[Segment a]]
splitOnLines [Segment a]
xs =
      [Segment a]
xs
        [Segment a]
-> ([Segment a] -> [Maybe (Segment a)]) -> [Maybe (Segment a)]
forall a b. a -> (a -> b) -> b
& (Segment a -> [Maybe (Segment a)])
-> [Segment a] -> [Maybe (Segment a)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
          ( \(Segment {segment :: forall a. Segment a -> Text
segment = Text
s, Maybe a
annotation :: forall a. Segment a -> Maybe a
annotation :: Maybe a
annotation}) ->
              HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"\n" Text
s
                [Text] -> (Text -> Maybe (Segment a)) -> [Maybe (Segment a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Text
seg -> Segment a -> Maybe (Segment a)
forall a. a -> Maybe a
Just (Segment a -> Maybe (Segment a)) -> Segment a -> Maybe (Segment a)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe a -> Segment a
forall a. Text -> Maybe a -> Segment a
Segment Text
seg Maybe a
annotation)
                [Maybe (Segment a)]
-> ([Maybe (Segment a)] -> [Maybe (Segment a)])
-> [Maybe (Segment a)]
forall a b. a -> (a -> b) -> b
& Maybe (Segment a) -> [Maybe (Segment a)] -> [Maybe (Segment a)]
forall a. a -> [a] -> [a]
List.intersperse Maybe (Segment a)
forall a. Maybe a
Nothing
                [Maybe (Segment a)]
-> ([Maybe (Segment a)] -> [Maybe (Segment a)])
-> [Maybe (Segment a)]
forall a b. a -> (a -> b) -> b
& (Maybe (Segment a) -> Bool)
-> [Maybe (Segment a)] -> [Maybe (Segment a)]
forall a. (a -> Bool) -> [a] -> [a]
filter \case
                  Maybe (Segment a)
Nothing -> Bool
True
                  Just (Segment {Text
segment :: forall a. Segment a -> Text
segment :: Text
segment}) -> Bool -> Bool
not (Text -> Bool
Text.null Text
segment)
          )
        [Maybe (Segment a)]
-> ([Maybe (Segment a)] -> [[Maybe (Segment a)]])
-> [[Maybe (Segment a)]]
forall a b. a -> (a -> b) -> b
& [Maybe (Segment a)] -> [Maybe (Segment a)] -> [[Maybe (Segment a)]]
forall a. (HasCallStack, Eq a) => [a] -> [a] -> [[a]]
List.splitOn [Maybe (Segment a)
forall a. Maybe a
Nothing]
        [[Maybe (Segment a)]]
-> ([[Maybe (Segment a)]] -> [[Segment a]]) -> [[Segment a]]
forall a b. a -> (a -> b) -> b
& ([Maybe (Segment a)] -> [Segment a])
-> [[Maybe (Segment a)]] -> [[Segment a]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (Segment a)] -> [Segment a]
forall a. [Maybe a] -> [a]
catMaybes
    pairLines :: forall x. [[x]] -> [[x]] -> ([[Paired x]], [[Paired x]])
    pairLines :: forall x. [[x]] -> [[x]] -> ([[Paired x]], [[Paired x]])
pairLines [[x]]
left [[x]]
right =
      let paired :: [[Paired x]]
paired = ([x] -> [x] -> [Paired x]) -> [[x]] -> [[x]] -> [[Paired x]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((x -> x -> Paired x) -> [x] -> [x] -> [Paired x]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith x -> x -> Paired x
forall a. a -> a -> Paired a
Paired) [[x]]
left [[x]]
right
       in ( [[Paired x]]
paired,
            (Paired x -> Paired x) -> [Paired x] -> [Paired x]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Paired x -> Paired x
forall a. Paired a -> Paired a
swapPair ([Paired x] -> [Paired x]) -> [[Paired x]] -> [[Paired x]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Paired x]]
paired
          )

-- | Compute a semantic line-wise diff between two SyntaxText values, with special-casing
-- to detect tokens whose name stayed the same but whose hash changed, or whose hash stayed the same but whose name changed.
semanticLinewiseDiff :: SyntaxText -> SyntaxText -> LinewiseDiff (SemanticSyntaxDiff Syntax.Element)
semanticLinewiseDiff :: SyntaxText
-> SyntaxText -> LinewiseDiff (SemanticSyntaxDiff Element)
semanticLinewiseDiff (AnnotatedText Seq (Segment Element)
lhs) (AnnotatedText Seq (Segment Element)
rhs) =
  (Segment Element -> Segment Element -> Bool)
-> Seq (Segment Element)
-> Seq (Segment Element)
-> LinewiseDiff (Paired (Segment Element))
forall (f :: * -> *) a.
(Foldable f, Eq a, Show a) =>
(Segment a -> Segment a -> Bool)
-> f (Segment a)
-> f (Segment a)
-> LinewiseDiff (Paired (Segment a))
linewiseDiff Segment Element -> Segment Element -> Bool
syntaxElementDiffEq Seq (Segment Element)
lhs Seq (Segment Element)
rhs
    LinewiseDiff (Paired (Segment Element))
-> (Paired (Segment Element) -> SemanticSyntaxDiff Element)
-> LinewiseDiff (SemanticSyntaxDiff Element)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Paired (Segment Element) -> SemanticSyntaxDiff Element
specialCasePairs
    LinewiseDiff (SemanticSyntaxDiff Element)
-> (LinewiseDiff (SemanticSyntaxDiff Element)
    -> LinewiseDiff (SemanticSyntaxDiff Element))
-> LinewiseDiff (SemanticSyntaxDiff Element)
forall a b. a -> (a -> b) -> b
& \(LinewiseDiff {[Changed [SemanticSyntaxDiff Element]]
$sel:lhsLines:LinewiseDiff :: forall a. LinewiseDiff a -> [Changed [a]]
lhsLines :: [Changed [SemanticSyntaxDiff Element]]
lhsLines, [Changed [SemanticSyntaxDiff Element]]
$sel:rhsLines:LinewiseDiff :: forall a. LinewiseDiff a -> [Changed [a]]
rhsLines :: [Changed [SemanticSyntaxDiff Element]]
rhsLines}) ->
      LinewiseDiff {$sel:lhsLines:LinewiseDiff :: [Changed [SemanticSyntaxDiff Element]]
lhsLines = ((Changed [SemanticSyntaxDiff Element]
 -> Changed [SemanticSyntaxDiff Element])
-> [Changed [SemanticSyntaxDiff Element]]
-> [Changed [SemanticSyntaxDiff Element]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Changed [SemanticSyntaxDiff Element]
  -> Changed [SemanticSyntaxDiff Element])
 -> [Changed [SemanticSyntaxDiff Element]]
 -> [Changed [SemanticSyntaxDiff Element]])
-> (([SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element])
    -> Changed [SemanticSyntaxDiff Element]
    -> Changed [SemanticSyntaxDiff Element])
-> ([SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element])
-> [Changed [SemanticSyntaxDiff Element]]
-> [Changed [SemanticSyntaxDiff Element]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element])
-> Changed [SemanticSyntaxDiff Element]
-> Changed [SemanticSyntaxDiff Element]
forall a b. (a -> b) -> Changed a -> Changed b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) [SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element]
aggregateChunks [Changed [SemanticSyntaxDiff Element]]
lhsLines, $sel:rhsLines:LinewiseDiff :: [Changed [SemanticSyntaxDiff Element]]
rhsLines = ((Changed [SemanticSyntaxDiff Element]
 -> Changed [SemanticSyntaxDiff Element])
-> [Changed [SemanticSyntaxDiff Element]]
-> [Changed [SemanticSyntaxDiff Element]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Changed [SemanticSyntaxDiff Element]
  -> Changed [SemanticSyntaxDiff Element])
 -> [Changed [SemanticSyntaxDiff Element]]
 -> [Changed [SemanticSyntaxDiff Element]])
-> (([SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element])
    -> Changed [SemanticSyntaxDiff Element]
    -> Changed [SemanticSyntaxDiff Element])
-> ([SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element])
-> [Changed [SemanticSyntaxDiff Element]]
-> [Changed [SemanticSyntaxDiff Element]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element])
-> Changed [SemanticSyntaxDiff Element]
-> Changed [SemanticSyntaxDiff Element]
forall a b. (a -> b) -> Changed a -> Changed b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) [SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element]
aggregateChunks [Changed [SemanticSyntaxDiff Element]]
rhsLines}
  where
    specialCasePairs :: Paired (Segment Syntax.Element) -> SemanticSyntaxDiff Syntax.Element
    specialCasePairs :: Paired (Segment Element) -> SemanticSyntaxDiff Element
specialCasePairs = \case
      OneSided Segment Element
a -> NonEmpty (Segment Element) -> SemanticSyntaxDiff Element
forall a. NonEmpty (Segment a) -> SemanticSyntaxDiff a
OnlyThisSide (Segment Element -> NonEmpty (Segment Element)
forall a. a -> NonEmpty a
NEL.singleton Segment Element
a)
      Paired Segment Element
fromSegment Segment Element
toSegment
        | Segment Element
fromSegment Segment Element -> Segment Element -> Bool
forall a. Eq a => a -> a -> Bool
== Segment Element
toSegment -> NonEmpty (Segment Element) -> SemanticSyntaxDiff Element
forall a. NonEmpty (Segment a) -> SemanticSyntaxDiff a
Both (Segment Element -> NonEmpty (Segment Element)
forall a. a -> NonEmpty a
NEL.singleton Segment Element
fromSegment)
        | Segment Element -> Maybe Element
forall a. Segment a -> Maybe a
AT.annotation Segment Element
fromSegment Maybe Element -> Maybe Element -> Bool
forall a. Eq a => a -> a -> Bool
== Segment Element -> Maybe Element
forall a. Segment a -> Maybe a
AT.annotation Segment Element
toSegment -> (Text, Text) -> Maybe Element -> SemanticSyntaxDiff Element
forall a. (Text, Text) -> Maybe a -> SemanticSyntaxDiff a
SegmentChange (Segment Element -> Text
forall a. Segment a -> Text
AT.segment Segment Element
fromSegment, Segment Element -> Text
forall a. Segment a -> Text
AT.segment Segment Element
toSegment) (Segment Element -> Maybe Element
forall a. Segment a -> Maybe a
AT.annotation Segment Element
fromSegment)
        -- We only emit an annotation change if it's a change in just the hash of the element (optionally the KIND of hash reference can change too).
        | Segment Element -> Text
forall a. Segment a -> Text
AT.segment Segment Element
fromSegment Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Segment Element -> Text
forall a. Segment a -> Text
AT.segment Segment Element
toSegment,
          Just Text
_fromHash <- Segment Element -> Maybe Element
forall a. Segment a -> Maybe a
AT.annotation Segment Element
fromSegment Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe Text
elementHash,
          Just Text
_toHash <- Segment Element -> Maybe Element
forall a. Segment a -> Maybe a
AT.annotation Segment Element
toSegment Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe Text
elementHash ->
            Text
-> (Maybe Element, Maybe Element) -> SemanticSyntaxDiff Element
forall a. Text -> (Maybe a, Maybe a) -> SemanticSyntaxDiff a
AnnotationChange (Segment Element -> Text
forall a. Segment a -> Text
AT.segment Segment Element
fromSegment) (Segment Element -> Maybe Element
forall a. Segment a -> Maybe a
AT.annotation Segment Element
fromSegment, Segment Element -> Maybe Element
forall a. Segment a -> Maybe a
AT.annotation Segment Element
toSegment)
        | Bool
otherwise ->
            -- the annotation changed, but it's not a recognized hash change.
            -- This can happen in certain special cases, e.g. a paren changed from being a syntax element into being part
            -- of a unit.
            -- We just emit both as old/new segments.
            NonEmpty (Segment Element) -> SemanticSyntaxDiff Element
forall a. NonEmpty (Segment a) -> SemanticSyntaxDiff a
OnlyThisSide (Segment Element -> NonEmpty (Segment Element)
forall a. a -> NonEmpty a
NEL.singleton Segment Element
fromSegment)
        where
          elementHash :: Syntax.Element -> Maybe Syntax.UnisonHash
          elementHash :: Element -> Maybe Text
elementHash = \case
            Syntax.TypeReference Text
hash -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
hash
            Syntax.TermReference Text
hash -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
hash
            Syntax.DataConstructorReference Text
hash -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
hash
            Syntax.AbilityConstructorReference Text
hash -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
hash
            Element
_ -> Maybe Text
forall a. Maybe a
Nothing

    -- Collapse subsequent chunks of the same kind of diff into one chunk.
    aggregateChunks :: [SemanticSyntaxDiff Syntax.Element] -> [SemanticSyntaxDiff Syntax.Element]
    aggregateChunks :: [SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element]
aggregateChunks =
      Algebra
  (XNor (SemanticSyntaxDiff Element)) [SemanticSyntaxDiff Element]
-> [SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element]
forall a.
Algebra (XNor (SemanticSyntaxDiff Element)) a
-> [SemanticSyntaxDiff Element] -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
Rec.cata \case
        XNor (SemanticSyntaxDiff Element) [SemanticSyntaxDiff Element]
Rec.Neither -> []
        Rec.Both SemanticSyntaxDiff Element
x [] -> [SemanticSyntaxDiff Element
x]
        Rec.Both (OnlyThisSide NonEmpty (Segment Element)
xs) (OnlyThisSide NonEmpty (Segment Element)
ys : [SemanticSyntaxDiff Element]
rest) ->
          NonEmpty (Segment Element) -> SemanticSyntaxDiff Element
forall a. NonEmpty (Segment a) -> SemanticSyntaxDiff a
OnlyThisSide (NonEmpty (Segment Element)
xs NonEmpty (Segment Element)
-> NonEmpty (Segment Element) -> NonEmpty (Segment Element)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Segment Element)
ys) SemanticSyntaxDiff Element
-> [SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element]
forall a. a -> [a] -> [a]
: [SemanticSyntaxDiff Element]
rest
        Rec.Both (Both NonEmpty (Segment Element)
xs) (Both NonEmpty (Segment Element)
ys : [SemanticSyntaxDiff Element]
rest) ->
          NonEmpty (Segment Element) -> SemanticSyntaxDiff Element
forall a. NonEmpty (Segment a) -> SemanticSyntaxDiff a
Both (NonEmpty (Segment Element)
xs NonEmpty (Segment Element)
-> NonEmpty (Segment Element) -> NonEmpty (Segment Element)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Segment Element)
ys) SemanticSyntaxDiff Element
-> [SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element]
forall a. a -> [a] -> [a]
: [SemanticSyntaxDiff Element]
rest
        Rec.Both SemanticSyntaxDiff Element
x [SemanticSyntaxDiff Element]
xs -> SemanticSyntaxDiff Element
x SemanticSyntaxDiff Element
-> [SemanticSyntaxDiff Element] -> [SemanticSyntaxDiff Element]
forall a. a -> [a] -> [a]
: [SemanticSyntaxDiff Element]
xs

-- | Takes the left and right sides of a diff which are part of the same contiguous chunk, then
-- diffs them and returns padded left/right line diffs
diffChangeChunk ::
  forall a.
  (Eq a) =>
  (Segment a -> Segment a -> Bool) ->
  [[Segment a]] ->
  [[Segment a]] ->
  -- Lists of lines, where each line is a list of segments.
  -- 'Nothing' lines are just padding
  ([Changed [Paired (Segment a)]], [Changed [Paired (Segment a)]])
diffChangeChunk :: forall a.
Eq a =>
(Segment a -> Segment a -> Bool)
-> [[Segment a]]
-> [[Segment a]]
-> ([Changed [Paired (Segment a)]], [Changed [Paired (Segment a)]])
diffChangeChunk Segment a -> Segment a -> Bool
diffEq [[Segment a]]
leftLines [[Segment a]]
rightLines =
  -- Represent newlines with 'Nothing' so we can do a flat diff.
  let flattenedL :: [Maybe (Segment a)]
      flattenedL :: [Maybe (Segment a)]
flattenedL = [Maybe (Segment a)] -> [[Maybe (Segment a)]] -> [Maybe (Segment a)]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Maybe (Segment a)
forall a. Maybe a
Nothing] ((Segment a -> Maybe (Segment a))
-> [Segment a] -> [Maybe (Segment a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Segment a -> Maybe (Segment a)
forall a. a -> Maybe a
Just ([Segment a] -> [Maybe (Segment a)])
-> [[Segment a]] -> [[Maybe (Segment a)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Segment a]]
leftLines)
      flattenedR :: [Maybe (Segment a)]
      flattenedR :: [Maybe (Segment a)]
flattenedR = [Maybe (Segment a)] -> [[Maybe (Segment a)]] -> [Maybe (Segment a)]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Maybe (Segment a)
forall a. Maybe a
Nothing] ((Segment a -> Maybe (Segment a))
-> [Segment a] -> [Maybe (Segment a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Segment a -> Maybe (Segment a)
forall a. a -> Maybe a
Just ([Segment a] -> [Maybe (Segment a)])
-> [[Segment a]] -> [[Maybe (Segment a)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Segment a]]
rightLines)
      diff :: [Diff.PolyDiff [Maybe (Segment a)] [Maybe (Segment a)]]
      diff :: [PolyDiff [Maybe (Segment a)] [Maybe (Segment a)]]
diff = (Maybe (Segment a) -> Maybe (Segment a) -> Bool)
-> [Maybe (Segment a)]
-> [Maybe (Segment a)]
-> [PolyDiff [Maybe (Segment a)] [Maybe (Segment a)]]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> f a -> [PolyDiff [a] [a]]
diffSegments Maybe (Segment a) -> Maybe (Segment a) -> Bool
mayDiffEq [Maybe (Segment a)]
flattenedL [Maybe (Segment a)]
flattenedR
      ([Maybe (Paired (Segment a))]
leftResults :: [Maybe (Paired (Segment a))], [Maybe (Paired (Segment a))]
rightResults) =
        [PolyDiff [Maybe (Segment a)] [Maybe (Segment a)]]
diff
          [PolyDiff [Maybe (Segment a)] [Maybe (Segment a)]]
-> ([PolyDiff [Maybe (Segment a)] [Maybe (Segment a)]]
    -> ([Maybe (Paired (Segment a))], [Maybe (Paired (Segment a))]))
-> ([Maybe (Paired (Segment a))], [Maybe (Paired (Segment a))])
forall a b. a -> (a -> b) -> b
& (PolyDiff [Maybe (Segment a)] [Maybe (Segment a)]
 -> ([Maybe (Paired (Segment a))], [Maybe (Paired (Segment a))]))
-> [PolyDiff [Maybe (Segment a)] [Maybe (Segment a)]]
-> ([Maybe (Paired (Segment a))], [Maybe (Paired (Segment a))])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
            Diff.First [Maybe (Segment a)]
ys ->
              ((Segment a -> Paired (Segment a))
-> Maybe (Segment a) -> Maybe (Paired (Segment a))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Segment a -> Paired (Segment a)
forall a. a -> Paired a
OneSided (Maybe (Segment a) -> Maybe (Paired (Segment a)))
-> [Maybe (Segment a)] -> [Maybe (Paired (Segment a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe (Segment a)]
ys, [Maybe (Paired (Segment a))]
forall a. Monoid a => a
mempty)
            Diff.Second [Maybe (Segment a)]
ys ->
              ([Maybe (Paired (Segment a))]
forall a. Monoid a => a
mempty, (Segment a -> Paired (Segment a))
-> Maybe (Segment a) -> Maybe (Paired (Segment a))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Segment a -> Paired (Segment a)
forall a. a -> Paired a
OneSided (Maybe (Segment a) -> Maybe (Paired (Segment a)))
-> [Maybe (Segment a)] -> [Maybe (Paired (Segment a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe (Segment a)]
ys)
            Diff.Both [Maybe (Segment a)]
from [Maybe (Segment a)]
to ->
              let zipper :: Maybe a -> Maybe a -> Maybe (Paired a)
zipper = \cases
                    Maybe a
Nothing Maybe a
Nothing -> Maybe (Paired a)
forall a. Maybe a
Nothing
                    (Just a
l) (Just a
r) -> Paired a -> Maybe (Paired a)
forall a. a -> Maybe a
Just (a -> a -> Paired a
forall a. a -> a -> Paired a
Paired a
l a
r)
                    Maybe a
_ Maybe a
_ -> String -> Maybe (Paired a)
forall a. HasCallStack => String -> a
error String
"impossible"
               in ((Maybe (Segment a)
 -> Maybe (Segment a) -> Maybe (Paired (Segment a)))
-> [Maybe (Segment a)]
-> [Maybe (Segment a)]
-> [Maybe (Paired (Segment a))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Maybe (Segment a)
-> Maybe (Segment a) -> Maybe (Paired (Segment a))
forall {a}. Maybe a -> Maybe a -> Maybe (Paired a)
zipper [Maybe (Segment a)]
from [Maybe (Segment a)]
to, (Maybe (Segment a)
 -> Maybe (Segment a) -> Maybe (Paired (Segment a)))
-> [Maybe (Segment a)]
-> [Maybe (Segment a)]
-> [Maybe (Paired (Segment a))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Maybe (Segment a)
-> Maybe (Segment a) -> Maybe (Paired (Segment a))
forall {a}. Maybe a -> Maybe a -> Maybe (Paired a)
zipper [Maybe (Segment a)]
to [Maybe (Segment a)]
from)

      -- Now only padding newlines are represented by Nothing.
      padding :: [Changed a]
padding = Changed a -> [Changed a]
forall a. a -> [a]
repeat Changed a
forall a. Changed a
Spacer
      relinedLeft :: [[Paired (Segment a)]]
relinedLeft = [Maybe (Paired (Segment a))] -> [Paired (Segment a)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Paired (Segment a))] -> [Paired (Segment a)])
-> [[Maybe (Paired (Segment a))]] -> [[Paired (Segment a)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe (Paired (Segment a))]
-> [Maybe (Paired (Segment a))] -> [[Maybe (Paired (Segment a))]]
forall a. (HasCallStack, Eq a) => [a] -> [a] -> [[a]]
List.splitOn [Maybe (Paired (Segment a))
forall a. Maybe a
Nothing] [Maybe (Paired (Segment a))]
leftResults
      relinedRight :: [[Paired (Segment a)]]
relinedRight = [Maybe (Paired (Segment a))] -> [Paired (Segment a)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Paired (Segment a))] -> [Paired (Segment a)])
-> [[Maybe (Paired (Segment a))]] -> [[Paired (Segment a)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe (Paired (Segment a))]
-> [Maybe (Paired (Segment a))] -> [[Maybe (Paired (Segment a))]]
forall a. (HasCallStack, Eq a) => [a] -> [a] -> [[a]]
List.splitOn [Maybe (Paired (Segment a))
forall a. Maybe a
Nothing] [Maybe (Paired (Segment a))]
rightResults
      leftLength :: Int
leftLength = [[Paired (Segment a)]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Paired (Segment a)]]
relinedLeft
      rightLength :: Int
rightLength = [[Paired (Segment a)]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Paired (Segment a)]]
relinedRight
      maxLines :: Int
maxLines = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
leftLength Int
rightLength
   in ( ([Paired (Segment a)] -> Changed [Paired (Segment a)]
forall a. a -> Changed a
Changed ([Paired (Segment a)] -> Changed [Paired (Segment a)])
-> [[Paired (Segment a)]] -> [Changed [Paired (Segment a)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Paired (Segment a)]]
relinedLeft) [Changed [Paired (Segment a)]]
-> [Changed [Paired (Segment a)]] -> [Changed [Paired (Segment a)]]
forall a. Semigroup a => a -> a -> a
<> Int
-> [Changed [Paired (Segment a)]] -> [Changed [Paired (Segment a)]]
forall a. Int -> [a] -> [a]
take (Int
maxLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftLength) [Changed [Paired (Segment a)]]
forall {a}. [Changed a]
padding,
        ([Paired (Segment a)] -> Changed [Paired (Segment a)]
forall a. a -> Changed a
Changed ([Paired (Segment a)] -> Changed [Paired (Segment a)])
-> [[Paired (Segment a)]] -> [Changed [Paired (Segment a)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Paired (Segment a)]]
relinedRight) [Changed [Paired (Segment a)]]
-> [Changed [Paired (Segment a)]] -> [Changed [Paired (Segment a)]]
forall a. Semigroup a => a -> a -> a
<> Int
-> [Changed [Paired (Segment a)]] -> [Changed [Paired (Segment a)]]
forall a. Int -> [a] -> [a]
take (Int
maxLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rightLength) [Changed [Paired (Segment a)]]
forall {a}. [Changed a]
padding
      )
  where
    mayDiffEq :: Maybe (Segment a) -> Maybe (Segment a) -> Bool
    mayDiffEq :: Maybe (Segment a) -> Maybe (Segment a) -> Bool
mayDiffEq = \cases
      Maybe (Segment a)
Nothing Maybe (Segment a)
Nothing -> Bool
True
      (Just Segment a
l) (Just Segment a
r) -> Segment a -> Segment a -> Bool
diffEq Segment a
l Segment a
r
      Maybe (Segment a)
_ Maybe (Segment a)
_ -> Bool
False