module Unison.Codebase.BranchDiff
  ( BranchDiff (..),
    DiffSlice (..),
    diff0,
    namespaceUpdates,
  )
where

import Data.Map qualified as Map
import Data.Set qualified as Set
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Name (Name)
import Unison.Prelude
import Unison.Reference (Reference)
import Unison.Referent (Referent)
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as R

data DiffType a = Create a | Delete a | Modify a deriving (Int -> DiffType a -> ShowS
[DiffType a] -> ShowS
DiffType a -> String
(Int -> DiffType a -> ShowS)
-> (DiffType a -> String)
-> ([DiffType a] -> ShowS)
-> Show (DiffType a)
forall a. Show a => Int -> DiffType a -> ShowS
forall a. Show a => [DiffType a] -> ShowS
forall a. Show a => DiffType a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> DiffType a -> ShowS
showsPrec :: Int -> DiffType a -> ShowS
$cshow :: forall a. Show a => DiffType a -> String
show :: DiffType a -> String
$cshowList :: forall a. Show a => [DiffType a] -> ShowS
showList :: [DiffType a] -> ShowS
Show)

data DiffSlice r = DiffSlice
  { --  tpatchUpdates :: Relation r r, -- old new
    forall r. DiffSlice r -> Map Name (Set r, Set r)
tallnamespaceUpdates :: Map Name (Set r, Set r),
    forall r. DiffSlice r -> Relation r Name
talladds :: Relation r Name,
    forall r. DiffSlice r -> Relation r Name
tallremoves :: Relation r Name,
    forall r. DiffSlice r -> Map r (Set Name, Set Name)
trenames :: Map r (Set Name, Set Name)
  }
  deriving stock ((forall x. DiffSlice r -> Rep (DiffSlice r) x)
-> (forall x. Rep (DiffSlice r) x -> DiffSlice r)
-> Generic (DiffSlice r)
forall x. Rep (DiffSlice r) x -> DiffSlice r
forall x. DiffSlice r -> Rep (DiffSlice r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall r x. Rep (DiffSlice r) x -> DiffSlice r
forall r x. DiffSlice r -> Rep (DiffSlice r) x
$cfrom :: forall r x. DiffSlice r -> Rep (DiffSlice r) x
from :: forall x. DiffSlice r -> Rep (DiffSlice r) x
$cto :: forall r x. Rep (DiffSlice r) x -> DiffSlice r
to :: forall x. Rep (DiffSlice r) x -> DiffSlice r
Generic, Int -> DiffSlice r -> ShowS
[DiffSlice r] -> ShowS
DiffSlice r -> String
(Int -> DiffSlice r -> ShowS)
-> (DiffSlice r -> String)
-> ([DiffSlice r] -> ShowS)
-> Show (DiffSlice r)
forall r. Show r => Int -> DiffSlice r -> ShowS
forall r. Show r => [DiffSlice r] -> ShowS
forall r. Show r => DiffSlice r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall r. Show r => Int -> DiffSlice r -> ShowS
showsPrec :: Int -> DiffSlice r -> ShowS
$cshow :: forall r. Show r => DiffSlice r -> String
show :: DiffSlice r -> String
$cshowList :: forall r. Show r => [DiffSlice r] -> ShowS
showList :: [DiffSlice r] -> ShowS
Show)

data BranchDiff = BranchDiff
  { BranchDiff -> DiffSlice Referent
termsDiff :: DiffSlice Referent,
    BranchDiff -> DiffSlice Reference
typesDiff :: DiffSlice Reference
  }
  deriving stock ((forall x. BranchDiff -> Rep BranchDiff x)
-> (forall x. Rep BranchDiff x -> BranchDiff) -> Generic BranchDiff
forall x. Rep BranchDiff x -> BranchDiff
forall x. BranchDiff -> Rep BranchDiff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BranchDiff -> Rep BranchDiff x
from :: forall x. BranchDiff -> Rep BranchDiff x
$cto :: forall x. Rep BranchDiff x -> BranchDiff
to :: forall x. Rep BranchDiff x -> BranchDiff
Generic, Int -> BranchDiff -> ShowS
[BranchDiff] -> ShowS
BranchDiff -> String
(Int -> BranchDiff -> ShowS)
-> (BranchDiff -> String)
-> ([BranchDiff] -> ShowS)
-> Show BranchDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BranchDiff -> ShowS
showsPrec :: Int -> BranchDiff -> ShowS
$cshow :: BranchDiff -> String
show :: BranchDiff -> String
$cshowList :: [BranchDiff] -> ShowS
showList :: [BranchDiff] -> ShowS
Show)

diff0 :: Branch0 m -> Branch0 m -> BranchDiff
diff0 :: forall (m :: * -> *). Branch0 m -> Branch0 m -> BranchDiff
diff0 Branch0 m
old Branch0 m
new = DiffSlice Referent -> DiffSlice Reference -> BranchDiff
BranchDiff DiffSlice Referent
terms DiffSlice Reference
types
  where
    (DiffSlice Referent
terms, DiffSlice Reference
types) =
      Relation Referent Name
-> Relation Referent Name
-> Relation Reference Name
-> Relation Reference Name
-> (DiffSlice Referent, DiffSlice Reference)
computeSlices
        (Branch0 m -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
Branch.deepTerms Branch0 m
old)
        (Branch0 m -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
Branch.deepTerms Branch0 m
new)
        (Branch0 m -> Relation Reference Name
forall (m :: * -> *). Branch0 m -> Relation Reference Name
Branch.deepTypes Branch0 m
old)
        (Branch0 m -> Relation Reference Name
forall (m :: * -> *). Branch0 m -> Relation Reference Name
Branch.deepTypes Branch0 m
new)

computeSlices ::
  Relation Referent Name ->
  Relation Referent Name ->
  Relation Reference Name ->
  Relation Reference Name ->
  (DiffSlice Referent, DiffSlice Reference)
computeSlices :: Relation Referent Name
-> Relation Referent Name
-> Relation Reference Name
-> Relation Reference Name
-> (DiffSlice Referent, DiffSlice Reference)
computeSlices Relation Referent Name
oldTerms Relation Referent Name
newTerms Relation Reference Name
oldTypes Relation Reference Name
newTypes = (DiffSlice Referent
termsOut, DiffSlice Reference
typesOut)
  where
    termsOut :: DiffSlice Referent
termsOut =
      let nc :: Map Referent (Set Name, Set Name)
nc = Relation Referent Name
-> Relation Referent Name -> Map Referent (Set Name, Set Name)
forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a b -> Relation a c -> Map a (Set b, Set c)
R.outerJoinDomMultimaps Relation Referent Name
oldTerms Relation Referent Name
newTerms
          nu :: Map Name (Set Referent, Set Referent)
nu = Relation Referent Name
-> Relation Referent Name -> Map Name (Set Referent, Set Referent)
forall r.
Ord r =>
Relation r Name -> Relation r Name -> Map Name (Set r, Set r)
allNamespaceUpdates Relation Referent Name
oldTerms Relation Referent Name
newTerms
       in DiffSlice
            { $sel:tallnamespaceUpdates:DiffSlice :: Map Name (Set Referent, Set Referent)
tallnamespaceUpdates = Map Name (Set Referent, Set Referent)
nu,
              $sel:talladds:DiffSlice :: Relation Referent Name
talladds = Map Referent (Set Name, Set Name)
-> Map Name (Set Referent, Set Referent) -> Relation Referent Name
forall r.
Ord r =>
Map r (Set Name, Set Name)
-> Map Name (Set r, Set r) -> Relation r Name
allAdds Map Referent (Set Name, Set Name)
nc Map Name (Set Referent, Set Referent)
nu,
              $sel:tallremoves:DiffSlice :: Relation Referent Name
tallremoves = Map Referent (Set Name, Set Name)
-> Map Name (Set Referent, Set Referent) -> Relation Referent Name
forall r.
Ord r =>
Map r (Set Name, Set Name)
-> Map Name (Set r, Set r) -> Relation r Name
allRemoves Map Referent (Set Name, Set Name)
nc Map Name (Set Referent, Set Referent)
nu,
              $sel:trenames:DiffSlice :: Map Referent (Set Name, Set Name)
trenames = Map Referent (Set Name, Set Name)
-> Map Referent (Set Name, Set Name)
forall r.
Ord r =>
Map r (Set Name, Set Name) -> Map r (Set Name, Set Name)
remainingNameChanges Map Referent (Set Name, Set Name)
nc
            }
    typesOut :: DiffSlice Reference
typesOut =
      let nc :: Map Reference (Set Name, Set Name)
nc = Relation Reference Name
-> Relation Reference Name -> Map Reference (Set Name, Set Name)
forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a b -> Relation a c -> Map a (Set b, Set c)
R.outerJoinDomMultimaps Relation Reference Name
oldTypes Relation Reference Name
newTypes
          nu :: Map Name (Set Reference, Set Reference)
nu = Relation Reference Name
-> Relation Reference Name
-> Map Name (Set Reference, Set Reference)
forall r.
Ord r =>
Relation r Name -> Relation r Name -> Map Name (Set r, Set r)
allNamespaceUpdates Relation Reference Name
oldTypes Relation Reference Name
newTypes
       in DiffSlice
            { $sel:tallnamespaceUpdates:DiffSlice :: Map Name (Set Reference, Set Reference)
tallnamespaceUpdates = Map Name (Set Reference, Set Reference)
nu,
              $sel:talladds:DiffSlice :: Relation Reference Name
talladds = Map Reference (Set Name, Set Name)
-> Map Name (Set Reference, Set Reference)
-> Relation Reference Name
forall r.
Ord r =>
Map r (Set Name, Set Name)
-> Map Name (Set r, Set r) -> Relation r Name
allAdds Map Reference (Set Name, Set Name)
nc Map Name (Set Reference, Set Reference)
nu,
              $sel:tallremoves:DiffSlice :: Relation Reference Name
tallremoves = Map Reference (Set Name, Set Name)
-> Map Name (Set Reference, Set Reference)
-> Relation Reference Name
forall r.
Ord r =>
Map r (Set Name, Set Name)
-> Map Name (Set r, Set r) -> Relation r Name
allRemoves Map Reference (Set Name, Set Name)
nc Map Name (Set Reference, Set Reference)
nu,
              $sel:trenames:DiffSlice :: Map Reference (Set Name, Set Name)
trenames = Map Reference (Set Name, Set Name)
-> Map Reference (Set Name, Set Name)
forall r.
Ord r =>
Map r (Set Name, Set Name) -> Map r (Set Name, Set Name)
remainingNameChanges Map Reference (Set Name, Set Name)
nc
            }

    allAdds,
      allRemoves ::
        forall r.
        (Ord r) =>
        Map r (Set Name, Set Name) ->
        Map Name (Set r, Set r) ->
        Relation r Name
    allAdds :: forall r.
Ord r =>
Map r (Set Name, Set Name)
-> Map Name (Set r, Set r) -> Relation r Name
allAdds Map r (Set Name, Set Name)
nc Map Name (Set r, Set r)
nu = Map r (Set Name) -> Relation r Name
forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
R.fromMultimap (Map r (Set Name) -> Relation r Name)
-> (Map r (Set Name, Set Name) -> Map r (Set Name))
-> Map r (Set Name, Set Name)
-> Relation r Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set Name, Set Name) -> Set Name)
-> Map r (Set Name, Set Name) -> Map r (Set Name)
forall a b. (a -> b) -> Map r a -> Map r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set Name, Set Name) -> Set Name
forall a b. (a, b) -> b
snd (Map r (Set Name, Set Name) -> Map r (Set Name))
-> (Map r (Set Name, Set Name) -> Map r (Set Name, Set Name))
-> Map r (Set Name, Set Name)
-> Map r (Set Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> (Set Name, Set Name) -> Bool)
-> Map r (Set Name, Set Name) -> Map r (Set Name, Set Name)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey r -> (Set Name, Set Name) -> Bool
f (Map r (Set Name, Set Name) -> Relation r Name)
-> Map r (Set Name, Set Name) -> Relation r Name
forall a b. (a -> b) -> a -> b
$ Map r (Set Name, Set Name)
nc
      where
        f :: r -> (Set Name, Set Name) -> Bool
