module Unison.Merge.Unconflicts
  ( Unconflicts (..),
    empty,
    apply,
    soloDeletedNames,
    soloUpdatedNames,
    bothUpdatedNames,
  )
where

import Data.Bitraversable (bitraverse)
import Data.Map.Strict qualified as Map
import Unison.Merge.TwoWay (TwoWay)
import Unison.Merge.TwoWayI (TwoWayI (..))
import Unison.Merge.TwoWayI qualified as TwoWayI
import Unison.Name (Name)
import Unison.Prelude hiding (empty)
import Unison.Util.Defns (DefnsF)

data Unconflicts v = Unconflicts
  { forall v. Unconflicts v -> TwoWayI (Map Name v)
adds :: !(TwoWayI (Map Name v)),
    forall v. Unconflicts v -> TwoWayI (Map Name v)
deletes :: !(TwoWayI (Map Name v)),
    forall v. Unconflicts v -> TwoWayI (Map Name v)
updates :: !(TwoWayI (Map Name v))
  }
  deriving stock ((forall m. Monoid m => Unconflicts m -> m)
-> (forall m a. Monoid m => (a -> m) -> Unconflicts a -> m)
-> (forall m a. Monoid m => (a -> m) -> Unconflicts a -> m)
-> (forall a b. (a -> b -> b) -> b -> Unconflicts a -> b)
-> (forall a b. (a -> b -> b) -> b -> Unconflicts a -> b)
-> (forall b a. (b -> a -> b) -> b -> Unconflicts a -> b)
-> (forall b a. (b -> a -> b) -> b -> Unconflicts a -> b)
-> (forall a. (a -> a -> a) -> Unconflicts a -> a)
-> (forall a. (a -> a -> a) -> Unconflicts a -> a)
-> (forall a. Unconflicts a -> [a])
-> (forall a. Unconflicts a -> Bool)
-> (forall a. Unconflicts a -> Int)
-> (forall a. Eq a => a -> Unconflicts a -> Bool)
-> (forall a. Ord a => Unconflicts a -> a)
-> (forall a. Ord a => Unconflicts a -> a)
-> (forall a. Num a => Unconflicts a -> a)
-> (forall a. Num a => Unconflicts a -> a)
-> Foldable Unconflicts
forall a. Eq a => a -> Unconflicts a -> Bool
forall a. Num a => Unconflicts a -> a
forall a. Ord a => Unconflicts a -> a
forall m. Monoid m => Unconflicts m -> m
forall a. Unconflicts a -> Bool
forall a. Unconflicts a -> Int
forall a. Unconflicts a -> [a]
forall a. (a -> a -> a) -> Unconflicts a -> a
forall m a. Monoid m => (a -> m) -> Unconflicts a -> m
forall b a. (b -> a -> b) -> b -> Unconflicts a -> b
forall a b. (a -> b -> b) -> b -> Unconflicts a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Unconflicts m -> m
fold :: forall m. Monoid m => Unconflicts m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Unconflicts a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Unconflicts a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Unconflicts a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Unconflicts a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Unconflicts a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Unconflicts a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Unconflicts a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Unconflicts a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Unconflicts a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Unconflicts a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Unconflicts a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Unconflicts a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Unconflicts a -> a
foldr1 :: forall a. (a -> a -> a) -> Unconflicts a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Unconflicts a -> a
foldl1 :: forall a. (a -> a -> a) -> Unconflicts a -> a
$ctoList :: forall a. Unconflicts a -> [a]
toList :: forall a. Unconflicts a -> [a]
$cnull :: forall a. Unconflicts a -> Bool
null :: forall a. Unconflicts a -> Bool
$clength :: forall a. Unconflicts a -> Int
length :: forall a. Unconflicts a -> Int
$celem :: forall a. Eq a => a -> Unconflicts a -> Bool
elem :: forall a. Eq a => a -> Unconflicts a -> Bool
$cmaximum :: forall a. Ord a => Unconflicts a -> a
maximum :: forall a. Ord a => Unconflicts a -> a
$cminimum :: forall a. Ord a => Unconflicts a -> a
minimum :: forall a. Ord a => Unconflicts a -> a
$csum :: forall a. Num a => Unconflicts a -> a
sum :: forall a. Num a => Unconflicts a -> a
$cproduct :: forall a. Num a => Unconflicts a -> a
product :: forall a. Num a => Unconflicts a -> a
Foldable, (forall a b. (a -> b) -> Unconflicts a -> Unconflicts b)
-> (forall a b. a -> Unconflicts b -> Unconflicts a)
-> Functor Unconflicts
forall a b. a -> Unconflicts b -> Unconflicts a
forall a b. (a -> b) -> Unconflicts a -> Unconflicts 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) -> Unconflicts a -> Unconflicts b
fmap :: forall a b. (a -> b) -> Unconflicts a -> Unconflicts b
$c<$ :: forall a b. a -> Unconflicts b -> Unconflicts a
<$ :: forall a b. a -> Unconflicts b -> Unconflicts a
Functor, (forall x. Unconflicts v -> Rep (Unconflicts v) x)
-> (forall x. Rep (Unconflicts v) x -> Unconflicts v)
-> Generic (Unconflicts v)
forall x. Rep (Unconflicts v) x -> Unconflicts v
forall x. Unconflicts v -> Rep (Unconflicts v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (Unconflicts v) x -> Unconflicts v
forall v x. Unconflicts v -> Rep (Unconflicts v) x
$cfrom :: forall v x. Unconflicts v -> Rep (Unconflicts v) x
from :: forall x. Unconflicts v -> Rep (Unconflicts v) x
$cto :: forall v x. Rep (Unconflicts v) x -> Unconflicts v
to :: forall x. Rep (Unconflicts v) x -> Unconflicts v
Generic)

