module Unison.Codebase.BranchDiff where

import Data.Map qualified as Map
import Data.Set qualified as Set
import U.Codebase.HashTags (PatchHash)
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Patch (Patch, PatchDiff)
import Unison.Codebase.Patch qualified as Patch
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,
    BranchDiff -> Map Name (DiffType PatchDiff)
patchesDiff :: Map Name (DiffType PatchDiff)
  }
  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 :: forall m. (Monad m) => Branch0 m -> Branch0 m -> m BranchDiff
diff0 :: forall (m :: * -> *).
Monad m =>
Branch0 m -> Branch0 m -> m BranchDiff
diff0 Branch0 m
old Branch0 m
new = DiffSlice Referent
-> DiffSlice Reference
-> Map Name (DiffType PatchDiff)
-> BranchDiff
BranchDiff DiffSlice Referent
terms DiffSlice Reference
types (Map Name (DiffType PatchDiff) -> BranchDiff)
-> m (Map Name (DiffType PatchDiff)) -> m BranchDiff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branch0 m -> Branch0 m -> m (Map Name (DiffType PatchDiff))
forall (m :: * -> *).
Monad m =>
Branch0 m -> Branch0 m -> m (Map Name (DiffType PatchDiff))
patchDiff Branch0 m
old Branch0 m
new
  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)

patchDiff :: forall m. (Monad m) => Branch0 m -> Branch0 m -> m (Map Name (DiffType PatchDiff))
patchDiff :: forall (m :: * -> *).
Monad m =>
Branch0 m -> Branch0 m -> m (Map Name (DiffType PatchDiff))
patchDiff Branch0 m
old Branch0 m
new = do
  let oldDeepEdits, newDeepEdits :: Map Name (PatchHash, m Patch)
      oldDeepEdits :: Map Name (PatchHash, m Patch)
oldDeepEdits = Branch0 m -> Map Name (PatchHash, m Patch)
forall (m :: * -> *). Branch0 m -> Map Name (PatchHash, m Patch)
Branch.deepEdits' Branch0 m
old
      newDeepEdits :: Map Name (PatchHash, m Patch)
newDeepEdits = Branch0 m -> Map Name (PatchHash, m Patch)
forall (m :: * -> *). Branch0 m -> Map Name (PatchHash, m Patch)
Branch.deepEdits' Branch0 m
new
  Map Name (DiffType PatchDiff)
added <- do
    Map Name Patch
addedPatches :: Map Name Patch <-
      ((PatchHash, m Patch) -> m Patch)
-> Map Name (PatchHash, m Patch) -> m (Map Name Patch)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Name a -> f (Map Name b)
traverse (PatchHash, m Patch) -> m Patch
forall a b. (a, b) -> b
snd (Map Name (PatchHash, m Patch) -> m (Map Name Patch))
-> Map Name (PatchHash, m Patch) -> m (Map Name Patch)
forall a b. (a -> b) -> a -> b
$ Map Name (PatchHash, m Patch)
-> Map Name (PatchHash, m Patch) -> Map Name (PatchHash, m Patch)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map Name (PatchHash, m Patch)
newDeepEdits Map Name (PatchHash, m Patch)
oldDeepEdits
    pure $ (Patch -> DiffType PatchDiff)
-> Map Name Patch -> Map Name (DiffType PatchDiff)
forall a b. (a -> b) -> Map Name a -> Map Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Patch
p -> PatchDiff -> DiffType PatchDiff
forall a. a -> DiffType a
Create (Patch -> Patch -> PatchDiff
Patch.diff Patch
p Patch
forall a. Monoid a => a
mempty)) Map Name Patch
addedPatches
  Map Name (DiffType PatchDiff)
removed <- do
    Map Name Patch
removedPatches :: Map Name Patch <-
      ((PatchHash, m Patch) -> m Patch)