f r
r (Set Name
oldNames, Set Name
newNames) = Set Name -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Name
oldNames Bool -> Bool -> Bool
&& (Name -> Bool) -> Set Name -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (r -> Name -> Bool
notInUpdates r
r) Set Name
newNames
        -- if an add matches RHS of an update, we exclude it from "Adds"
        notInUpdates :: r -> Name -> Bool
notInUpdates r
r Name
name = case Name -> Map Name (Set r, Set r) -> Maybe (Set r, Set r)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name (Set r, Set r)
nu of
          Maybe (Set r, Set r)
Nothing -> Bool
True
          Just (Set r
_, Set r
rs_new) -> r -> Set r -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember r
r Set r
rs_new

    allRemoves :: forall r.
Ord r =>
Map r (Set Name, Set Name)
-> Map Name (Set r, Set r) -> Relation r Name
allRemoves Map r (Set Name, Set Name)
nc Map Name (Set r, Set r)
nu = Map r (Set Name) -> Relation r Name
forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
R.fromMultimap (Map r (Set Name) -> Relation r Name)
-> (Map r (Set Name, Set Name) -> Map r (Set Name))
-> Map r (Set Name, Set Name)
-> Relation r Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set Name, Set Name) -> Set Name)
-> Map r (Set Name, Set Name) -> Map r (Set Name)
forall a b. (a -> b) -> Map r a -> Map r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set Name, Set Name) -> Set Name
forall a b. (a, b) -> a
fst (Map r (Set Name, Set Name) -> Map r (Set Name))
-> (Map r (Set Name, Set Name) -> Map r (Set Name, Set Name))
-> Map r (Set Name, Set Name)
-> Map r (Set Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> (Set Name, Set Name) -> Bool)
-> Map r (Set Name, Set Name) -> Map r (Set Name, Set Name)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey r -> (Set Name, Set Name) -> Bool
f (Map r (Set Name, Set Name) -> Relation r Name)
-> Map r (Set Name, Set Name) -> Relation r Name
forall a b. (a -> b) -> a -> b
$ Map r (Set Name, Set Name)
nc
      where
        f :: r -> (Set Name, Set Name) -> Bool
