module U.Codebase.Branch.Diff
  ( TreeDiff (..),
    hoistTreeDiff,
    NameChanges (..),
    DefinitionDiffs (..),
    Diff (..),
    NameBasedDiff (..),
    diffBranches,
    allNameChanges,
    nameBasedDiff,
    streamNameChanges,
  )
where

import Control.Comonad.Cofree
import Control.Comonad.Cofree qualified as Cofree
import Control.Lens (ifoldMap)
import Control.Lens qualified as Lens
import Data.Functor.Compose (Compose (..))
import Data.Map qualified as Map
import Data.Semialign qualified as Align
import Data.Set qualified as Set
import Data.These
import U.Codebase.Branch
import U.Codebase.Branch qualified as V2Branch
import U.Codebase.Branch.Type qualified as Branch
import U.Codebase.Causal qualified as Causal
import U.Codebase.Reference (Reference)
import U.Codebase.Referent (Referent)
import U.Codebase.Referent qualified as Referent
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.Prelude
import Unison.Sqlite qualified as Sqlite
import Unison.Util.Monoid (foldMapM, ifoldMapM)
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as Relation

data Diff a = Diff
  { forall a. Diff a -> Set a
adds :: Set a,
    forall a. Diff a -> Set a
removals :: Set a
  }
  deriving (Int -> Diff a -> ShowS
[Diff a] -> ShowS
Diff a -> String
(Int -> Diff a -> ShowS)
-> (Diff a -> String) -> ([Diff a] -> ShowS) -> Show (Diff a)
forall a. Show a => Int -> Diff a -> ShowS
forall a. Show a => [Diff a] -> ShowS
forall a. Show a => Diff a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Diff a -> ShowS
showsPrec :: Int -> Diff a -> ShowS
$cshow :: forall a. Show a => Diff a -> String
show :: Diff a -> String
$cshowList :: forall a. Show a => [Diff a] -> ShowS
showList :: [Diff a] -> ShowS
Show, Diff a -> Diff a -> Bool
(Diff a -> Diff a -> Bool)
-> (Diff a -> Diff a -> Bool) -> Eq (Diff a)
forall a. Eq a => Diff a -> Diff a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Diff a -> Diff a -> Bool
== :: Diff a -> Diff a -> Bool
$c/= :: forall a. Eq a => Diff a -> Diff a -> Bool
/= :: Diff a -> Diff a -> Bool
Eq, Eq (Diff a)
Eq (Diff a) =>
(Diff a -> Diff a -> Ordering)
-> (Diff a -> Diff a -> Bool)
-> (Diff a -> Diff a -> Bool)
-> (Diff a -> Diff a -> Bool)
-> (Diff a -> Diff a -> Bool)
-> (Diff a -> Diff a -> Diff a)
-> (Diff a -> Diff a -> Diff a)
-> Ord (Diff a)
Diff a -> Diff a -> Bool
Diff a -> Diff a -> Ordering
Diff a -> Diff a -> Diff a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Diff a)
forall a. Ord a => Diff a -> Diff a -> Bool
forall a. Ord a => Diff a -> Diff a -> Ordering
forall a. Ord a => Diff a -> Diff a -> Diff a
$ccompare :: forall a. Ord a => Diff a -> Diff a -> Ordering
compare :: Diff a -> Diff a -> Ordering
$c< :: forall a. Ord a => Diff a -> Diff a -> Bool
< :: Diff a -> Diff a -> Bool
$c<= :: forall a. Ord a => Diff a -> Diff a -> Bool
<= :: Diff a -> Diff a -> Bool
$c> :: forall a. Ord a => Diff a -> Diff a -> Bool
> :: Diff a -> Diff a -> Bool
$c>= :: forall a. Ord a => Diff a -> Diff a -> Bool
>= :: Diff a -> Diff a -> Bool
$cmax :: forall a. Ord a => Diff a -> Diff a -> Diff a
max :: Diff a -> Diff a -> Diff a
$cmin :: forall a. Ord a => Diff a -> Diff a -> Diff a
min :: Diff a -> Diff a -> Diff a
Ord)

-- | Represents the changes to definitions at a given path, not including child paths.
--
-- Note: doesn't yet include any info on patch diffs. Feel free to add it.
data DefinitionDiffs = DefinitionDiffs
  { DefinitionDiffs -> Map NameSegment (Diff Referent)
termDiffs :: Map NameSegment (Diff Referent),
    DefinitionDiffs -> Map NameSegment (Diff Reference)
typeDiffs :: Map NameSegment (Diff Reference)
    -- patchDiffs :: Map NameSegment (Diff ())
  }
  deriving stock (Int -> DefinitionDiffs -> ShowS
[DefinitionDiffs] -> ShowS
DefinitionDiffs -> String
(Int -> DefinitionDiffs -> ShowS)
-> (DefinitionDiffs -> String)
-> ([DefinitionDiffs] -> ShowS)
-> Show DefinitionDiffs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefinitionDiffs -> ShowS
showsPrec :: Int -> DefinitionDiffs -> ShowS
$cshow :: DefinitionDiffs -> String
show :: DefinitionDiffs -> String
$cshowList :: [DefinitionDiffs] -> ShowS
showList :: [DefinitionDiffs] -> ShowS
Show, DefinitionDiffs -> DefinitionDiffs -> Bool
(DefinitionDiffs -> DefinitionDiffs -> Bool)
-> (DefinitionDiffs -> DefinitionDiffs -> Bool)
-> Eq DefinitionDiffs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefinitionDiffs -> DefinitionDiffs -> Bool
== :: DefinitionDiffs -> DefinitionDiffs -> Bool
$c/= :: DefinitionDiffs -> DefinitionDiffs -> Bool
/= :: DefinitionDiffs -> DefinitionDiffs -> Bool
Eq, Eq DefinitionDiffs
Eq DefinitionDiffs =>
(DefinitionDiffs -> DefinitionDiffs -> Ordering)
-> (DefinitionDiffs -> DefinitionDiffs -> Bool)
-> (DefinitionDiffs -> DefinitionDiffs -> Bool)
-> (DefinitionDiffs -> DefinitionDiffs -> Bool)
-> (DefinitionDiffs -> DefinitionDiffs -> Bool)
-> (DefinitionDiffs -> DefinitionDiffs -> DefinitionDiffs)
-> (DefinitionDiffs -> DefinitionDiffs -> DefinitionDiffs)
-> Ord DefinitionDiffs
DefinitionDiffs -> DefinitionDiffs -> Bool
DefinitionDiffs -> DefinitionDiffs -> Ordering
DefinitionDiffs -> DefinitionDiffs -> DefinitionDiffs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DefinitionDiffs -> DefinitionDiffs -> Ordering
compare :: DefinitionDiffs -> DefinitionDiffs -> Ordering
$c< :: DefinitionDiffs -> DefinitionDiffs -> Bool
< :: DefinitionDiffs -> DefinitionDiffs -> Bool
$c<= :: DefinitionDiffs -> DefinitionDiffs -> Bool
<= :: DefinitionDiffs -> DefinitionDiffs -> Bool
$c> :: DefinitionDiffs -> DefinitionDiffs -> Bool
> :: DefinitionDiffs -> DefinitionDiffs -> Bool
$c>= :: DefinitionDiffs -> DefinitionDiffs -> Bool
>= :: DefinitionDiffs -> DefinitionDiffs -> Bool
$cmax :: DefinitionDiffs -> DefinitionDiffs -> DefinitionDiffs
max :: DefinitionDiffs -> DefinitionDiffs -> DefinitionDiffs
$cmin :: DefinitionDiffs -> DefinitionDiffs -> DefinitionDiffs
min :: DefinitionDiffs -> DefinitionDiffs -> DefinitionDiffs
Ord)

