module Unison.Merge.Diff
  ( diffSynhashedDefns,
  )
where

import Data.Map.Merge.Strict qualified as Map
import Data.Map.Strict qualified as Map
import Data.Zip qualified as Zip
import U.Codebase.Reference (TypeReference)
import Unison.Merge.DiffOp (DiffOp (..), DiffOp2 (..))
import Unison.Merge.Synhashed (Synhashed (..))
import Unison.Merge.Synhashed qualified as Synhashed
import Unison.Merge.TwoWay (TwoWay (..))
import Unison.Merge.Updated (GUpdated (..), Updated)
import Unison.Merge.Updated qualified as Updated
import Unison.Name (Name)
import Unison.Prelude hiding (catMaybes)
import Unison.Referent (Referent)
import Unison.Util.Defns (DefnsF, DefnsF2, DefnsF3, unzipDefns, zipDefnsWith)

-- | @diffSynhashedDefns defns@, given the output of @synhashDefns@, computes the two two-way diffs (each consisting of
-- the "core" diffs, i.e. adds/delete/updates, alongside the propagated updates, i.e. updates that have the same synhash
-- but different Unison hashes).
diffSynhashedDefns ::
  TwoWay (Updated (DefnsF2 (Map Name) Synhashed Referent TypeReference)) ->
  ( -- Core diffs, i.e. adds, deletes, and updates which have different synhashes.
    TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
    -- Propagated updates, i.e. updates which have the same synhash but different Unison hashes.
    TwoWay (DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
  )
diffSynhashedDefns :: TwoWay
  (Updated (DefnsF2 (Map Name) Synhashed Referent TypeReference))
-> (TwoWay
      (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
    TwoWay
      (DefnsF (Map Name) (Updated Referent) (Updated TypeReference)))
diffSynhashedDefns =
  TwoWay
  (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
   DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
-> (TwoWay
      (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
    TwoWay
      (DefnsF (Map Name) (Updated Referent) (Updated TypeReference)))
forall a b. TwoWay (a, b) -> (TwoWay a, TwoWay b)
forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
Zip.unzip (TwoWay
   (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
    DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
 -> (TwoWay
       (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
     TwoWay
       (DefnsF (Map Name) (Updated Referent) (Updated TypeReference))))
-> (TwoWay
      (Updated (DefnsF2 (Map Name) Synhashed Referent TypeReference))
    -> TwoWay
         (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
          DefnsF (Map Name) (Updated Referent) (Updated TypeReference)))
-> TwoWay
     (Updated (DefnsF2 (Map Name) Synhashed Referent TypeReference))
-> (TwoWay
      (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
    TwoWay
      (DefnsF (Map Name) (Updated Referent) (Updated TypeReference)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Updated (DefnsF2 (Map Name) Synhashed Referent TypeReference)
 -> (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
     DefnsF (Map Name) (Updated Referent) (Updated TypeReference)))
-> TwoWay
     (Updated (DefnsF2 (Map Name) Synhashed Referent TypeReference))
-> TwoWay
     (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
      DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
forall a b. (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Updated (DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
    DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
forall term typ.
(Eq term, Eq typ) =>
Updated (DefnsF2 (Map Name) Synhashed term typ)
-> (DefnsF3 (Map Name) DiffOp Synhashed term typ,
    DefnsF (Map Name) (Updated term) (Updated typ))
diffSynhashedDefns0

diffSynhashedDefns0 ::
  (Eq term, Eq typ) =>
  Updated (DefnsF2 (Map Name) Synhashed term typ) ->
  ( -- Core diffs, i.e. adds, deletes, and updates which have different synhashes.
    DefnsF3 (Map Name) DiffOp Synhashed term typ,
    -- Propagated updates, i.e. updates which have the same synhash but different Unison hashes.
    DefnsF (Map Name) (Updated term) (Updated typ)
  )
diffSynhashedDefns0 :: forall term typ.
(Eq term, Eq typ) =>
Updated (DefnsF2 (Map Name) Synhashed term typ)
-> (DefnsF3 (Map Name) DiffOp Synhashed term typ,
    DefnsF (Map Name) (Updated term) (Updated typ))
diffSynhashedDefns0 Updated (DefnsF2 (Map Name) Synhashed term typ)
defns =
  Defns
  (Map Name (DiffOp (Synhashed term)), Map Name (Updated term))
  (Map Name (DiffOp (Synhashed typ)), Map Name (Updated typ))
-> (Defns
      (Map Name (DiffOp (Synhashed term)))
      (Map Name (DiffOp (Synhashed typ))),
    Defns (Map Name (Updated term)) (Map Name (Updated typ)))
forall tm1 tm2 ty1 ty2.
Defns (tm1, tm2) (ty1, ty2) -> (Defns tm1 ty1, Defns tm2 ty2)
unzipDefns ((Map Name (Synhashed term)
 -> Map Name (Synhashed term)
 -> (Map Name (DiffOp (Synhashed term)), Map Name (Updated term)))
-> (Map Name (Synhashed typ)
    -> Map Name (Synhashed typ)
    -> (Map Name (DiffOp (Synhashed typ)), Map Name (Updated typ)))
-> DefnsF2 (Map Name) Synhashed term typ
-> DefnsF2 (Map Name) Synhashed term typ
-> Defns
     (Map Name (DiffOp (Synhashed term)), Map Name (Updated term))
     (Map Name (DiffOp (Synhashed typ)), Map Name (Updated typ))
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith Map Name (Synhashed term)
-> Map Name (Synhashed term)
-> (Map Name (DiffOp (Synhashed term)), Map Name (Updated term))
forall ref.
Eq ref =>
Map Name (Synhashed ref)
-> Map Name (Synhashed ref)
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
f Map Name (Synhashed typ)
-> Map Name (Synhashed typ)
-> (Map Name (DiffOp (Synhashed typ)), Map Name (Updated typ))
forall ref.
Eq ref =>
Map Name (Synhashed ref)
-> Map Name (Synhashed ref)
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
f Updated (DefnsF2 (Map Name) Synhashed term typ)
defns.old Updated (DefnsF2 (Map Name) Synhashed term typ)
defns.new)
  where
    f ::
      (Eq ref) =>
      Map Name (Synhashed ref) ->
      Map Name (Synhashed ref) ->
      (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
    f :: forall ref.
Eq ref =>
Map Name (Synhashed ref)
-> Map Name (Synhashed ref)
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
f Map Name (Synhashed ref)
old Map Name (Synhashed ref)
new =
      Map Name (DiffOp2 (Synhashed ref))
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
forall ref.
Map Name (DiffOp2 (Synhashed ref))
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
partitionPropagated (Map Name (Synhashed ref)
-> Map Name (Synhashed ref) -> Map Name (DiffOp2 (Synhashed ref))
forall ref.
Eq ref =>
Map Name (Synhashed ref)
-> Map Name (Synhashed ref) -> Map Name (DiffOp2 (Synhashed ref))
diffSynhashedDefns1 Map Name (Synhashed ref)
old Map Name (Synhashed ref)
new)

-- Compute the diff by comparing old-and-new values, resulting in either an add, delete, update (propagated or not),
-- or dropping the thing entirely (because old and new have the same hash).
diffSynhashedDefns1 ::
  forall ref.
  (Eq ref) =>
  Map Name (Synhashed ref) ->
  Map Name (Synhashed ref) ->
  Map Name (DiffOp2 (Synhashed ref))
diffSynhashedDefns1 :: forall ref.
Eq ref =>
Map Name (Synhashed ref)
-> Map Name (Synhashed ref) -> Map Name (DiffOp2 (Synhashed ref))
diffSynhashedDefns1 =
  SimpleWhenMissing Name (Synhashed ref) (DiffOp2 (Synhashed ref))
-> SimpleWhenMissing Name (Synhashed ref) (DiffOp2 (Synhashed ref))
-> SimpleWhenMatched
     Name (Synhashed ref) (Synhashed ref) (DiffOp2 (Synhashed ref))
-> Map Name (Synhashed ref)
-> Map Name (Synhashed ref)
-> Map Name (DiffOp2 (Synhashed ref))
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
    ((Name -> Synhashed ref -> DiffOp2 (Synhashed ref))
-> SimpleWhenMissing Name (Synhashed ref) (DiffOp2 (Synhashed ref))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing \Name
_ -> Synhashed ref -> DiffOp2 (Synhashed ref)
forall a. a -> DiffOp2 a
DiffOp2'Delete)
    ((Name -> Synhashed ref -> DiffOp2 (Synhashed ref))
-> SimpleWhenMissing Name (Synhashed ref) (DiffOp2 (Synhashed ref))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing \Name
_ -> Synhashed ref -> DiffOp2 (Synhashed ref)
forall a. a -> DiffOp2 a
DiffOp2'Add)
    ((Name
 -> Synhashed ref
 -> Synhashed ref
 -> Maybe (DiffOp2 (Synhashed ref)))
-> SimpleWhenMatched
     Name (Synhashed ref) (Synhashed ref) (DiffOp2 (Synhashed ref))
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched \Name
_ -> Synhashed ref -> Synhashed ref -> Maybe (DiffOp2 (Synhashed ref))
f)
  where
    f :: Synhashed ref -> Synhashed ref -> Maybe (DiffOp2 (Synhashed ref))
    f :: Synhashed ref -> Synhashed ref -> Maybe (DiffOp2 (Synhashed ref))
f Synhashed ref
old Synhashed ref
new = do
      let equalSynhashes :: Bool
equalSynhashes = Synhashed ref
old Synhashed ref -> Synhashed ref -> Bool
forall a. Eq a => a -> a -> Bool
== Synhashed ref
new
      -- Drop things that haven't changed
      Bool -> Maybe () -> Maybe ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
equalSynhashes do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Synhashed ref -> ref
forall a. Synhashed a -> a
Synhashed.value Synhashed ref
old ref -> ref -> Bool
forall a. Eq a => a -> a -> Bool
/= Synhashed ref -> ref
forall a. Synhashed a -> a
Synhashed.value Synhashed ref
new)
      DiffOp2 (Synhashed ref) -> Maybe (DiffOp2 (Synhashed ref))
forall a. a -> Maybe a
Just (Updated (Synhashed ref) -> Bool -> DiffOp2 (Synhashed ref)
forall a. Updated a -> Bool -> DiffOp2 a
DiffOp2'Update Updated {Synhashed ref
old :: Synhashed ref
$sel:old:Updated :: Synhashed ref
old, Synhashed ref
new :: Synhashed ref
$sel:new:Updated :: Synhashed ref
new} Bool
equalSynhashes)

-- Partition add/delete/update/propagated-update into add/delete/update + propagated-update
partitionPropagated :: Map Name (DiffOp2 (Synhashed ref)) -> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
partitionPropagated :: forall ref.
Map Name (DiffOp2 (Synhashed ref))
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
partitionPropagated =
  (DiffOp2 (Synhashed ref)
 -> Either (DiffOp (Synhashed ref)) (Updated ref))
-> Map Name (DiffOp2 (Synhashed ref))
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
Map.mapEither \case
    DiffOp2'Add Synhashed ref
ref -> DiffOp (Synhashed ref)
-> Either (DiffOp (Synhashed ref)) (Updated ref)
forall a b. a -> Either a b
Left (Synhashed ref -> DiffOp (Synhashed ref)
forall a. a -> DiffOp a
DiffOp'Add Synhashed ref
ref)
    DiffOp2'Delete Synhashed ref
ref -> DiffOp (Synhashed ref)
-> Either (DiffOp (Synhashed ref)) (Updated ref)
forall a b. a -> Either a b
Left (Synhashed ref -> DiffOp (Synhashed ref)
forall a. a -> DiffOp a
DiffOp'Delete Synhashed ref
ref)
    DiffOp2'Update Updated (Synhashed ref)
refs Bool
propagated
      | Bool
propagated -> Updated ref -> Either (DiffOp (Synhashed ref)) (Updated ref)
forall a b. b -> Either a b
Right ((Synhashed ref -> ref) -> Updated (Synhashed ref) -> Updated ref
forall a b. (a -> b) -> Updated a -> Updated b
Updated.map Synhashed ref -> ref
forall a. Synhashed a -> a
Synhashed.value Updated (Synhashed ref)
refs)
      | Bool
otherwise -> DiffOp (Synhashed ref)
-> Either (DiffOp (Synhashed ref)) (Updated ref)
forall a b. a -> Either a b
Left (Updated (Synhashed ref) -> DiffOp (Synhashed ref)
forall a. Updated a -> DiffOp a
DiffOp'Update Updated (Synhashed ref)
refs)