-- | Combine two diffs together.
module Unison.Merge.CombineDiffs
  ( CombinedDiffOp (..),
    combineDiffs,
  )
where

import Data.Semialign (alignWith)
import Data.These (These (..))
import Unison.Merge.DiffOp (DiffOp (..))
import Unison.Merge.EitherWay (EitherWay (..))
import Unison.Merge.EitherWayI (EitherWayI (..))
import Unison.Merge.Synhashed (Synhashed (..))
import Unison.Merge.TwoDiffOps (TwoDiffOps (..))
import Unison.Merge.TwoDiffOps qualified as TwoDiffOps
import Unison.Merge.TwoWay (TwoWay (..), twoWay)
import Unison.Merge.TwoWay qualified as TwoWay
import Unison.Merge.Updated (Updated (..))
import Unison.Name (Name)
import Unison.Prelude hiding (catMaybes)
import Unison.Reference (TypeReference)
import Unison.Referent (Referent)
import Unison.Util.Defns (DefnsF2, DefnsF3)

-- | The combined result of two diffs on the same thing.
data CombinedDiffOp a
  = CombinedDiffOp'Add !(EitherWayI a)
  | CombinedDiffOp'Delete !(EitherWayI a) -- old value
  | CombinedDiffOp'Update !(EitherWayI (Updated a))
  | -- An add-add or an update-update conflict. We don't consider update-delete a conflict; the delete gets ignored.
    CombinedDiffOp'Conflict !(TwoWay a)
  deriving stock ((forall a b. (a -> b) -> CombinedDiffOp a -> CombinedDiffOp b)
-> (forall a b. a -> CombinedDiffOp b -> CombinedDiffOp a)
-> Functor CombinedDiffOp
forall a b. a -> CombinedDiffOp b -> CombinedDiffOp a
forall a b. (a -> b) -> CombinedDiffOp a -> CombinedDiffOp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CombinedDiffOp a -> CombinedDiffOp b
fmap :: forall a b. (a -> b) -> CombinedDiffOp a -> CombinedDiffOp b
$c<$ :: forall a b. a -> CombinedDiffOp b -> CombinedDiffOp a
<$ :: forall a b. a -> CombinedDiffOp b -> CombinedDiffOp a
Functor, Int -> CombinedDiffOp a -> ShowS
[CombinedDiffOp a] -> ShowS
CombinedDiffOp a -> String
(Int -> CombinedDiffOp a -> ShowS)
-> (CombinedDiffOp a -> String)
-> ([CombinedDiffOp a] -> ShowS)
-> Show (CombinedDiffOp a)
forall a. Show a => Int -> CombinedDiffOp a -> ShowS
forall a. Show a => [CombinedDiffOp a] -> ShowS
forall a. Show a => CombinedDiffOp a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CombinedDiffOp a -> ShowS
showsPrec :: Int -> CombinedDiffOp a -> ShowS
$cshow :: forall a. Show a => CombinedDiffOp a -> String
show :: CombinedDiffOp a -> String
$cshowList :: forall a. Show a => [CombinedDiffOp a] -> ShowS
showList :: [CombinedDiffOp a] -> ShowS
Show)

-- | Combine LCA->Alice diff and LCA->Bob diff.
combineDiffs ::
  TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) ->
  DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
combineDiffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
combineDiffs =
  (TwoWay (Map Name (DiffOp (Synhashed Referent)))
 -> Map Name (CombinedDiffOp Referent))
-> (TwoWay (Map Name (DiffOp (Synhashed TypeReference)))
    -> Map Name (CombinedDiffOp TypeReference))
