-- | An API for merging together two collections of library dependencies.
module Unison.Merge.Libdeps
  ( LibdepDiffOp (..),
    diffLibdeps,
    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.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 a three-way diff on two collections of library dependencies.
diffLibdeps ::
  (Ord k, Eq v) =>
  -- | Library dependencies.
  ThreeWay (Map k v) ->
  -- | Library dependencies diff.
  Map k (LibdepDiffOp v)
diffLibdeps :: forall k v.
(Ord k, Eq v) =>
ThreeWay (Map k v) -> Map k (LibdepDiffOp v)
diffLibdeps ThreeWay (Map k v)
libdeps =
  Map k (DiffOp v) -> Map k (DiffOp v) -> Map k (LibdepDiffOp v)
forall k v.
(Ord k, Eq v) =>
Map k (DiffOp v) -> Map k (DiffOp v) -> Map k (LibdepDiffOp v)
mergeDiffs (Map k v -> Map k v -> Map k (DiffOp v)
forall k v. (Ord k, Eq v) => Map k v -> Map k v -> Map k (DiffOp v)
twoWayDiff ThreeWay (Map k v)
libdeps.lca ThreeWay (Map k v)
libdeps.alice) (Map k v -> Map k v -> Map k (DiffOp v)
forall k v. (Ord k, Eq v) => Map k v -> Map k v -> Map k (DiffOp v)
twoWayDiff ThreeWay (Map k v)
libdeps.lca ThreeWay (Map k v)
libdeps.bob)

-- `twoWayDiff old new` computes a diff between old thing `old` and new thing `new`.
--
-- Values present in `old` but not `new` are tagged as "deleted"; similar for "added" and "updated".
twoWayDiff :: (Ord k, Eq v) => Map k v -> Map k v -> Map k (DiffOp v)
twoWayDiff :: forall k v. (Ord k, Eq v) => Map k v -> Map k v -> Map k (DiffOp v)
twoWayDiff =
  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})
    )

-- 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)
mergeDiffs ::
  forall k v.
  (Ord k, Eq v) =>
  -- The LCA->Alice library dependencies diff.
  Map k (DiffOp v) ->
  -- The LCA->Bob library dependencies diff.
  Map k (DiffOp v) ->
  -- The merged library dependencies diff.
  Map k (LibdepDiffOp v)
mergeDiffs :: forall k v.
(Ord k, Eq v) =>
Map k (DiffOp v) -> Map k (DiffOp v) -> Map k (LibdepDiffOp v)
mergeDiffs Map k (DiffOp v)
alice Map k (DiffOp v)
bob =
  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 Map k (DiffOp v)
alice Map k (DiffOp v)
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)