empty :: Unconflicts v
empty :: forall v. Unconflicts v
empty =
  TwoWayI (Map Name v)
-> TwoWayI (Map Name v) -> TwoWayI (Map Name v) -> Unconflicts v
forall v.
TwoWayI (Map Name v)
-> TwoWayI (Map Name v) -> TwoWayI (Map Name v) -> Unconflicts v
Unconflicts TwoWayI (Map Name v)
forall {k} {a}. TwoWayI (Map k a)
x TwoWayI (Map Name v)
forall {k} {a}. TwoWayI (Map k a)
x TwoWayI (Map Name v)
forall {k} {a}. TwoWayI (Map k a)
x
  where
    x :: TwoWayI (Map k a)
x = Map k a -> Map k a -> Map k a -> TwoWayI (Map k a)
forall a. a -> a -> a -> TwoWayI a
TwoWayI Map k a
forall k a. Map k a
Map.empty Map k a
forall k a. Map k a
Map.empty Map k a
forall k a. Map k a
Map.empty

-- | Apply unconflicts to a namespace.
apply :: forall v. Unconflicts v -> Map Name v -> Map Name v
apply :: forall v. Unconflicts v -> Map Name v -> Map Name v
apply Unconflicts v
unconflicts =
  Map Name v -> Map Name v
applyDeletes (Map Name v -> Map Name v)
-> (Map Name v -> Map Name v) -> Map Name v -> Map Name v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name v -> Map Name v
applyUpdates (Map Name v -> Map Name v)
-> (Map Name v -> Map Name v) -> Map Name v -> Map Name v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name v -> Map Name v
applyAdds
  where
    applyAdds :: Map Name v -> Map Name v
    applyAdds :: Map Name v -> Map Name v
applyAdds =
      Map Name v -> Map Name v -> Map Name v
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (TwoWayI (Map Name v) -> Map Name v
forall m. Monoid m => TwoWayI m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Unconflicts v
unconflicts.adds)

    applyUpdates :: Map Name v -> Map Name v
    applyUpdates :: Map Name v -> Map Name v
applyUpdates =
      Map Name v -> Map Name v -> Map Name v
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (TwoWayI (Map Name v) -> Map Name v
forall m. Monoid m => TwoWayI m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Unconflicts v
unconflicts.updates)

    applyDeletes :: Map Name v -> Map Name v
    applyDeletes :: Map Name v -> Map Name v