-> Defns
     (TwoWay (Map Name (DiffOp (Synhashed Referent))))
     (TwoWay (Map Name (DiffOp (Synhashed TypeReference))))
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TwoWay (Map Name (DiffOp (Synhashed Referent)))
-> Map Name (CombinedDiffOp Referent)
forall {a}.
TwoWay (Map Name (DiffOp (Synhashed a)))
-> Map Name (CombinedDiffOp a)
f TwoWay (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (CombinedDiffOp TypeReference)
forall {a}.
TwoWay (Map Name (DiffOp (Synhashed a)))
-> Map Name (CombinedDiffOp a)
f (Defns
   (TwoWay (Map Name (DiffOp (Synhashed Referent))))
   (TwoWay (Map Name (DiffOp (Synhashed TypeReference))))
 -> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference)
-> (TwoWay
      (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
    -> Defns
         (TwoWay (Map Name (DiffOp (Synhashed Referent))))
         (TwoWay (Map Name (DiffOp (Synhashed TypeReference)))))
-> TwoWay
     (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> Defns
     (TwoWay (Map Name (DiffOp (Synhashed Referent))))
     (TwoWay (Map Name (DiffOp (Synhashed TypeReference))))
forall terms types.
TwoWay (Defns terms types) -> DefnsF TwoWay terms types
TwoWay.sequenceDefns
  where
    f :: TwoWay (Map Name (DiffOp (Synhashed a)))
-> Map Name (CombinedDiffOp a)
f = (Map Name (DiffOp (Synhashed a))
 -> Map Name (DiffOp (Synhashed a)) -> Map Name (CombinedDiffOp a))
-> TwoWay (Map Name (DiffOp (Synhashed a)))
-> Map Name (CombinedDiffOp a)
forall a b. (a -> a -> b) -> TwoWay a -> b
twoWay ((These (DiffOp (Synhashed a)) (DiffOp (Synhashed a))
 -> CombinedDiffOp a)
-> Map Name (DiffOp (Synhashed a))
-> Map Name (DiffOp (Synhashed a))
-> Map Name (CombinedDiffOp a)
forall a b c.
(These a b -> c) -> Map Name a -> Map Name b -> Map Name c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These (DiffOp (Synhashed a)) (DiffOp (Synhashed a))
-> CombinedDiffOp a
forall a.
These (DiffOp (Synhashed a)) (DiffOp (Synhashed a))
-> CombinedDiffOp a
combine)

combine :: These (DiffOp (Synhashed a)) (DiffOp (Synhashed a)) -> CombinedDiffOp a
combine :: forall a.
These (DiffOp (Synhashed a)) (DiffOp (Synhashed a))
-> CombinedDiffOp a
combine =
  These (DiffOp (Synhashed a)) (DiffOp (Synhashed a))
-> TwoDiffOps (Synhashed a)
forall a. These (DiffOp a) (DiffOp a) -> TwoDiffOps a
TwoDiffOps.make (These (DiffOp (Synhashed a)) (DiffOp (Synhashed a))
 -> TwoDiffOps (Synhashed a))
-> (TwoDiffOps (Synhashed a) -> CombinedDiffOp a)
-> These (DiffOp (Synhashed a)) (DiffOp (Synhashed a))
-> CombinedDiffOp a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TwoDiffOps (Synhashed a) -> CombinedDiffOp (Synhashed a)
forall a. Eq a => TwoDiffOps a -> CombinedDiffOp a
combine1 (TwoDiffOps (Synhashed a) -> CombinedDiffOp (Synhashed a))
-> (CombinedDiffOp (Synhashed a) -> CombinedDiffOp a)
-> TwoDiffOps (Synhashed a)
-> CombinedDiffOp a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Synhashed a -> a)
-> CombinedDiffOp (Synhashed a) -> CombinedDiffOp a
forall a b. (a -> b) -> CombinedDiffOp a -> CombinedDiffOp b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting a (Synhashed a) a -> Synhashed a -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting a (Synhashed a) a
#value)

combine1 :: (Eq a) => TwoDiffOps a -> CombinedDiffOp a
combine1 :: forall a. Eq a => TwoDiffOps a -> CombinedDiffOp a
combine1 = \case
  TwoDiffOps'Add EitherWay a
x -> EitherWayI a -> CombinedDiffOp a
forall a. EitherWayI a -> CombinedDiffOp a
CombinedDiffOp'Add (EitherWay a -> EitherWayI a
forall a. EitherWay a -> EitherWayI a
xor2ior EitherWay a
x)
  TwoDiffOps'Delete EitherWay a
x -> EitherWayI a -> CombinedDiffOp a
forall a. EitherWayI a -> CombinedDiffOp a
CombinedDiffOp'Delete (EitherWay a -> EitherWayI a
forall a. EitherWay a -> EitherWayI a
xor2ior EitherWay a
x)
  TwoDiffOps'Update EitherWay (Updated a)