-> Map Name (PatchHash, m Patch) -> m (Map Name Patch)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Name a -> f (Map Name b)
traverse (PatchHash, m Patch) -> m Patch
forall a b. (a, b) -> b
snd (Map Name (PatchHash, m Patch) -> m (Map Name Patch))
-> Map Name (PatchHash, m Patch) -> m (Map Name Patch)
forall a b. (a -> b) -> a -> b
$ Map Name (PatchHash, m Patch)
-> Map Name (PatchHash, m Patch) -> Map Name (PatchHash, m Patch)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map Name (PatchHash, m Patch)
oldDeepEdits Map Name (PatchHash, m Patch)
newDeepEdits
    pure $ (Patch -> DiffType PatchDiff)
-> Map Name Patch -> Map Name (DiffType PatchDiff)
forall a b. (a -> b) -> Map Name a -> Map Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Patch
p -> PatchDiff -> DiffType PatchDiff
forall a. a -> DiffType a
Delete (Patch -> Patch -> PatchDiff
Patch.diff Patch
forall a. Monoid a => a
mempty Patch
p)) Map Name Patch
removedPatches

  let f :: Map Name (DiffType PatchDiff)
-> Name -> m (Map Name (DiffType PatchDiff))
f Map Name (DiffType PatchDiff)
acc Name
k = case (Name -> Map Name (PatchHash, m Patch) -> Maybe (PatchHash, m Patch)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
k Map Name (PatchHash, m Patch)
oldDeepEdits, Name -> Map Name (PatchHash, m Patch) -> Maybe (PatchHash, m Patch)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
k Map Name (PatchHash, m Patch)
newDeepEdits) of
        (Just (PatchHash
h1, m Patch
p1), Just (PatchHash
h2, m Patch
p2)) ->
          if PatchHash
h1 PatchHash -> PatchHash -> Bool
forall a. Eq a => a -> a -> Bool
== PatchHash
h2
            then Map Name (DiffType PatchDiff) -> m (Map Name (DiffType PatchDiff))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Name (DiffType PatchDiff)
acc
            else Name -> DiffType PatchDiff -> Map Name (DiffType PatchDiff)
forall k a. k -> a -> Map k a
Map.singleton Name
k (DiffType PatchDiff -> Map Name (DiffType PatchDiff))
-> (PatchDiff -> DiffType PatchDiff)
-> PatchDiff
-> Map Name (DiffType PatchDiff)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchDiff -> DiffType PatchDiff
forall a. a -> DiffType a
Modify (PatchDiff -> Map Name (DiffType PatchDiff))
-> m PatchDiff -> m (Map Name (DiffType PatchDiff))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Patch -> Patch -> PatchDiff
Patch.diff (Patch -> Patch -> PatchDiff) -> m Patch -> m (Patch -> PatchDiff)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Patch
p2 m (Patch -> PatchDiff) -> m Patch -> m PatchDiff
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Patch
p1)
        (Maybe (PatchHash, m Patch), Maybe (PatchHash, m Patch))
_ -> String -> m (Map Name (DiffType PatchDiff))
forall a. HasCallStack => String -> a
error String
"we've done something very wrong"
  Map Name (DiffType PatchDiff)
modified <- (Map Name (DiffType PatchDiff)
 -> Name -> m (Map Name (DiffType PatchDiff)))
-> Map Name (DiffType PatchDiff)
-> Set Name
-> m (Map Name (DiffType PatchDiff))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map Name (DiffType PatchDiff)
-> Name -> m (Map Name (DiffType PatchDiff))
f Map Name (DiffType PatchDiff)
forall a. Monoid a => a
mempty (Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (Map Name (PatchHash, m Patch) -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Map Name (PatchHash, m Patch)
oldDeepEdits) (Map Name (PatchHash, m Patch) -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Map Name (PatchHash, m Patch)
newDeepEdits))
  pure $ Map Name (DiffType PatchDiff)
added Map Name (DiffType PatchDiff)
-> Map Name (DiffType PatchDiff) -> Map Name (DiffType PatchDiff)
forall a. Semigroup a => a -> a -> a
<> Map Name (DiffType PatchDiff)
removed Map Name (DiffType PatchDiff)
-> Map Name (DiffType PatchDiff) -> Map Name (DiffType PatchDiff)
forall a. Semigroup a => a -> a -> a
<> Map Name (DiffType PatchDiff)
modified

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)