applyDeletes =
      (Map Name v -> Set Name -> Map Name v
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` (Map Name v -> Set Name) -> TwoWayI (Map Name v) -> Set Name
forall m a. Monoid m => (a -> m) -> TwoWayI a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Map Name v -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Unconflicts v
unconflicts.deletes)

soloDeletedNames :: DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name)
soloDeletedNames :: forall term typ.
DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name)
soloDeletedNames =
  (Unconflicts term -> TwoWay (Set Name))
-> (Unconflicts typ -> TwoWay (Set Name))
-> Defns (Unconflicts term) (Unconflicts typ)
-> TwoWay (DefnsF Set Name Name)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Unconflicts term -> TwoWay (Set Name)
forall v. Unconflicts v -> TwoWay (Set Name)
f Unconflicts typ -> TwoWay (Set Name)
forall v. Unconflicts v -> TwoWay (Set Name)
f
  where
    f :: Unconflicts v -> TwoWay (Set Name)
    f :: forall v. Unconflicts v -> TwoWay (Set Name)
f =
      (Map Name v -> Set Name)
-> TwoWay (Map Name v) -> TwoWay (Set Name)
forall a b. (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Name v -> Set Name
forall k a. Map k a -> Set k
Map.keysSet (TwoWay (Map Name v) -> TwoWay (Set Name))
-> (Unconflicts v -> TwoWay (Map Name v))
-> Unconflicts v
-> TwoWay (Set Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TwoWayI (Map Name v) -> TwoWay (Map Name v)
forall a. TwoWayI a -> TwoWay a
TwoWayI.forgetBoth (TwoWayI (Map Name v) -> TwoWay (Map Name v))
-> (Unconflicts v -> TwoWayI (Map Name v))
-> Unconflicts v
-> TwoWay (Map Name v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (TwoWayI (Map Name v)) (Unconflicts v) (TwoWayI (Map Name v))
-> Unconflicts v -> TwoWayI (Map Name v)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TwoWayI (Map Name v)) (Unconflicts v) (TwoWayI (Map Name v))
#deletes

soloUpdatedNames :: DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name)
soloUpdatedNames :: forall term typ.
DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name)
soloUpdatedNames =
  (Unconflicts term -> TwoWay (Set Name))
-> (Unconflicts typ -> TwoWay (Set Name))
-> Defns (Unconflicts term) (Unconflicts typ)
-> TwoWay (DefnsF Set Name Name)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Unconflicts term -> TwoWay (Set Name)
forall v. Unconflicts v -> TwoWay (Set Name)
f Unconflicts typ -> TwoWay (Set Name)
forall v. Unconflicts v -> TwoWay (Set Name)
f
  where
    f :: Unconflicts v -> TwoWay (Set Name)
    f :: forall v. Unconflicts v -> TwoWay (Set Name)
f =
      (Map Name v -> Set Name)
-> TwoWay (Map Name v) -> TwoWay (Set Name)
forall a b. (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Name v -> Set Name
forall k a. Map k a -> Set k
Map.keysSet (TwoWay (Map Name v) -> TwoWay (Set Name))
-> (Unconflicts v -> TwoWay (Map Name v))
-> Unconflicts v
-> TwoWay (Set Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TwoWayI (Map Name v) -> TwoWay (Map Name v)
forall a. TwoWayI a -> TwoWay a
TwoWayI.forgetBoth (TwoWayI (Map Name v) -> TwoWay (Map Name v))
-> (Unconflicts v -> TwoWayI (Map Name v))
-> Unconflicts v
-> TwoWay (Map Name v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (TwoWayI (Map Name v)) (Unconflicts v) (TwoWayI (Map Name v))
-> Unconflicts v -> TwoWayI (Map Name v)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TwoWayI (Map Name v)) (Unconflicts v) (TwoWayI (Map Name v))
#updates

bothUpdatedNames :: DefnsF Unconflicts term typ -> DefnsF Set Name Name
bothUpdatedNames :: forall term typ.
DefnsF Unconflicts term typ -> DefnsF Set Name Name
bothUpdatedNames =
  (Unconflicts term -> Set Name)
-> (Unconflicts typ -> Set Name)
-> Defns (Unconflicts term) (Unconflicts typ)
-> DefnsF Set Name Name
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 Unconflicts term -> Set Name
forall v. Unconflicts v -> Set Name
f Unconflicts typ -> Set Name
forall v. Unconflicts v -> Set Name
f
  where
    f :: Unconflicts v -> Set Name
    f :: forall v. Unconflicts v -> Set Name
f Unconflicts v
unconflicts =
      Map Name v -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Unconflicts v
unconflicts.updates.both