x -> EitherWayI (Updated a) -> CombinedDiffOp a
forall a. EitherWayI (Updated a) -> CombinedDiffOp a
CombinedDiffOp'Update (EitherWay (Updated a) -> EitherWayI (Updated a)
forall a. EitherWay a -> EitherWayI a
xor2ior EitherWay (Updated a)
x)
  TwoDiffOps'AddAdd TwoWay a
x
    | TwoWay a
x.alice a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= TwoWay a
x.bob -> TwoWay a -> CombinedDiffOp a
forall a. TwoWay a -> CombinedDiffOp a
CombinedDiffOp'Conflict TwoWay a
x
    | Bool
otherwise -> EitherWayI a -> CombinedDiffOp a
forall a. EitherWayI a -> CombinedDiffOp a
CombinedDiffOp'Add (a -> EitherWayI a
forall a. a -> EitherWayI a
AliceAndBob TwoWay a
x.alice)
  TwoDiffOps'DeleteDelete a
x -> EitherWayI a -> CombinedDiffOp a
forall a. EitherWayI a -> CombinedDiffOp a
CombinedDiffOp'Delete (a -> EitherWayI a
forall a. a -> EitherWayI a
AliceAndBob a
x)
  -- These two are not a conflicts, perhaps only temporarily, because it's easier to implement. We just ignore these
  -- deletes and keep the updates.
  TwoDiffOps'DeleteUpdate Updated a
x -> EitherWayI (Updated a) -> CombinedDiffOp a
forall a. EitherWayI (Updated a) -> CombinedDiffOp a
CombinedDiffOp'Update (Updated a -> EitherWayI (Updated a)
forall a. a -> EitherWayI a
OnlyBob Updated a
x)
  TwoDiffOps'UpdateDelete Updated a
x -> EitherWayI (Updated a) -> CombinedDiffOp a
forall a. EitherWayI (Updated a) -> CombinedDiffOp a
CombinedDiffOp'Update (Updated a -> EitherWayI (Updated a)
forall a. a -> EitherWayI a
OnlyAlice Updated a
x)
  TwoDiffOps'UpdateUpdate a
old TwoWay a
new
    | TwoWay a
new.alice a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= TwoWay a
new.bob -> TwoWay a -> CombinedDiffOp a
forall a. TwoWay a -> CombinedDiffOp a
CombinedDiffOp'Conflict TwoWay a
new
    | Bool
otherwise -> EitherWayI (Updated a) -> CombinedDiffOp a
forall a. EitherWayI (Updated a) -> CombinedDiffOp a
CombinedDiffOp'Update (Updated a -> EitherWayI (Updated a)
forall a. a -> EitherWayI a
AliceAndBob Updated {a
old :: a
$sel:old:Updated :: a
old, $sel:new:Updated :: a
new = TwoWay a
new.alice})

xor2ior :: EitherWay a -> EitherWayI a
xor2ior :: forall a. EitherWay a -> EitherWayI a
xor2ior = \case
  Alice a
x -> a -> EitherWayI a
forall a. a -> EitherWayI a
OnlyAlice a
x
  Bob a
x -> a -> EitherWayI a
forall a. a -> EitherWayI a
OnlyBob a
x