instance Semigroup DefinitionDiffs where
  DefinitionDiffs
a <> :: DefinitionDiffs -> DefinitionDiffs -> DefinitionDiffs
<> DefinitionDiffs
b =
    DefinitionDiffs
      { $sel:termDiffs:DefinitionDiffs :: Map NameSegment (Diff Referent)
termDiffs = DefinitionDiffs -> Map NameSegment (Diff Referent)
termDiffs DefinitionDiffs
a Map NameSegment (Diff Referent)
-> Map NameSegment (Diff Referent)
-> Map NameSegment (Diff Referent)
forall a. Semigroup a => a -> a -> a
<> DefinitionDiffs -> Map NameSegment (Diff Referent)
termDiffs DefinitionDiffs
b,
        $sel:typeDiffs:DefinitionDiffs :: Map NameSegment (Diff Reference)
typeDiffs = DefinitionDiffs -> Map NameSegment (Diff Reference)
typeDiffs DefinitionDiffs
a Map NameSegment (Diff Reference)
-> Map NameSegment (Diff Reference)
-> Map NameSegment (Diff Reference)
forall a. Semigroup a => a -> a -> a
<> DefinitionDiffs -> Map NameSegment (Diff Reference)
typeDiffs DefinitionDiffs
b
      }

instance Monoid DefinitionDiffs where
  mempty :: DefinitionDiffs
mempty = Map NameSegment (Diff Referent)
-> Map NameSegment (Diff Reference) -> DefinitionDiffs
DefinitionDiffs Map NameSegment (Diff Referent)
forall a. Monoid a => a
mempty Map NameSegment (Diff Reference)
forall a. Monoid a => a
mempty

-- | A tree of local diffs. Each node of the tree contains the definition diffs at that path.
newtype TreeDiff m = TreeDiff
  { forall (m :: * -> *).
TreeDiff m -> Cofree (Compose (Map NameSegment) m) DefinitionDiffs
unTreeDiff :: Cofree (Compose (Map NameSegment) m) DefinitionDiffs
  }
  deriving stock (Int -> TreeDiff m -> ShowS
[TreeDiff m] -> ShowS
TreeDiff m -> String
(Int -> TreeDiff m -> ShowS)
-> (TreeDiff m -> String)
-> ([TreeDiff m] -> ShowS)
-> Show (TreeDiff m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *). Show1 m => Int -> TreeDiff m -> ShowS
forall (m :: * -> *). Show1 m => [TreeDiff m] -> ShowS
forall (m :: * -> *). Show1 m => TreeDiff m -> String
$cshowsPrec :: forall (m :: * -> *). Show1 m => Int -> TreeDiff m -> ShowS
showsPrec :: Int -> TreeDiff m -> ShowS
$cshow :: forall (m :: * -> *). Show1 m => TreeDiff m -> String
show :: TreeDiff m -> String
$cshowList :: forall (m :: * -> *). Show1 m => [TreeDiff m] -> ShowS
showList :: [TreeDiff m] -> ShowS
Show, TreeDiff m -> TreeDiff m -> Bool
(TreeDiff m -> TreeDiff m -> Bool)
-> (TreeDiff m -> TreeDiff m -> Bool) -> Eq (TreeDiff m)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *). Eq1 m => TreeDiff m -> TreeDiff m -> Bool
$c== :: forall (m :: * -> *). Eq1 m => TreeDiff m -> TreeDiff m -> Bool
== :: TreeDiff m -> TreeDiff m -> Bool
$c/= :: forall (m :: * -> *). Eq1 m => TreeDiff m -> TreeDiff m -> Bool
/= :: TreeDiff m -> TreeDiff m -> Bool
Eq, Eq (TreeDiff m)
Eq (TreeDiff m) =>
(TreeDiff m -> TreeDiff m -> Ordering)
-> (TreeDiff m -> TreeDiff m -> Bool)
-> (TreeDiff m -> TreeDiff m -> Bool)
-> (TreeDiff m -> TreeDiff m -> Bool)
-> (TreeDiff m -> TreeDiff m -> Bool)
-> (TreeDiff m -> TreeDiff m -> TreeDiff m)
-> (TreeDiff m -> TreeDiff m -> TreeDiff m)
-> Ord (TreeDiff m)
TreeDiff m -> TreeDiff m -> Bool
TreeDiff m -> TreeDiff m -> Ordering
TreeDiff m -> TreeDiff m -> TreeDiff m
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (m :: * -> *). Ord1 m => Eq (TreeDiff m)
forall (m :: * -> *). Ord1 m => TreeDiff m -> TreeDiff m -> Bool
forall (m :: * -> *).
Ord1 m =>
TreeDiff m -> TreeDiff m -> Ordering
forall (m :: * -> *).
Ord1 m =>
TreeDiff m -> TreeDiff m -> TreeDiff m
$ccompare :: forall (m :: * -> *).
Ord1 m =>
TreeDiff m -> TreeDiff m -> Ordering
compare :: TreeDiff m -> TreeDiff m -> Ordering
$c< :: forall (m :: * -> *). Ord1 m => TreeDiff m -> TreeDiff m -> Bool
< :: TreeDiff m -> TreeDiff m -> Bool
$c<= :: forall (m :: * -> *). Ord1 m => TreeDiff m -> TreeDiff m -> Bool
<= :: TreeDiff m -> TreeDiff m -> Bool
$c> :: forall (m :: * -> *). Ord1 m => TreeDiff m -> TreeDiff m -> Bool
> :: TreeDiff m -> TreeDiff m -> Bool
$c>= :: forall (m :: * -> *). Ord1 m => TreeDiff m -> TreeDiff m -> Bool
>= :: TreeDiff m -> TreeDiff m -> Bool
$cmax :: forall (m :: * -> *).
Ord1 m =>
TreeDiff m -> TreeDiff m -> TreeDiff m
max :: TreeDiff m -> TreeDiff m -> TreeDiff m
$cmin :: forall (m :: * -> *).
Ord1 m =>
TreeDiff m -> TreeDiff m -> TreeDiff m
min :: TreeDiff m -> TreeDiff m -> TreeDiff m
Ord)

