-- | An API for merging together two collections of library dependencies.
module Unison.Merge.Libdeps
  ( LibdepDiffOp (..),
    diffLibdeps,
    mergeLibdepsDiffs,
    applyLibdepsDiff,
    getTwoFreshLibdepNames,
  )
where

import Data.Map.Merge.Strict qualified as Map
import Data.Map.Strict qualified as Map
import Data.Semialign (alignWith)
import Data.Set qualified as Set
import Data.These (These (..))
import Unison.Merge.DiffOp (DiffOp (..))
import Unison.Merge.EitherWay qualified as EitherWay
import Unison.Merge.ThreeWay (ThreeWay (..))
import Unison.Merge.ThreeWay qualified as ThreeWay
import Unison.Merge.TwoDiffOps (TwoDiffOps (..))
import Unison.Merge.TwoDiffOps qualified as TwoDiffOps
import Unison.Merge.TwoWay (TwoWay (..))
import Unison.Merge.Updated (Updated (..))
import Unison.NameSegment.Internal (NameSegment (NameSegment))
import Unison.NameSegment.Internal qualified as NameSegment
import Unison.Prelude hiding (catMaybes)
import Unison.Util.Map qualified as Map
import Witherable (catMaybes)

------------------------------------------------------------------------------------------------------------------------
-- Diffing libdeps

data LibdepDiffOp a
  = AddLibdep !a
  | AddBothLibdeps !a !a
  | DeleteLibdep

-- | Perform two two-way diffs on two collections of library dependencies. This is only half of a three-way diff: use
-- 'mergeLibdepsDiffs' to complete it.
diffLibdeps ::
  forall k v.
  (Ord k, Eq v) =>
  -- | Library dependencies.
  ThreeWay (Map k v) ->
  -- | Library dependencies diffs.
  TwoWay (Map k (DiffOp v))
diffLibdeps :: forall k v.
(Ord k, Eq v) =>
ThreeWay (Map k v) -> TwoWay (Map k (DiffOp v))
diffLibdeps ThreeWay (Map k v)
libdeps =
  Map k v -> Map k (DiffOp v)
