module Unison.Merge.Unconflicts
  ( Unconflicts (..),
    empty,
    apply,
    soloUpdatesAndDeletes,
  )
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)

soloUpdatesAndDeletes :: DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name)
soloUpdatesAndDeletes :: forall term typ.
DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name)
soloUpdatesAndDeletes DefnsF Unconflicts term typ
unconflicts =
  TwoWay (DefnsF Set Name Name)
unconflictedSoloDeletedNames TwoWay (DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name Name) -> TwoWay (DefnsF Set Name Name)
forall a. Semigroup a => a -> a -> a
<> TwoWay (DefnsF Set Name Name)
unconflictedSoloUpdatedNames
  where
    unconflictedSoloDeletedNames :: TwoWay (DefnsF Set Name Name)
    unconflictedSoloDeletedNames :: TwoWay (DefnsF Set Name Name)
unconflictedSoloDeletedNames =
      (Unconflicts term -> TwoWay (Set Name))
-> (Unconflicts typ -> TwoWay (Set Name))
-> DefnsF Unconflicts term 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)
soloDeletedNames Unconflicts typ -> TwoWay (Set Name)
forall v. Unconflicts v -> TwoWay (Set Name)
soloDeletedNames DefnsF Unconflicts term typ
unconflicts

    unconflictedSoloUpdatedNames :: TwoWay (DefnsF Set Name Name)
    unconflictedSoloUpdatedNames :: TwoWay (DefnsF Set Name Name)
unconflictedSoloUpdatedNames =
      (Unconflicts term -> TwoWay (Set Name))
-> (Unconflicts typ -> TwoWay (Set Name))
-> DefnsF Unconflicts term 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)
soloUpdatedNames Unconflicts typ -> TwoWay (Set Name)
forall v. Unconflicts v -> TwoWay (Set Name)
soloUpdatedNames DefnsF Unconflicts term typ
unconflicts

soloDeletedNames :: Unconflicts v -> TwoWay (Set Name)
soloDeletedNames :: forall v. Unconflicts v -> TwoWay (Set Name)
soloDeletedNames =
  (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 :: Unconflicts v -> TwoWay (Set Name)
soloUpdatedNames :: forall v. Unconflicts v -> TwoWay (Set Name)
soloUpdatedNames =
  (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