instance (Applicative m) => Semigroup (TreeDiff m) where
  TreeDiff (DefinitionDiffs
a :< Compose Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
mas) <> :: TreeDiff m -> TreeDiff m -> TreeDiff m
<> TreeDiff (DefinitionDiffs
b :< Compose Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
mbs) =
    Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
forall (m :: * -> *).
Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
TreeDiff (Cofree (Compose (Map NameSegment) m) DefinitionDiffs
 -> TreeDiff m)
-> Cofree (Compose (Map NameSegment) m) DefinitionDiffs
-> TreeDiff m
forall a b. (a -> b) -> a -> b
$ (DefinitionDiffs
a DefinitionDiffs -> DefinitionDiffs -> DefinitionDiffs
forall a. Semigroup a => a -> a -> a
<> DefinitionDiffs
b) DefinitionDiffs
-> Compose
     (Map NameSegment)
     m
     (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
-> Cofree (Compose (Map NameSegment) m) DefinitionDiffs
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
-> Compose
     (Map NameSegment)
     m
     (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
 -> m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
 -> m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
-> Map
     NameSegment
     (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
-> Map
     NameSegment
     (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
-> Map
     NameSegment
     (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
-> m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
-> m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
mergeCofrees Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
mas Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
mbs)
    where
      mergeCofrees :: m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
-> m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
-> m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
mergeCofrees = (Cofree (Compose (Map NameSegment) m) DefinitionDiffs
 -> Cofree (Compose (Map NameSegment) m) DefinitionDiffs
 -> Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
-> m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
-> m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
-> m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\Cofree (Compose (Map NameSegment) m) DefinitionDiffs
x Cofree (Compose (Map NameSegment) m) DefinitionDiffs
y -> TreeDiff m -> Cofree (Compose (Map NameSegment) m) DefinitionDiffs
forall (m :: * -> *).
TreeDiff m -> Cofree (Compose (Map NameSegment) m) DefinitionDiffs
unTreeDiff (Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
forall (m :: * -> *).
Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
TreeDiff Cofree (Compose (Map NameSegment) m) DefinitionDiffs
x TreeDiff m -> TreeDiff m -> TreeDiff m
forall a. Semigroup a => a -> a -> a
<> Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
forall (m :: * -> *).
Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
TreeDiff Cofree (Compose (Map NameSegment) m) DefinitionDiffs
y))

instance (Applicative m) => Monoid (TreeDiff m) where
  mempty :: TreeDiff m
mempty = Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
forall (m :: * -> *).
Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
TreeDiff (DefinitionDiffs
forall a. Monoid a => a
mempty DefinitionDiffs
-> Compose
     (Map NameSegment)
     m
     (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
-> Cofree (Compose (Map NameSegment) m) DefinitionDiffs
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
-> Compose
     (Map NameSegment)
     m
     (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
forall a. Monoid a => a
mempty)

hoistTreeDiff :: (Functor m) => (forall x. m x -> n x) -> TreeDiff m -> TreeDiff n
hoistTreeDiff :: forall (m :: * -> *) (n :: * -> *).
Functor m =>
(forall x. m x -> n x) -> TreeDiff m -> TreeDiff n
hoistTreeDiff forall x. m x -> n x
f (TreeDiff Cofree (Compose (Map NameSegment) m) DefinitionDiffs
cfr) =
  Cofree (Compose (Map NameSegment) n) DefinitionDiffs -> TreeDiff n
forall (m :: * -> *).
Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
TreeDiff (Cofree (Compose (Map NameSegment) n) DefinitionDiffs
 -> TreeDiff n)
-> Cofree (Compose (Map NameSegment) n) DefinitionDiffs
-> TreeDiff n
forall a b. (a -> b) -> a -> b
$ (forall x.
 Compose (Map NameSegment) m x -> Compose (Map NameSegment) n x)
-> Cofree (Compose (Map NameSegment) m) DefinitionDiffs
-> Cofree (Compose (Map NameSegment) n) DefinitionDiffs
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(forall x. f x -> g x) -> Cofree f a -> Cofree g a
Cofree.hoistCofree (\(Compose Map NameSegment (m x)
m) -> Map NameSegment (n x) -> Compose (Map NameSegment) n x
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((m x -> n x) -> Map NameSegment (m x) -> Map NameSegment (n x)
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m x -> n x
forall x. m x -> n x
f Map NameSegment (m x)
m)) Cofree (Compose (Map NameSegment) m) DefinitionDiffs
cfr

-- | A summary of a 'TreeDiff', containing all names added and removed.
-- Note that there isn't a clear notion of a name "changing" since conflicts might muddy the notion
-- by having multiple copies of both the from and to names, so we just talk about adds and
-- removals instead.
data NameChanges = NameChanges
  { NameChanges -> [(Name, Referent)]
termNameAdds :: [(Name, Referent)],
    NameChanges -> [(Name, Referent)]
termNameRemovals :: [(Name, Referent)],
    NameChanges -> [(Name, Reference)]
typeNameAdds :: [(Name, Reference)],
    NameChanges -> [(Name, Reference)]
typeNameRemovals :: [(Name, Reference)]
  }
  deriving stock (Int -> NameChanges -> ShowS
[NameChanges] -> ShowS
NameChanges -> String
(Int -> NameChanges -> ShowS)
-> (NameChanges -> String)
-> ([NameChanges] -> ShowS)
-> Show NameChanges
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameChanges -> ShowS
showsPrec :: Int -> NameChanges -> ShowS
$cshow :: NameChanges -> String
show :: NameChanges -> String
$cshowList :: [NameChanges] -> ShowS
showList :: [NameChanges] -> ShowS
Show, NameChanges -> NameChanges -> Bool
(NameChanges -> NameChanges -> Bool)
-> (NameChanges -> NameChanges -> Bool) -> Eq NameChanges
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameChanges -> NameChanges -> Bool
== :: NameChanges -> NameChanges -> Bool
$c/= :: NameChanges -> NameChanges -> Bool
/= :: NameChanges -> NameChanges -> Bool
Eq)

instance Semigroup NameChanges where
  NameChanges [(Name, Referent)]
a [(Name, Referent)]
b [(Name, Reference)]
c [(Name, Reference)]
d <> :: NameChanges -> NameChanges -> NameChanges
<> NameChanges [(Name, Referent)]
a2 [(Name, Referent)]
b2 [(Name, Reference)]
c2 [(Name, Reference)]
d2 =
    [(Name, Referent)]
-> [(Name, Referent)]
-> [(Name, Reference)]
-> [(Name, Reference)]
-> NameChanges
NameChanges ([(Name, Referent)]
a [(Name, Referent)] -> [(Name, Referent)] -> [(Name, Referent)]
forall a. Semigroup a => a -> a -> a
<> [(Name, Referent)]
a2) ([(Name, Referent)]
b [(Name, Referent)] -> [(Name, Referent)] -> [(Name, Referent)]
forall a. Semigroup a => a -> a -> a
<> [(Name, Referent)]
b2) ([(Name, Reference)]
c [(Name, Reference)] -> [(Name, Reference)] -> [(Name, Reference)]
forall a. Semigroup a => a -> a -> a
<> [(Name, Reference)]
c2) ([(Name, Reference)]
d [(Name, Reference)] -> [(Name, Reference)] -> [(Name, Reference)]
forall a. Semigroup a => a -> a -> a
<> [(Name, Reference)]
d2)

instance Monoid NameChanges where
  mempty :: NameChanges
mempty = [(Name, Referent)]
-> [(Name, Referent)]
-> [(Name, Reference)]
-> [(Name, Reference)]
-> NameChanges
NameChanges [(Name, Referent)]
forall a. Monoid a => a
mempty [(Name, Referent)]
forall a. Monoid a => a
mempty [(Name, Reference)]
forall a. Monoid a => a
mempty [(Name, Reference)]
forall a. Monoid a => a
mempty

-- | A name-based diff for namespaces `N1` and `N2` is (for both terms and types) a relation between references, where
-- `a R b` if:
--
--   1. `a` has name `n` in `N1`, and `b` has the same name `n` in `N2`
--   2. `a` != `b`
data NameBasedDiff = NameBasedDiff
  { NameBasedDiff -> Relation Reference Reference
terms :: Relation Reference Reference,
    NameBasedDiff -> Relation Reference Reference
types :: Relation Reference Reference
  }
  deriving stock ((forall x. NameBasedDiff -> Rep NameBasedDiff x)
-> (forall x. Rep NameBasedDiff x -> NameBasedDiff)
-> Generic NameBasedDiff
forall x. Rep NameBasedDiff x -> NameBasedDiff
forall x. NameBasedDiff -> Rep NameBasedDiff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameBasedDiff -> Rep NameBasedDiff x
from :: forall x. NameBasedDiff -> Rep NameBasedDiff x
$cto :: forall x. Rep NameBasedDiff x -> NameBasedDiff
to :: forall x. Rep NameBasedDiff x -> NameBasedDiff
Generic, Int -> NameBasedDiff -> ShowS
[NameBasedDiff] -> ShowS
NameBasedDiff -> String
(Int -> NameBasedDiff -> ShowS)
-> (NameBasedDiff -> String)
-> ([NameBasedDiff] -> ShowS)
-> Show NameBasedDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameBasedDiff -> ShowS
showsPrec :: Int -> NameBasedDiff -> ShowS
$cshow :: NameBasedDiff -> String
show :: NameBasedDiff -> String
$cshowList :: [NameBasedDiff] -> ShowS
showList :: [NameBasedDiff] -> ShowS
Show)

instance Monoid NameBasedDiff where
  mempty :: NameBasedDiff
mempty = Relation Reference Reference
-> Relation Reference Reference -> NameBasedDiff
NameBasedDiff Relation Reference Reference
forall a. Monoid a => a
mempty Relation Reference Reference
forall a. Monoid a => a
mempty

instance Semigroup NameBasedDiff where
  NameBasedDiff Relation Reference Reference
terms0 Relation Reference Reference
types0 <> :: NameBasedDiff -> NameBasedDiff -> NameBasedDiff
<> NameBasedDiff Relation Reference Reference
terms1 Relation Reference Reference
types1 =
    Relation Reference Reference
-> Relation Reference Reference -> NameBasedDiff
NameBasedDiff (Relation Reference Reference
terms0 Relation Reference Reference
-> Relation Reference Reference -> Relation Reference Reference
forall a. Semigroup a => a -> a -> a
<> Relation Reference Reference
terms1) (Relation Reference Reference
types0 Relation Reference Reference
-> Relation Reference Reference -> Relation Reference Reference
forall a. Semigroup a => a -> a -> a
<> Relation Reference Reference
types1)

-- | Diff two Branches, returning a tree containing all of the changes
diffBranches :: Branch Sqlite.Transaction -> Branch Sqlite.Transaction -> Sqlite.Transaction (TreeDiff Sqlite.Transaction)
diffBranches :: Branch Transaction
-> Branch Transaction -> Transaction (TreeDiff Transaction)
diffBranches Branch Transaction
from Branch Transaction
to = do
  Map NameSegment (CausalBranch Transaction)
fromChildren <- Branch Transaction
-> Transaction (Map NameSegment (CausalBranch Transaction))
forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
V2Branch.nonEmptyChildren Branch Transaction
from
  Map NameSegment (CausalBranch Transaction)
toChildren <- Branch Transaction
-> Transaction (Map NameSegment (CausalBranch Transaction))
forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
V2Branch.nonEmptyChildren Branch Transaction
to
  let termDiffs :: Map NameSegment (Diff Referent)
termDiffs = Map NameSegment (Map Referent (Transaction MdValues))
-> Map NameSegment (Map Referent (Transaction MdValues))
-> Map NameSegment (Diff Referent)
forall ref.
Ord ref =>
Map NameSegment (Map ref (Transaction MdValues))
-> Map NameSegment (Map ref (Transaction MdValues))
-> Map NameSegment (Diff ref)
diffMap (Branch Transaction
-> Map NameSegment (Map Referent (Transaction MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Referent (m MdValues))
Branch.terms Branch Transaction
from) (Branch Transaction
-> Map NameSegment (Map Referent (Transaction MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Referent (m MdValues))
Branch.terms Branch Transaction
to)
  let typeDiffs :: Map NameSegment (Diff Reference)
typeDiffs = Map NameSegment (Map Reference (Transaction MdValues))
-> Map NameSegment (Map Reference (Transaction MdValues))
-> Map NameSegment (Diff Reference)
forall ref.
Ord ref =>
Map NameSegment (Map ref (Transaction MdValues))
-> Map NameSegment (Map ref (Transaction MdValues))
-> Map NameSegment (Diff ref)
diffMap (Branch Transaction
-> Map NameSegment (Map Reference (Transaction MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Reference (m MdValues))
Branch.types Branch Transaction
from) (Branch Transaction
-> Map NameSegment (Map Reference (Transaction MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Reference (m MdValues))
Branch.types Branch Transaction
to)
  let defDiff :: DefinitionDiffs
defDiff = DefinitionDiffs {Map NameSegment (Diff Referent)
$sel:termDiffs:DefinitionDiffs :: Map NameSegment (Diff Referent)
termDiffs :: Map NameSegment (Diff Referent)
termDiffs, Map NameSegment (Diff Reference)
$sel:typeDiffs:DefinitionDiffs :: Map NameSegment (Diff Reference)
typeDiffs :: Map NameSegment (Diff Reference)
typeDiffs}
  let childDiff :: Map NameSegment (Sqlite.Transaction (Cofree (Compose (Map NameSegment) Sqlite.Transaction) DefinitionDiffs))
      childDiff :: Map
  NameSegment
  (Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
childDiff =
        Map NameSegment (CausalBranch Transaction)
-> Map NameSegment (CausalBranch Transaction)
-> Map
     NameSegment
     (These (CausalBranch Transaction) (CausalBranch Transaction))
forall a b.
Map NameSegment a
-> Map NameSegment b -> Map NameSegment (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
Align.align Map NameSegment (CausalBranch Transaction)
fromChildren Map NameSegment (CausalBranch Transaction)
toChildren
          Map
  NameSegment
  (These (CausalBranch Transaction) (CausalBranch Transaction))
-> (Map
      NameSegment
      (These (CausalBranch Transaction) (CausalBranch Transaction))
    -> Map
         NameSegment
         (Transaction
            (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)))
-> Map
     NameSegment
     (Transaction
        (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
forall a b. a -> (a -> b) -> b
& (These (CausalBranch Transaction) (CausalBranch Transaction)
 -> Maybe
      (Transaction
         (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)))
-> Map
     NameSegment
     (These (CausalBranch Transaction) (CausalBranch Transaction))
-> Map
     NameSegment
     (Transaction
        (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
forall a b.
(a -> Maybe b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \case
            This CausalBranch Transaction
ca -> Transaction
  (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
-> Maybe
     (Transaction
        (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
forall a. a -> Maybe a
Just do
              -- TODO: For the names index we really don't need to know which exact
              -- names were removed, we just need to delete from the index using a
              -- prefix query, this would be faster than crawling to get all the deletes.
              Branch Transaction
removedChildBranch <- CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
Causal.value CausalBranch Transaction
ca
              TreeDiff Transaction
-> Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs
forall (m :: * -> *).
TreeDiff m -> Cofree (Compose (Map NameSegment) m) DefinitionDiffs
unTreeDiff (TreeDiff Transaction
 -> Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
-> Transaction (TreeDiff Transaction)
-> Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branch Transaction
-> Branch Transaction -> Transaction (TreeDiff Transaction)
diffBranches Branch Transaction
removedChildBranch Branch Transaction
forall (m :: * -> *). Branch m
Branch.empty
            That CausalBranch Transaction
ca -> Transaction
  (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
-> Maybe
     (Transaction
        (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
forall a. a -> Maybe a
Just do
              Branch Transaction
newChildBranch <- CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
Causal.value CausalBranch Transaction
ca
              TreeDiff Transaction
-> Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs
forall (m :: * -> *).
TreeDiff m -> Cofree (Compose (Map NameSegment) m) DefinitionDiffs
unTreeDiff (TreeDiff Transaction
 -> Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
-> Transaction (TreeDiff Transaction)
-> Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branch Transaction
-> Branch Transaction -> Transaction (TreeDiff Transaction)
diffBranches Branch Transaction
forall (m :: * -> *). Branch m
Branch.empty Branch Transaction
newChildBranch
            These CausalBranch Transaction
fromC CausalBranch Transaction
toC
              | CausalBranch Transaction -> BranchHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> he
Causal.valueHash CausalBranch Transaction
fromC BranchHash -> BranchHash -> Bool
forall a. Eq a => a -> a -> Bool
== CausalBranch Transaction -> BranchHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> he
Causal.valueHash CausalBranch Transaction
toC ->
                  -- This child didn't change.
                  Maybe
  (Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
forall a. Maybe a
Nothing
              | Bool
otherwise -> Transaction
  (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
-> Maybe
     (Transaction
        (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
forall a. a -> Maybe a
Just (Transaction
   (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
 -> Maybe
      (Transaction
         (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)))
-> Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
-> Maybe
     (Transaction
        (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
forall a b. (a -> b) -> a -> b
$ do
                  Branch Transaction
fromChildBranch <- CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
Causal.value CausalBranch Transaction
fromC
                  Branch Transaction
toChildBranch <- CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
Causal.value CausalBranch Transaction
toC
                  Branch Transaction
-> Branch Transaction -> Transaction (TreeDiff Transaction)
diffBranches Branch Transaction
fromChildBranch Branch Transaction
toChildBranch Transaction (TreeDiff Transaction)
-> (TreeDiff Transaction
    -> Transaction
         (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
-> Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    TreeDiff (DefinitionDiffs
defDiffs :< Compose Map
  NameSegment
  (Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
mchildren) -> do
                      Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs
-> Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs
 -> Transaction
      (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
-> Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs
-> Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
forall a b. (a -> b) -> a -> b
$ (DefinitionDiffs
defDiffs DefinitionDiffs
-> Compose
     (Map NameSegment)
     Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
-> Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< Map
  NameSegment
  (Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
-> Compose
     (Map NameSegment)
     Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Map
  NameSegment
  (Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
mchildren)
  TreeDiff Transaction -> Transaction (TreeDiff Transaction)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TreeDiff Transaction -> Transaction (TreeDiff Transaction))
-> TreeDiff Transaction -> Transaction (TreeDiff Transaction)
forall a b. (a -> b) -> a -> b
$
    Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs
-> TreeDiff Transaction
forall (m :: * -> *).
Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
TreeDiff (DefinitionDiffs
defDiff DefinitionDiffs
-> Compose
     (Map NameSegment)
     Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
-> Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< Map
  NameSegment
  (Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
-> Compose
     (Map NameSegment)
     Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs)
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Map
  NameSegment
  (Transaction
     (Cofree (Compose (Map NameSegment) Transaction) DefinitionDiffs))
childDiff)
  where
    diffMap :: forall ref. (Ord ref) => Map NameSegment (Map ref (Sqlite.Transaction MdValues)) -> Map NameSegment (Map ref (Sqlite.Transaction MdValues)) -> Map NameSegment (Diff ref)
    diffMap :: forall ref.
Ord ref =>
Map NameSegment (Map ref (Transaction MdValues))
-> Map NameSegment (Map ref (Transaction MdValues))
-> Map NameSegment (Diff ref)
diffMap Map NameSegment (Map ref (Transaction MdValues))
l Map NameSegment (Map ref (Transaction MdValues))
r =
      Map NameSegment (Map ref (Transaction MdValues))
-> Map NameSegment (Map ref (Transaction MdValues))
-> Map
     NameSegment
     (These
        (Map ref (Transaction MdValues)) (Map ref (Transaction MdValues)))
forall a b.
Map NameSegment a
-> Map NameSegment b -> Map NameSegment (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
Align.align Map NameSegment (Map ref (Transaction MdValues))
l Map NameSegment (Map ref (Transaction MdValues))
r
        Map
  NameSegment
  (These
     (Map ref (Transaction MdValues)) (Map ref (Transaction MdValues)))
-> (Map
      NameSegment
      (These
         (Map ref (Transaction MdValues)) (Map ref (Transaction MdValues)))
    -> Map NameSegment (Diff ref))
-> Map NameSegment (Diff ref)
forall a b. a -> (a -> b) -> b
& (These
   (Map ref (Transaction MdValues)) (Map ref (Transaction MdValues))
 -> Diff ref)
-> Map
     NameSegment
     (These
        (Map ref (Transaction MdValues)) (Map ref (Transaction MdValues)))
-> Map NameSegment (Diff ref)
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \case
          This Map ref (Transaction MdValues)
refs -> Diff {$sel:removals:Diff :: Set ref
removals = Map ref (Transaction MdValues) -> Set ref
forall k a. Map k a -> Set k
Map.keysSet Map ref (Transaction MdValues)
refs, $sel:adds:Diff :: Set ref
adds = Set ref
forall a. Monoid a => a
mempty}
          That Map ref (Transaction MdValues)
refs -> Diff {$sel:removals:Diff :: Set ref
removals = Set ref
forall a. Monoid a => a
mempty, $sel:adds:Diff :: Set ref
adds = Map ref (Transaction MdValues) -> Set ref
forall k a. Map k a -> Set k
Map.keysSet Map ref (Transaction MdValues)
refs}
          These Map ref (Transaction MdValues)
l' Map ref (Transaction MdValues)
r' ->
            let lRefs :: Set ref
lRefs = Map ref (Transaction MdValues) -> Set ref
forall k a. Map k a -> Set k
Map.keysSet Map ref (Transaction MdValues)
l'
                rRefs :: Set ref
rRefs = Map ref (Transaction MdValues) -> Set ref
forall k a. Map k a -> Set k
Map.keysSet Map ref (Transaction MdValues)
r'
             in Diff {$sel:removals:Diff :: Set ref
removals = Set ref
lRefs Set ref -> Set ref -> Set ref
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set ref
rRefs, $sel:adds:Diff :: Set ref
adds = Set ref
rRefs Set ref -> Set ref -> Set ref
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set ref
lRefs}

-- | Get a summary of all of the name adds and removals from a tree diff.
--
-- The provided name will be prepended to all names in the output diff, and can be useful if diffing branches at a
-- specific sub-tree, but you can pass 'Nothing' if you're diffing from the root.
allNameChanges ::
  (Monad m) =>
  Maybe Name ->
  TreeDiff m ->
  m NameChanges
allNameChanges :: forall (m :: * -> *).
Monad m =>
Maybe Name -> TreeDiff m -> m NameChanges
allNameChanges Maybe Name
mayPrefix TreeDiff m
treediff = do
  Maybe Name
-> TreeDiff m
-> (Maybe Name -> NameChanges -> m NameChanges)
-> m NameChanges
forall (m :: * -> *) r.
(Monad m, Monoid r) =>
Maybe Name
-> TreeDiff m -> (Maybe Name -> NameChanges -> m r) -> m r
streamNameChanges Maybe Name
mayPrefix TreeDiff m
treediff \Maybe Name
_prefix NameChanges
changes -> NameChanges -> m NameChanges
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NameChanges
changes

-- | Get a 'NameBasedDiff' from a 'TreeDiff'.
nameBasedDiff :: (Monad m) => TreeDiff m -> m NameBasedDiff
nameBasedDiff :: forall (m :: * -> *). Monad m => TreeDiff m -> m NameBasedDiff
nameBasedDiff (TreeDiff (DefinitionDiffs {Map NameSegment (Diff Referent)
$sel:termDiffs:DefinitionDiffs :: DefinitionDiffs -> Map NameSegment (Diff Referent)
termDiffs :: Map NameSegment (Diff Referent)
termDiffs, Map NameSegment (Diff Reference)
$sel:typeDiffs:DefinitionDiffs :: DefinitionDiffs -> Map NameSegment (Diff Reference)
typeDiffs :: Map NameSegment (Diff Reference)
typeDiffs} :< Compose Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
childMap)) = do
  NameBasedDiff
children <- Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
-> m (Map
        NameSegment (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map NameSegment (f a) -> f (Map NameSegment a)
sequenceA Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
childMap m (Map
     NameSegment (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
-> (Map
      NameSegment (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
    -> m NameBasedDiff)
-> m NameBasedDiff
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Cofree (Compose (Map NameSegment) m) DefinitionDiffs
 -> m NameBasedDiff)
-> Map
     NameSegment (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
-> m NameBasedDiff
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM (TreeDiff m -> m NameBasedDiff
forall (m :: * -> *). Monad m => TreeDiff m -> m NameBasedDiff
nameBasedDiff (TreeDiff m -> m NameBasedDiff)
-> (Cofree (Compose (Map NameSegment) m) DefinitionDiffs
    -> TreeDiff m)
-> Cofree (Compose (Map NameSegment) m) DefinitionDiffs
-> m NameBasedDiff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
forall (m :: * -> *).
Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
TreeDiff)
  let terms :: Relation Reference Reference
terms = (Diff Referent -> Relation Reference Reference)
-> Map NameSegment (Diff Referent) -> Relation Reference Reference
forall m a. Monoid m => (a -> m) -> Map NameSegment a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Diff Referent -> Relation Reference Reference
nameBasedTermDiff Map NameSegment (Diff Referent)
termDiffs
  let types :: Relation Reference Reference
types = (Diff Reference -> Relation Reference Reference)
-> Map NameSegment (Diff Reference) -> Relation Reference Reference
forall m a. Monoid m => (a -> m) -> Map NameSegment a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Diff Reference -> Relation Reference Reference
nameBasedTypeDiff Map NameSegment (Diff Reference)
typeDiffs
  pure $ NameBasedDiff {Relation Reference Reference
$sel:terms:NameBasedDiff :: Relation Reference Reference
terms :: Relation Reference Reference
terms, Relation Reference Reference
$sel:types:NameBasedDiff :: Relation Reference Reference
types :: Relation Reference Reference
types} NameBasedDiff -> NameBasedDiff -> NameBasedDiff
forall a. Semigroup a => a -> a -> a
<> NameBasedDiff
children
  where
    nameBasedTermDiff :: Diff Referent -> Relation Reference Reference
    nameBasedTermDiff :: Diff Referent -> Relation Reference Reference
nameBasedTermDiff Diff {Set Referent
$sel:adds:Diff :: forall a. Diff a -> Set a
adds :: Set Referent
adds, Set Referent
$sel:removals:Diff :: forall a. Diff a -> Set a
removals :: Set Referent
removals} =
      let termAdds :: [Reference]
termAdds = (Referent -> Maybe Reference) -> [Referent] -> [Reference]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe Referent -> Maybe Reference
forall termRef typeRef. Referent' termRef typeRef -> Maybe termRef
Referent.toTermReference (Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList Set Referent
adds)
          termRemovals :: [Reference]
termRemovals = (Referent -> Maybe Reference) -> [Referent] -> [Reference]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe Referent -> Maybe Reference
forall termRef typeRef. Referent' termRef typeRef -> Maybe termRef
Referent.toTermReference (Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList Set Referent
removals)
       in ((,) (Reference -> Reference -> (Reference, Reference))
-> [Reference] -> [Reference -> (Reference, Reference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Reference]
termRemovals [Reference -> (Reference, Reference)]
-> [Reference] -> [(Reference, Reference)]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Reference]
termAdds)
            [(Reference, Reference)]
-> ([(Reference, Reference)] -> [(Reference, Reference)])
-> [(Reference, Reference)]
forall a b. a -> (a -> b) -> b
& ((Reference, Reference) -> Bool)
-> [(Reference, Reference)] -> [(Reference, Reference)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Reference
r0, Reference
r1) -> Reference
r0 Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
/= Reference
r1)
            [(Reference, Reference)]
-> ([(Reference, Reference)] -> Relation Reference Reference)
-> Relation Reference Reference
forall a b. a -> (a -> b) -> b
& [(Reference, Reference)] -> Relation Reference Reference
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
Relation.fromList

    nameBasedTypeDiff :: Diff Reference -> Relation Reference Reference
    nameBasedTypeDiff :: Diff Reference -> Relation Reference Reference
nameBasedTypeDiff Diff {Set Reference
$sel:adds:Diff :: forall a. Diff a -> Set a
adds :: Set Reference
adds, Set Reference
$sel:removals:Diff :: forall a. Diff a -> Set a
removals :: Set Reference
removals} =
      ((,) (Reference -> Reference -> (Reference, Reference))
-> [Reference] -> [Reference -> (Reference, Reference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList Set Reference
removals [Reference -> (Reference, Reference)]
-> [Reference] -> [(Reference, Reference)]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList Set Reference
adds)
        [(Reference, Reference)]
-> ([(Reference, Reference)] -> [(Reference, Reference)])
-> [(Reference, Reference)]
forall a b. a -> (a -> b) -> b
& ((Reference, Reference) -> Bool)
-> [(Reference, Reference)] -> [(Reference, Reference)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Reference
r0, Reference
r1) -> Reference
r0 Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
/= Reference
r1)
        [(Reference, Reference)]
-> ([(Reference, Reference)] -> Relation Reference Reference)
-> Relation Reference Reference
forall a b. a -> (a -> b) -> b
& [(Reference, Reference)] -> Relation Reference Reference
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
Relation.fromList

-- | Stream a summary of all of the name adds and removals from a tree diff.
-- Callback is passed the diff from one namespace level at a time, with the name representing
-- that location.
-- Accumulator is folded strictly, use '()' if you don't need one.
streamNameChanges ::
  (Monad m, Monoid r) =>
  Maybe Name ->
  TreeDiff m ->
  (Maybe Name -> NameChanges -> m r) ->
  m r
streamNameChanges :: forall (m :: * -> *) r.
(Monad m, Monoid r) =>
Maybe Name
-> TreeDiff m -> (Maybe Name -> NameChanges -> m r) -> m r
streamNameChanges Maybe Name
namePrefix (TreeDiff (DefinitionDiffs {Map NameSegment (Diff Referent)
$sel:termDiffs:DefinitionDiffs :: DefinitionDiffs -> Map NameSegment (Diff Referent)
termDiffs :: Map NameSegment (Diff Referent)
termDiffs, Map NameSegment (Diff Reference)
$sel:typeDiffs:DefinitionDiffs :: DefinitionDiffs -> Map NameSegment (Diff Reference)
typeDiffs :: Map NameSegment (Diff Reference)
typeDiffs} :< Compose Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
children)) Maybe Name -> NameChanges -> m r
f = do
  let ([(Name, Referent)]
termNameAdds, [(Name, Referent)]
termNameRemovals) =
        Map NameSegment (Diff Referent)
termDiffs
          Map NameSegment (Diff Referent)
-> (Map NameSegment (Diff Referent)
    -> ([(Name, Referent)], [(Name, Referent)]))
-> ([(Name, Referent)], [(Name, Referent)])
forall a b. a -> (a -> b) -> b
& (NameSegment
 -> Diff Referent -> ([(Name, Referent)], [(Name, Referent)]))
-> Map NameSegment (Diff Referent)
-> ([(Name, Referent)], [(Name, Referent)])
forall m a.
Monoid m =>
(NameSegment -> a -> m) -> Map NameSegment a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap \NameSegment
ns Diff Referent
diff ->
            let name :: Name
name = NameSegment -> Name
appendName NameSegment
ns
             in (Name -> Set Referent -> [(Name, Referent)]
forall ref. Name -> Set ref -> [(Name, ref)]
listifyNames Name
name (Set Referent -> [(Name, Referent)])
-> Set Referent -> [(Name, Referent)]
forall a b. (a -> b) -> a -> b
$ Diff Referent -> Set Referent
forall a. Diff a -> Set a
adds Diff Referent
diff, Name -> Set Referent -> [(Name, Referent)]
forall ref. Name -> Set ref -> [(Name, ref)]
listifyNames Name
name (Set Referent -> [(Name, Referent)])
-> Set Referent -> [(Name, Referent)]
forall a b. (a -> b) -> a -> b
$ Diff Referent -> Set Referent
forall a. Diff a -> Set a
removals Diff Referent
diff)
  let ([(Name, Reference)]
typeNameAdds, [(Name, Reference)]
typeNameRemovals) =
        Map NameSegment (Diff Reference)
typeDiffs
          Map NameSegment (Diff Reference)
-> (Map NameSegment (Diff Reference)
    -> ([(Name, Reference)], [(Name, Reference)]))
-> ([(Name, Reference)], [(Name, Reference)])
forall a b. a -> (a -> b) -> b
& (NameSegment
 -> Diff Reference -> ([(Name, Reference)], [(Name, Reference)]))
-> Map NameSegment (Diff Reference)
-> ([(Name, Reference)], [(Name, Reference)])
forall m a.
Monoid m =>
(NameSegment -> a -> m) -> Map NameSegment a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap \NameSegment
ns Diff Reference
diff ->
            let name :: Name
name = NameSegment -> Name
appendName NameSegment
ns
             in (Name -> Set Reference -> [(Name, Reference)]
forall ref. Name -> Set ref -> [(Name, ref)]
listifyNames Name
name (Set Reference -> [(Name, Reference)])
-> Set Reference -> [(Name, Reference)]
forall a b. (a -> b) -> a -> b
$ Diff Reference -> Set Reference
forall a. Diff a -> Set a
adds Diff Reference
diff, Name -> Set Reference -> [(Name, Reference)]
forall ref. Name -> Set ref -> [(Name, ref)]
listifyNames Name
name (Set Reference -> [(Name, Reference)])
-> Set Reference -> [(Name, Reference)]
forall a b. (a -> b) -> a -> b
$ Diff Reference -> Set Reference
forall a. Diff a -> Set a
removals Diff Reference
diff)
  let nameChanges :: NameChanges
nameChanges = NameChanges {[(Name, Referent)]
$sel:termNameAdds:NameChanges :: [(Name, Referent)]
termNameAdds :: [(Name, Referent)]
termNameAdds, [(Name, Referent)]
$sel:termNameRemovals:NameChanges :: [(Name, Referent)]
termNameRemovals :: [(Name, Referent)]
termNameRemovals, [(Name, Reference)]
$sel:typeNameAdds:NameChanges :: [(Name, Reference)]
typeNameAdds :: [(Name, Reference)]
typeNameAdds, [(Name, Reference)]
$sel:typeNameRemovals:NameChanges :: [(Name, Reference)]
typeNameRemovals :: [(Name, Reference)]
typeNameRemovals}
  r
acc <-
    if NameChanges
nameChanges NameChanges -> NameChanges -> Bool
forall a. Eq a => a -> a -> Bool
== NameChanges
forall a. Monoid a => a
mempty
      then r -> m r
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
forall a. Monoid a => a
mempty
      else Maybe Name -> NameChanges -> m r
f Maybe Name
namePrefix NameChanges
nameChanges
  r
childAcc <-
    Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
children
      Map
  NameSegment
  (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
-> (Map
      NameSegment
      (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
    -> m r)
-> m r
forall a b. a -> (a -> b) -> b
& (NameSegment
 -> m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs) -> m r)
-> Map
     NameSegment
     (m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs))
-> m r
forall r (f :: * -> *) (t :: * -> *) i a.
(Monoid r, Applicative f, Foldable t, TraversableWithIndex i t) =>
(i -> a -> f r) -> t a -> f r
ifoldMapM
        ( \NameSegment
ns m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
mchildTree -> do
            Cofree (Compose (Map NameSegment) m) DefinitionDiffs
childTree <- m (Cofree (Compose (Map NameSegment) m) DefinitionDiffs)
mchildTree
            Maybe Name
-> TreeDiff m -> (Maybe Name -> NameChanges -> m r) -> m r
forall (m :: * -> *) r.
(Monad m, Monoid r) =>
Maybe Name
-> TreeDiff m -> (Maybe Name -> NameChanges -> m r) -> m r
streamNameChanges (Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ NameSegment -> Name
appendName NameSegment
ns) (Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
forall (m :: * -> *).
Cofree (Compose (Map NameSegment) m) DefinitionDiffs -> TreeDiff m
TreeDiff Cofree (Compose (Map NameSegment) m) DefinitionDiffs
childTree) Maybe Name -> NameChanges -> m r
f
        )
  r -> m r
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> m r) -> r -> m r
forall a b. (a -> b) -> a -> b
$! r
acc r -> r -> r
forall a. Semigroup a => a -> a -> a
<> r
childAcc
  where
    appendName :: NameSegment -> Name
    appendName :: NameSegment -> Name
appendName =
      case Maybe Name
namePrefix of
        Maybe Name
Nothing -> NameSegment -> Name
Name.fromSegment
        Just Name
prefix -> (Name
prefix Name -> NameSegment -> Name
forall s a. Snoc s s a a => s -> a -> s
Lens.|>)
    listifyNames :: (Name -> Set ref -> [(Name, ref)])
    listifyNames :: forall ref. Name -> Set ref -> [(Name, ref)]
listifyNames Name
name Set ref
xs =
      Set ref
xs
        Set ref -> (Set ref -> [ref]) -> [ref]
forall a b. a -> (a -> b) -> b
& Set ref -> [ref]
forall a. Set a -> [a]
Set.toList
        [ref] -> ([ref] -> [(Name, ref)]) -> [(Name, ref)]
forall a b. a -> (a -> b) -> b
& (ref -> (Name, ref)) -> [ref] -> [(Name, ref)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name
name,)