f (Map k v -> Map k (DiffOp v))
-> TwoWay (Map k v) -> TwoWay (Map k (DiffOp v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay (Map k v) -> TwoWay (Map k v)
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca ThreeWay (Map k v)
libdeps
  where
    f :: Map k v -> Map k (DiffOp v)
    f :: Map k v -> Map k (DiffOp v)
f =
      SimpleWhenMissing k v (DiffOp v)
-> SimpleWhenMissing k v (DiffOp v)
-> SimpleWhenMatched k v v (DiffOp v)
-> Map k v
-> Map k v
-> Map k (DiffOp v)
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
        ((k -> v -> DiffOp v) -> SimpleWhenMissing k v (DiffOp v)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing \k
_ -> v -> DiffOp v
forall a. a -> DiffOp a
DiffOp'Delete)
        ((k -> v -> DiffOp v) -> SimpleWhenMissing k v (DiffOp v)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing \k
_ -> v -> DiffOp v
forall a. a -> DiffOp a
DiffOp'Add)
        ( (k -> v -> v -> Maybe (DiffOp v))
-> SimpleWhenMatched k v v (DiffOp v)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched \k
_ v
old v
new ->
            if v
old v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
new
              then Maybe (DiffOp v)
forall a. Maybe a
Nothing
              else DiffOp v -> Maybe (DiffOp v)
forall a. a -> Maybe a
Just (Updated v -> DiffOp v
forall a. Updated a -> DiffOp a
DiffOp'Update Updated {v
old :: v
$sel:old:Updated :: v
old, v
new :: v
$sel:new:Updated :: v
new})
        )
        ThreeWay (Map k v)
libdeps.lca

-- Merge two library dependency diffs together:
--
--   * Keep all adds/updates (allowing conflicts as necessary, which will be resolved later)
--   * Ignore deletes that only one party makes (because the other party may expect the dep to still be there)
mergeLibdepsDiffs ::
  forall k v.
  (Ord k, Eq v) =>
  -- The LCA->Alice and LCA->Bob library dependencies diffs.
  TwoWay (Map k (DiffOp v)) ->
  -- The merged library dependencies diff.
  Map k (LibdepDiffOp v)
mergeLibdepsDiffs :: forall k v.
(Ord k, Eq v) =>
TwoWay (Map k (DiffOp v)) -> Map k (LibdepDiffOp v)
mergeLibdepsDiffs TwoWay (Map k (DiffOp v))
diffs =
  Map k (Maybe (LibdepDiffOp v)) -> Map k (LibdepDiffOp v)
forall a. Map k (Maybe a) -> Map k a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes ((These (DiffOp v) (DiffOp v) -> Maybe (LibdepDiffOp v))
-> Map k (DiffOp v)
-> Map k (DiffOp v)
-> Map k (Maybe (LibdepDiffOp v))
forall a b c. (These a b -> c) -> Map k a -> Map k b -> Map k c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These (DiffOp v) (DiffOp v) -> Maybe (LibdepDiffOp v)
forall a.
Eq a =>
These (DiffOp a) (DiffOp a) -> Maybe (LibdepDiffOp a)
combineDiffOps TwoWay (Map k (DiffOp v))
diffs.alice TwoWay (Map k (DiffOp v))
diffs.bob)

combineDiffOps :: (Eq a) => These (DiffOp a) (DiffOp a) -> Maybe (LibdepDiffOp a)
combineDiffOps :: forall a.
Eq a =>
These (DiffOp a) (DiffOp a) -> Maybe (LibdepDiffOp a)
combineDiffOps =
  These (DiffOp a) (DiffOp a) -> TwoDiffOps a
forall a. These (DiffOp a) (DiffOp a) -> TwoDiffOps a
TwoDiffOps.make (These (DiffOp a) (DiffOp a) -> TwoDiffOps a)
-> (TwoDiffOps a -> Maybe (LibdepDiffOp a))
-> These (DiffOp a) (DiffOp a)
-> Maybe (LibdepDiffOp a)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TwoDiffOps a -> Maybe (LibdepDiffOp a)
forall a. Eq a => TwoDiffOps a -> Maybe (LibdepDiffOp a)
combineDiffOps1

combineDiffOps1 :: (Eq a) => TwoDiffOps a -> Maybe (LibdepDiffOp a)
combineDiffOps1 :: forall a. Eq a => TwoDiffOps a -> Maybe (LibdepDiffOp a)
combineDiffOps1 = \case
  TwoDiffOps'Add EitherWay a
new -> LibdepDiffOp a -> Maybe (LibdepDiffOp a)
forall a. a -> Maybe a
Just (a -> LibdepDiffOp a
forall a. a -> LibdepDiffOp a
AddLibdep (EitherWay a -> a
forall a. EitherWay a -> a
EitherWay.value EitherWay a
new))
  -- If Alice deletes a dep and Bob doesn't touch it, ignore the delete, since Bob may still be using it.
  TwoDiffOps'Delete EitherWay a
_old -> Maybe (LibdepDiffOp a)
forall a. Maybe a
Nothing
  -- If Alice updates a dep and Bob doesn't touch it, keep the old one around too, since Bob may still be using it.
  TwoDiffOps'Update EitherWay (Updated a)
x -> LibdepDiffOp a -> Maybe (LibdepDiffOp a)
forall a. a -> Maybe a
Just (a -> a -> LibdepDiffOp a
forall a. a -> a -> LibdepDiffOp a
AddBothLibdeps (EitherWay (Updated a) -> Updated a
forall a. EitherWay a -> a
EitherWay.value EitherWay (Updated a)
x).old (EitherWay (Updated a) -> Updated a
forall a. EitherWay a -> a
EitherWay.value EitherWay (Updated a)
x).new)
  TwoDiffOps'AddAdd TwoWay {a
alice :: a
$sel:alice:TwoWay :: forall a. TwoWay a -> a
alice, a
bob :: a
$sel:bob:TwoWay :: forall a. TwoWay a -> a
bob}
    | a
alice a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
bob -> LibdepDiffOp a -> Maybe (LibdepDiffOp a)
forall a. a -> Maybe a
Just (a -> LibdepDiffOp a
forall a. a -> LibdepDiffOp a
AddLibdep a
alice)
    | Bool
otherwise -> LibdepDiffOp a -> Maybe (LibdepDiffOp a)
forall a. a -> Maybe a
Just (a -> a -> LibdepDiffOp a
forall a. a -> a -> LibdepDiffOp a
AddBothLibdeps a
alice a
bob)
  -- If Alice and Bob both delete something, delete it.
  TwoDiffOps'DeleteDelete a
_ -> LibdepDiffOp a -> Maybe (LibdepDiffOp a)
forall a. a -> Maybe a
Just LibdepDiffOp a
forall a. LibdepDiffOp a
DeleteLibdep
  -- If Alice updates a dependency and Bob deletes the old one, ignore the delete and keep Alice's, and vice versa.
  TwoDiffOps'DeleteUpdate Updated a
bob -> LibdepDiffOp a -> Maybe (LibdepDiffOp a)
forall a. a -> Maybe a
Just (a -> LibdepDiffOp a
forall a. a -> LibdepDiffOp a
AddLibdep Updated a
bob.new)
  TwoDiffOps'UpdateDelete Updated a
alice -> LibdepDiffOp a -> Maybe (LibdepDiffOp a)
forall a. a -> Maybe a
Just (a -> LibdepDiffOp a
forall a. a -> LibdepDiffOp a
AddLibdep Updated a
alice.new)
  -- combineDiffOps (Deleted _) (Updated _ bob) = AddLibdep bob
  -- combineDiffOps (Updated _ alice) (Deleted _) = AddLibdep alice
  TwoDiffOps'UpdateUpdate a
_old TwoWay {a
$sel:alice:TwoWay :: forall a. TwoWay a -> a
alice :: a
alice, a
$sel:bob:TwoWay :: forall a. TwoWay a -> a
bob :: a
bob}
    | a
alice a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
bob -> LibdepDiffOp a -> Maybe (LibdepDiffOp a)
forall a. a -> Maybe a
Just (a -> LibdepDiffOp a
forall a. a -> LibdepDiffOp a
AddLibdep a
alice)
    | Bool
otherwise -> LibdepDiffOp a -> Maybe (LibdepDiffOp a)
forall a. a -> Maybe a
Just (a -> a -> LibdepDiffOp a
forall a. a -> a -> LibdepDiffOp a
AddBothLibdeps a
alice a
bob)

------------------------------------------------------------------------------------------------------------------------
-- Applying libdeps diff

-- Apply a library dependencies diff to the LCA.
applyLibdepsDiff ::
  forall k v.
  (Ord k) =>
  -- | Freshen a name, e.g. "base" -> ("base__4", "base__5").
  (Set k -> k -> (k, k)) ->
  -- | Library dependencies.
  ThreeWay (Map k v) ->
  -- | Library dependencies diff.
  Map k (LibdepDiffOp v) ->
  -- | Merged library dependencies.
  Map k v
applyLibdepsDiff :: forall k v.
Ord k =>
(Set k -> k -> (k, k))
-> ThreeWay (Map k v) -> Map k (LibdepDiffOp v) -> Map k v
applyLibdepsDiff Set k -> k -> (k, k)
freshen0 ThreeWay (Map k v)
libdeps =
  (k -> v -> Map k v)
-> (k -> LibdepDiffOp v -> Map k v)
-> (k -> v -> LibdepDiffOp v -> Map k v)
-> Map k v
-> Map k (LibdepDiffOp v)
-> Map k v
forall a b k m.
(Monoid m, Ord k) =>
(k -> a -> m)
-> (k -> b -> m) -> (k -> a -> b -> m) -> Map k a -> Map k b -> m
Map.mergeMap k -> v -> Map k v
forall k a. k -> a -> Map k a
Map.singleton k -> LibdepDiffOp v -> Map k v
f (\k
name v
_ -> k -> LibdepDiffOp v -> Map k v
f k
name) ThreeWay (Map k v)
libdeps.lca
  where
    f :: k -> LibdepDiffOp v -> Map k v
    f :: k -> LibdepDiffOp v -> Map k v
f k
k = \case
      AddLibdep v
v -> k -> v -> Map k v
forall k a. k -> a -> Map k a
Map.singleton k
k v
v
      AddBothLibdeps v
v1 v
v2 ->
        let (k
k1, k
k2) = k -> (k, k)
freshen k
k
         in [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(k
k1, v
v1), (k
k2, v
v2)]
      LibdepDiffOp v
DeleteLibdep -> Map k v
forall k a. Map k a
Map.empty

    freshen :: k -> (k, k)
    freshen :: k -> (k, k)
freshen =
      Set k -> k -> (k, k)
freshen0 (Set k -> k -> (k, k)) -> Set k -> k -> (k, k)
forall a b. (a -> b) -> a -> b
$
        [Set k] -> Set k
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
          [ Map k v -> Set k
forall k a. Map k a -> Set k
Map.keysSet ThreeWay (Map k v)
libdeps.lca,
            Map k v -> Set k
forall k a. Map k a -> Set k
Map.keysSet ThreeWay (Map k v)
libdeps.alice,
            Map k v -> Set k
forall k a. Map k a -> Set k
Map.keysSet ThreeWay (Map k v)
libdeps.bob
          ]

------------------------------------------------------------------------------------------------------------------------
-- Getting fresh libdeps names

-- Given a name like "base", try "base__1", then "base__2", etc, until we find a name that doesn't
-- clash with any existing dependencies.
getTwoFreshLibdepNames :: Set NameSegment -> NameSegment -> (NameSegment, NameSegment)
getTwoFreshLibdepNames :: Set NameSegment -> NameSegment -> (NameSegment, NameSegment)
getTwoFreshLibdepNames Set NameSegment
names NameSegment
name0 =
  Integer -> (NameSegment, NameSegment)
go2 Integer
0
  where
    -- if
    --   name0 = "base"
    --   names = {"base__5", "base__6"}
    -- then
    --   go2 4 = ("base__4", "base__7")
    go2 :: Integer -> (NameSegment, NameSegment)
    go2 :: Integer -> (NameSegment, NameSegment)
go2 !Integer
i
      | NameSegment -> Set NameSegment -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member NameSegment
name Set NameSegment
names = Integer -> (NameSegment, NameSegment)
go2 (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
      | Bool
otherwise = (NameSegment
name, Integer -> NameSegment
go1 (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1))
      where
        name :: NameSegment
name = Integer -> NameSegment
mangled Integer
i

    -- if
    --   name0 = "base"
    --   names = {"base__5", "base__6"}
    -- then
    --   go1 5 = "base__7"
    go1 :: Integer -> NameSegment
    go1 :: Integer -> NameSegment
go1 !Integer
i
      | NameSegment -> Set NameSegment -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member NameSegment
name Set NameSegment
names = Integer -> NameSegment
go1 (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
      | Bool
otherwise = NameSegment
name
      where
        name :: NameSegment
name = Integer -> NameSegment
mangled Integer
i

    mangled :: Integer -> NameSegment
    mangled :: Integer -> NameSegment
mangled Integer
i =
      Text -> NameSegment
NameSegment (NameSegment -> Text
NameSegment.toUnescapedText NameSegment
name0 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"__" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tShow Integer
i)