f r
r (Set Name
oldNames, Set Name
newNames) = Set Name -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Name
newNames Bool -> Bool -> Bool
&& (Name -> Bool) -> Set Name -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (r -> Name -> Bool
notInUpdates r
r) Set Name
oldNames
        -- if a remove matches LHS of an update, we exclude it from "Removes"
        notInUpdates :: r -> Name -> Bool
notInUpdates r
r Name
name = case Name -> Map Name (Set r, Set r) -> Maybe (Set r, Set r)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name (Set r, Set r)
nu of
          Maybe (Set r, Set r)
Nothing -> Bool
True
          Just (Set r
rs_old, Set r
_) -> r -> Set r -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember r
r Set r
rs_old

    -- renames and stuff, name changes without a reference change
    remainingNameChanges ::
      forall r.
      (Ord r) =>
      Map r (Set Name, Set Name) ->
      Map r (Set Name, Set Name)
    remainingNameChanges :: forall r.
Ord r =>
Map r (Set Name, Set Name) -> Map r (Set Name, Set Name)
remainingNameChanges =
      ((Set Name, Set Name) -> Bool)
-> Map r (Set Name, Set Name) -> Map r (Set Name, Set Name)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\(Set Name
old, Set Name
new) -> Bool -> Bool
not (Set Name -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Name
old) Bool -> Bool -> Bool
&& Bool -> Bool
not (Set Name -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Name
new) Bool -> Bool -> Bool
&& Set Name
old Set Name -> Set Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Set Name
new)

    allNamespaceUpdates :: (Ord r) => Relation r Name -> Relation r Name -> Map Name (Set r, Set r)
    allNamespaceUpdates :: forall r.
Ord r =>
Relation r Name -> Relation r Name -> Map Name (Set r, Set r)
allNamespaceUpdates Relation r Name
old Relation r Name
new =
      ((Set r, Set r) -> Bool)
-> Map Name (Set r, Set r) -> Map Name (Set r, Set r)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Set r, Set r) -> Bool
forall {a}. Eq a => (a, a) -> Bool
f (Map Name (Set r, Set r) -> Map Name (Set r, Set r))
-> Map Name (Set r, Set r) -> Map Name (Set r, Set r)
forall a b. (a -> b) -> a -> b
$ Relation r Name -> Relation r Name -> Map Name (Set r, Set r)
forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a c -> Relation b c -> Map c (Set a, Set b)
R.innerJoinRanMultimaps Relation r Name
old Relation r Name
new
      where
        f :: (a, a) -> Bool
f (a
old, a
new) = a
old a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
new

namespaceUpdates :: (Ord r) => DiffSlice r -> Map Name (Set r, Set r)
namespaceUpdates :: forall r. Ord r => DiffSlice r -> Map Name (Set r, Set r)
namespaceUpdates DiffSlice r
s = ((Set r, Set r) -> Maybe (Set r, Set r))
-> Map Name (Set r, Set r) -> Map Name (Set r, Set r)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (Set r, Set r) -> Maybe (Set r, Set r)
forall {t :: * -> *} {a} {a}.
Foldable t =>
(a, t a) -> Maybe (a, t a)
f (DiffSlice r -> Map Name (Set r, Set r)
forall r. DiffSlice r -> Map Name (Set r, Set r)
tallnamespaceUpdates DiffSlice r
s)
  where
    f :: (a, t a) -> Maybe (a, t a)
f (a
olds, t a
news) =
      if t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
news then Maybe (a, t a)
forall a. Maybe a
Nothing else (a, t a) -> Maybe (a, t a)
forall a. a -> Maybe a
Just (a
olds, t a
news)