module Unison.Merge.Diffblob
  ( Diffblob (..),
    makeDiffblob,
    makeFastForwardDiffblob,
    DiffblobLog (..),
    emptyDiffblobLog,
    canonicalizeNamesForSynhashing,
  )
where

import Control.Lens.Fold (folded)
import Data.Char qualified as Char
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Set.Lens (setOf)
import Data.Text qualified as Text
import GHC.Base qualified as List.NonEmpty
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration.Dependencies qualified as Decl
import Unison.DeclNameLookup (DeclNameLookup)
import Unison.LabeledDependency (LabeledDependency)
import Unison.LabeledDependency qualified as LabeledDependency
import Unison.Merge.CombineDiffs (CombinedDiffOp, combineDiffs)
import Unison.Merge.Diff (diffSynhashedDefns, diffSynhashedDefns1)
import Unison.Merge.DiffOp (DiffOp)
import Unison.Merge.Libdeps (applyLibdepsDiff, diffLibdeps, diffLibdeps1, getTwoFreshLibdepNames, mergeLibdepsDiffs)
import Unison.Merge.Narrow (narrowDefns, narrowDefnsTotal)
import Unison.Merge.PartitionCombinedDiffs (assumeUnconflicts, partitionCombinedDiffs)
import Unison.Merge.Rename (Rename, SimpleRenames (..), makeRenames, makeSimpleRenames)
import Unison.Merge.Synhash (synhashDefns, synhashLcaDefns)
import Unison.Merge.Synhashed (Synhashed)
import Unison.Merge.ThreeWay (GThreeWay (..), ThreeWay (..))
import Unison.Merge.ThreeWay qualified as ThreeWay
import Unison.Merge.TwoWay (TwoWay (..))
import Unison.Merge.TwoWay qualified as TwoWay
import Unison.Merge.Unconflicts (Unconflicts)
import Unison.Merge.Updated (GUpdated (..), Updated)
import Unison.Merge.Updated qualified as Updated
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.NameSegment qualified as NameSegment
import Unison.NameSegment.Internal qualified as NameSegment
import Unison.Names (Names (..))
import Unison.NamesUtils qualified as NamesUtils
import Unison.Parser.Ann (Ann)
import Unison.PartialDeclNameLookup (PartialDeclNameLookup)
import Unison.PartialDeclNameLookup qualified as PartialDeclNameLookup
import Unison.Prelude
import Unison.PrettyPrintEnv (PrettyPrintEnv)
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl)
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Symbol (Symbol)
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.UnconflictedLocalDefnsView (UnconflictedLocalDefnsView (..))
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, zipDefnsWith)
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as Relation

data Diffblob libdep = Diffblob
  { forall libdep.
Diffblob libdep
-> TwoWay (DefnsF (Map Name) TypeReference TypeReference)
conflicts :: TwoWay (DefnsF (Map Name) TermReference TypeReference),
    forall libdep.
Diffblob libdep -> GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups :: GThreeWay PartialDeclNameLookup DeclNameLookup,
    forall libdep.
Diffblob libdep -> ThreeWay UnconflictedLocalDefnsView
defns :: ThreeWay UnconflictedLocalDefnsView,
    forall libdep.
Diffblob libdep
-> ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
defnsIds :: ThreeWay (DefnsF Set TermReferenceId TypeReferenceId),
    forall libdep.
Diffblob libdep
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference,
    forall libdep.
Diffblob libdep
-> TwoWay
     (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
diffsFromLCA :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
    -- Hydrated narrowed definitions. These are not necessarily all of the definitions needed for actually rendering
    -- a file, e.g. it doesn't contain dependents. It's included here because we did some work to hydrate these, and if
    -- we need to hydrate more *later*, we ought to look in this map first (to save duplicate work).
    forall libdep.
Diffblob libdep
-> Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
hydratedNarrowedDefns ::
      Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TypeReferenceId (Decl Symbol Ann)),
    forall libdep. Diffblob libdep -> Updated (Map NameSegment libdep)
libdeps :: Updated (Map NameSegment libdep),
    forall libdep.
Diffblob libdep -> TwoWay (Map NameSegment (DiffOp libdep))
libdepsDiffs :: TwoWay (Map NameSegment (DiffOp libdep)),
    forall libdep.
Diffblob libdep
-> TwoWay
     (DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
propagatedUpdates :: TwoWay (DefnsF (Map Name) (Updated Referent) (Updated TypeReference)),
    forall libdep.
Diffblob libdep -> TwoWay (Defns SimpleRenames SimpleRenames)
simpleRenames :: TwoWay (Defns SimpleRenames SimpleRenames),
    forall libdep.
Diffblob libdep -> DefnsF Unconflicts Referent TypeReference
unconflicts :: DefnsF Unconflicts Referent TypeReference
  }

data DiffblobLog m = DiffblobLog
  { forall (m :: * -> *).
DiffblobLog m
-> ThreeWay (DefnsF (Map Name) Referent TypeReference) -> m ()
logDefns :: ThreeWay (DefnsF (Map Name) Referent TypeReference) -> m (),
    forall (m :: * -> *).
DiffblobLog m
-> TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
-> m ()
logNarrowedDefns :: TwoWay (Updated (DefnsF (Map Name) Referent TypeReference)) -> m (),
    forall (m :: * -> *).
DiffblobLog m
-> TwoWay
     (GUpdated
        (DefnsF2 (Map Name) Synhashed Referent TypeReference)
        (DefnsF2 (Map Name) Synhashed Referent TypeReference))
-> m ()
logSynhashedNarrowedDefns ::
      TwoWay
        ( GUpdated
            (DefnsF2 (Map Name) Synhashed Referent TypeReference)
            (DefnsF2 (Map Name) Synhashed Referent TypeReference)
        ) ->
      m (),
    forall (m :: * -> *).
DiffblobLog m
-> TwoWay
     (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> m ()
logDiffsFromLCA :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) -> m (),
    forall (m :: * -> *).
DiffblobLog m
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> m ()
logDiff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> m ()
  }

emptyDiffblobLog :: (Applicative m) => DiffblobLog m
emptyDiffblobLog :: forall (m :: * -> *). Applicative m => DiffblobLog m
emptyDiffblobLog =
  let f :: p -> f ()
f p
_ = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () in (ThreeWay (DefnsF (Map Name) Referent TypeReference) -> m ())
-> (TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
    -> m ())
-> (TwoWay
      (GUpdated
         (DefnsF2 (Map Name) Synhashed Referent TypeReference)
         (DefnsF2 (Map Name) Synhashed Referent TypeReference))
    -> m ())
-> (TwoWay
      (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
    -> m ())
-> (DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
    -> m ())
-> DiffblobLog m
forall (m :: * -> *).
(ThreeWay (DefnsF (Map Name) Referent TypeReference) -> m ())
-> (TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
    -> m ())
-> (TwoWay
      (GUpdated
         (DefnsF2 (Map Name) Synhashed Referent TypeReference)
         (DefnsF2 (Map Name) Synhashed Referent TypeReference))
    -> m ())
-> (TwoWay
      (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
    -> m ())
-> (DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
    -> m ())
-> DiffblobLog m
DiffblobLog ThreeWay (DefnsF (Map Name) Referent TypeReference) -> m ()
forall {f :: * -> *} {p}. Applicative f => p -> f ()
f TwoWay (Updated (DefnsF (Map Name) Referent TypeReference)) -> m ()
forall {f :: * -> *} {p}. Applicative f => p -> f ()
f TwoWay
  (GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference))
-> m ()
forall {f :: * -> *} {p}. Applicative f => p -> f ()
f TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> m ()
forall {f :: * -> *} {p}. Applicative f => p -> f ()
f DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> m ()
forall {f :: * -> *} {p}. Applicative f => p -> f ()
f

makeDiffblob ::
  forall libdep m.
  (Eq libdep, Monad m) =>
  DiffblobLog m ->
  ( ThreeWay (DefnsF Set TermReferenceId TypeReferenceId) ->
    m
      ( Defns
          (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
          (Map TypeReferenceId (Decl Symbol Ann))
      )
  ) ->
  (ThreeWay (Set LabeledDependency) -> m (ThreeWay Names)) ->
  ThreeWay UnconflictedLocalDefnsView ->
  ThreeWay (Map NameSegment libdep) ->
  GThreeWay PartialDeclNameLookup DeclNameLookup ->
  m (Diffblob libdep)
makeDiffblob :: forall libdep (m :: * -> *).
(Eq libdep, Monad m) =>
DiffblobLog m
-> (ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
    -> m (Defns
            (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
            (Map TermReferenceId (Decl Symbol Ann))))
-> (ThreeWay (Set LabeledDependency) -> m (ThreeWay Names))
-> ThreeWay UnconflictedLocalDefnsView
-> ThreeWay (Map NameSegment libdep)
-> GThreeWay PartialDeclNameLookup DeclNameLookup
-> m (Diffblob libdep)
makeDiffblob DiffblobLog m
logger ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
-> m (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
hydrate ThreeWay (Set LabeledDependency) -> m (ThreeWay Names)
loadNames ThreeWay UnconflictedLocalDefnsView
defns ThreeWay (Map NameSegment libdep)
libdeps GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups = do
  let defnsByName :: ThreeWay (DefnsF (Map Name) Referent TypeReference)
defnsByName = Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF (Map Name) Referent TypeReference
forall terms name types.
Defns (BiMultimap terms name) (BiMultimap types name)
-> DefnsF (Map name) terms types
NamesUtils.byName (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
 -> DefnsF (Map Name) Referent TypeReference)
-> (UnconflictedLocalDefnsView
    -> Defns
         (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> UnconflictedLocalDefnsView
-> DefnsF (Map Name) Referent TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.defns) (UnconflictedLocalDefnsView
 -> DefnsF (Map Name) Referent TypeReference)
-> ThreeWay UnconflictedLocalDefnsView
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay UnconflictedLocalDefnsView
defns

  DiffblobLog m
logger.logDefns ThreeWay (DefnsF (Map Name) Referent TypeReference)
defnsByName

  let defnsIds :: ThreeWay (DefnsF Set TermReferenceId TypeReferenceId)
      defnsIds :: ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
defnsIds =
        DefnsF (Map Name) Referent TypeReference
-> DefnsF Set TermReferenceId TermReferenceId
toIds (DefnsF (Map Name) Referent TypeReference
 -> DefnsF Set TermReferenceId TermReferenceId)
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
-> ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay (DefnsF (Map Name) Referent TypeReference)
defnsByName

  -- Narrow definitions to those that could have different syntactic hashes
  let narrowedDefns :: TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
narrowedDefns =
        HasCallStack =>
GThreeWay PartialDeclNameLookup DeclNameLookup
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
-> TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
GThreeWay PartialDeclNameLookup DeclNameLookup
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
-> TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
narrowDefns GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups ThreeWay (DefnsF (Map Name) Referent TypeReference)
defnsByName

  let narrowedDefns3 :: ThreeWay (DefnsF (Map Name) Referent TypeReference)
narrowedDefns3 =
        TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
forall a. Semigroup a => TwoWay (Updated a) -> ThreeWay a
TwoWay.updatedToThreeWay TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
narrowedDefns

  let narrowedDefnsIds3 :: ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
narrowedDefnsIds3 =
        DefnsF (Map Name) Referent TypeReference
-> DefnsF Set TermReferenceId TermReferenceId
toIds (DefnsF (Map Name) Referent TypeReference
 -> DefnsF Set TermReferenceId TermReferenceId)
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
-> ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay (DefnsF (Map Name) Referent TypeReference)
narrowedDefns3

  DiffblobLog m
logger.logNarrowedDefns TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
narrowedDefns

  -- Hydrate only the narrowed definitions
  Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedNarrowedDefns <-
    ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
-> m (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
hydrate ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
narrowedDefnsIds3

  -- Load the names of all dependencies hydrated definitions
  ThreeWay Names
dependencyNames <-
    let hydratedNarrowedDefnsList :: Defns
  [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
  [(TermReferenceId, Decl Symbol Ann)]
hydratedNarrowedDefnsList = (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)
 -> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))])
-> (Map TermReferenceId (Decl Symbol Ann)
    -> [(TermReferenceId, Decl Symbol Ann)])
-> Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> Defns
     [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
     [(TermReferenceId, Decl Symbol Ann)]
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)
-> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList Map TermReferenceId (Decl Symbol Ann)
-> [(TermReferenceId, Decl Symbol Ann)]
forall k a. Map k a -> [(k, a)]
Map.toList Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedNarrowedDefns
        f :: Set a -> [(a, b)] -> [(a, b)]
f Set a
refs = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (\(a
ref, b
_) -> a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
ref Set a
refs)
     in ThreeWay (Set LabeledDependency) -> m (ThreeWay Names)
loadNames (ThreeWay (Set LabeledDependency) -> m (ThreeWay Names))
-> ThreeWay (Set LabeledDependency) -> m (ThreeWay Names)
forall a b. (a -> b) -> a -> b
$
          (\DefnsF Set TermReferenceId TermReferenceId
defns -> Defns
  [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
  [(TermReferenceId, Decl Symbol Ann)]
-> Set LabeledDependency
forall (f :: * -> *).
Foldable f =>
DefnsF
  f
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
-> Set LabeledDependency
toLabeledDependencies ((Set TermReferenceId
 -> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
 -> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))])
-> (Set TermReferenceId
    -> [(TermReferenceId, Decl Symbol Ann)]
    -> [(TermReferenceId, Decl Symbol Ann)])
-> DefnsF Set TermReferenceId TermReferenceId
-> Defns
     [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
     [(TermReferenceId, Decl Symbol Ann)]
-> Defns
     [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
     [(TermReferenceId, Decl Symbol Ann)]
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith Set TermReferenceId
-> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
-> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
forall {a} {b}. Ord a => Set a -> [(a, b)] -> [(a, b)]
f Set TermReferenceId
-> [(TermReferenceId, Decl Symbol Ann)]
-> [(TermReferenceId, Decl Symbol Ann)]
forall {a} {b}. Ord a => Set a -> [(a, b)] -> [(a, b)]
f DefnsF Set TermReferenceId TermReferenceId
defns Defns
  [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
  [(TermReferenceId, Decl Symbol Ann)]
hydratedNarrowedDefnsList))
            (DefnsF Set TermReferenceId TermReferenceId
 -> Set LabeledDependency)
-> ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
-> ThreeWay (Set LabeledDependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
narrowedDefnsIds3

  -- Compute the syntactic hashes of the narrowed+hydrated definitions
  let synhashedNarrowedDefns :: TwoWay (Updated (DefnsF2 (Map Name) Synhashed Referent TypeReference))
      synhashedNarrowedDefns :: TwoWay
  (GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference))
synhashedNarrowedDefns =
        ((Term Symbol Ann, Type Symbol Ann) -> Term Symbol Ann)
-> ThreeWay Names
-> GThreeWay PartialDeclNameLookup DeclNameLookup
-> TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
-> Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> TwoWay
     (GUpdated
        (DefnsF2 (Map Name) Synhashed Referent TypeReference)
        (DefnsF2 (Map Name) Synhashed Referent TypeReference))
forall term.
(term -> Term Symbol Ann)
-> ThreeWay Names
-> GThreeWay PartialDeclNameLookup DeclNameLookup
-> TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> TwoWay
     (GUpdated
        (DefnsF2 (Map Name) Synhashed Referent TypeReference)
        (DefnsF2 (Map Name) Synhashed Referent TypeReference))
makeSynhashedNarrowedDefns
          (Term Symbol Ann, Type Symbol Ann) -> Term Symbol Ann
forall a b. (a, b) -> a
fst
          ThreeWay Names
dependencyNames
          GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups
          TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
narrowedDefns
          Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedNarrowedDefns

  DiffblobLog m
logger.logSynhashedNarrowedDefns TwoWay
  (GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference))
synhashedNarrowedDefns

  -- Identify all renames
  let renames :: TwoWay (DefnsF [] Rename Rename)
renames =
        Updated
  (Defns
     (BiMultimap (Synhashed Referent) Name)
     (BiMultimap (Synhashed TypeReference) Name))
-> DefnsF [] Rename Rename
makeRenames (Updated
   (Defns
      (BiMultimap (Synhashed Referent) Name)
      (BiMultimap (Synhashed TypeReference) Name))
 -> DefnsF [] Rename Rename)
-> (GUpdated
      (DefnsF2 (Map Name) Synhashed Referent TypeReference)
      (DefnsF2 (Map Name) Synhashed Referent TypeReference)
    -> Updated
         (Defns
            (BiMultimap (Synhashed Referent) Name)
            (BiMultimap (Synhashed TypeReference) Name)))
-> GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> DefnsF [] Rename Rename
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DefnsF2 (Map Name) Synhashed Referent TypeReference
 -> Defns
      (BiMultimap (Synhashed Referent) Name)
      (BiMultimap (Synhashed TypeReference) Name))
-> GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> Updated
     (Defns
        (BiMultimap (Synhashed Referent) Name)
        (BiMultimap (Synhashed TypeReference) Name))
forall a b. (a -> b) -> Updated a -> Updated b
Updated.map ((Map Name (Synhashed Referent)
 -> BiMultimap (Synhashed Referent) Name)
-> (Map Name (Synhashed TypeReference)
    -> BiMultimap (Synhashed TypeReference) Name)
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
-> Defns
     (BiMultimap (Synhashed Referent) Name)
     (BiMultimap (Synhashed TypeReference) Name)
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Map Name (Synhashed Referent)
-> BiMultimap (Synhashed Referent) Name
forall a b. (Ord a, Ord b) => Map b a -> BiMultimap a b
BiMultimap.fromRange Map Name (Synhashed TypeReference)
-> BiMultimap (Synhashed TypeReference) Name
forall a b. (Ord a, Ord b) => Map b a -> BiMultimap a b
BiMultimap.fromRange) (GUpdated
   (DefnsF2 (Map Name) Synhashed Referent TypeReference)
   (DefnsF2 (Map Name) Synhashed Referent TypeReference)
 -> DefnsF [] Rename Rename)
-> TwoWay
     (GUpdated
        (DefnsF2 (Map Name) Synhashed Referent TypeReference)
        (DefnsF2 (Map Name) Synhashed Referent TypeReference))
-> TwoWay (DefnsF [] Rename Rename)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay
  (GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference))
synhashedNarrowedDefns

  -- Filter all renames down to just "simple" renames
  let simpleRenames :: TwoWay (Defns SimpleRenames SimpleRenames)
simpleRenames =
        DefnsF [] Rename Rename -> Defns SimpleRenames SimpleRenames
makeSimpleRenames (DefnsF [] Rename Rename -> Defns SimpleRenames SimpleRenames)
-> TwoWay (DefnsF [] Rename Rename)
-> TwoWay (Defns SimpleRenames SimpleRenames)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF [] Rename Rename)
renames

  -- Diff LCA->Alice and LCA->Bob
  let (TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
diffsFromLCA, TwoWay
  (DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
propagatedUpdates) =
        TwoWay
  (GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference))
-> (TwoWay
      (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
    TwoWay
      (DefnsF (Map Name) (Updated Referent) (Updated TypeReference)))
forall term typ.
(Eq term, Eq typ) =>
TwoWay (Updated (DefnsF2 (Map Name) Synhashed term typ))
-> (TwoWay (DefnsF3 (Map Name) DiffOp Synhashed term typ),
    TwoWay (DefnsF (Map Name) (Updated term) (Updated typ)))
diffSynhashedDefns TwoWay
  (GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference))
synhashedNarrowedDefns

  DiffblobLog m
logger.logDiffsFromLCA TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
diffsFromLCA

  -- Combine the LCA->Alice and LCA->Bob diffs together
  let diff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
      diff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff =
        TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
combineDiffs TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
diffsFromLCA

  DiffblobLog m
logger.logDiff DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff

  -- Partition the combined diff into the conflicted things and the unconflicted things
  let (TwoWay (DefnsF (Map Name) TypeReference TypeReference)
conflicts, DefnsF Unconflicts Referent TypeReference
unconflicts) =
        TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> TwoWay DeclNameLookup
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> (TwoWay (DefnsF (Map Name) TypeReference TypeReference),
    DefnsF Unconflicts Referent TypeReference)
partitionCombinedDiffs ((.defns) (UnconflictedLocalDefnsView
 -> Defns
      (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> TwoWay UnconflictedLocalDefnsView
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay UnconflictedLocalDefnsView
-> TwoWay UnconflictedLocalDefnsView
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca ThreeWay UnconflictedLocalDefnsView
defns) (GThreeWay PartialDeclNameLookup DeclNameLookup
-> TwoWay DeclNameLookup
forall a b. GThreeWay a b -> TwoWay b
ThreeWay.gforgetLca GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups) DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff

  -- Diff and merge libdeps
  let libdepsDiffs :: TwoWay (Map NameSegment (DiffOp libdep))
      libdepsDiffs :: TwoWay (Map NameSegment (DiffOp libdep))
libdepsDiffs =
        ThreeWay (Map NameSegment libdep)
-> TwoWay (Map NameSegment (DiffOp libdep))
forall k v.
(Ord k, Eq v) =>
ThreeWay (Map k v) -> TwoWay (Map k (DiffOp v))
diffLibdeps ThreeWay (Map NameSegment libdep)
libdeps

  let mergedLibdeps :: Map NameSegment libdep
      mergedLibdeps :: Map NameSegment libdep
mergedLibdeps =
        (Set NameSegment -> NameSegment -> (NameSegment, NameSegment))
-> ThreeWay (Map NameSegment libdep)
-> Map NameSegment (LibdepDiffOp libdep)
-> Map NameSegment libdep
forall k v.
Ord k =>
(Set k -> k -> (k, k))
-> ThreeWay (Map k v) -> Map k (LibdepDiffOp v) -> Map k v
applyLibdepsDiff
          Set NameSegment -> NameSegment -> (NameSegment, NameSegment)
getTwoFreshLibdepNames
          ThreeWay (Map NameSegment libdep)
libdeps
          (TwoWay (Map NameSegment (DiffOp libdep))
-> Map NameSegment (LibdepDiffOp libdep)
forall k v.
(Ord k, Eq v) =>
TwoWay (Map k (DiffOp v)) -> Map k (LibdepDiffOp v)
mergeLibdepsDiffs TwoWay (Map NameSegment (DiffOp libdep))
libdepsDiffs)

  pure
    Diffblob
      { TwoWay (DefnsF (Map Name) TypeReference TypeReference)
$sel:conflicts:Diffblob :: TwoWay (DefnsF (Map Name) TypeReference TypeReference)
conflicts :: TwoWay (DefnsF (Map Name) TypeReference TypeReference)
conflicts,
        GThreeWay PartialDeclNameLookup DeclNameLookup
$sel:declNameLookups:Diffblob :: GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups :: GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups,
        ThreeWay UnconflictedLocalDefnsView
$sel:defns:Diffblob :: ThreeWay UnconflictedLocalDefnsView
defns :: ThreeWay UnconflictedLocalDefnsView
defns,
        ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
$sel:defnsIds:Diffblob :: ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
defnsIds :: ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
defnsIds,
        DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
$sel:diff:Diffblob :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff,
        TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
$sel:diffsFromLCA:Diffblob :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
diffsFromLCA :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
diffsFromLCA,
        $sel:libdeps:Diffblob :: Updated (Map NameSegment libdep)
libdeps = Updated {$sel:old:Updated :: Map NameSegment libdep
old = ThreeWay (Map NameSegment libdep)
libdeps.lca, $sel:new:Updated :: Map NameSegment libdep
new = Map NameSegment libdep
mergedLibdeps},
        TwoWay (Map NameSegment (DiffOp libdep))
$sel:libdepsDiffs:Diffblob :: TwoWay (Map NameSegment (DiffOp libdep))
libdepsDiffs :: TwoWay (Map NameSegment (DiffOp libdep))
libdepsDiffs,
        Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
$sel:hydratedNarrowedDefns:Diffblob :: Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedNarrowedDefns :: Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedNarrowedDefns,
        TwoWay
  (DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
$sel:propagatedUpdates:Diffblob :: TwoWay
  (DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
propagatedUpdates :: TwoWay
  (DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
propagatedUpdates,
        TwoWay (Defns SimpleRenames SimpleRenames)
$sel:simpleRenames:Diffblob :: TwoWay (Defns SimpleRenames SimpleRenames)
simpleRenames :: TwoWay (Defns SimpleRenames SimpleRenames)
simpleRenames,
        DefnsF Unconflicts Referent TypeReference
$sel:unconflicts:Diffblob :: DefnsF Unconflicts Referent TypeReference
unconflicts :: DefnsF Unconflicts Referent TypeReference
unconflicts
      }

-- | Like 'makeDiffblob', but for a fast forward, and when the LCA is known not to have any type declarations with
-- missing constructor names.
makeFastForwardDiffblob ::
  forall libdep m.
  (Eq libdep, Monad m) =>
  ( Updated (DefnsF Set TermReferenceId TypeReferenceId) ->
    m
      ( Defns
          (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
          (Map TypeReferenceId (Decl Symbol Ann))
      )
  ) ->
  (Updated (Set LabeledDependency) -> m (Updated Names)) ->
  Updated UnconflictedLocalDefnsView ->
  Updated (Map NameSegment libdep) ->
  Updated DeclNameLookup ->
  m (Diffblob libdep)
makeFastForwardDiffblob :: forall libdep (m :: * -> *).
(Eq libdep, Monad m) =>
(Updated (DefnsF Set TermReferenceId TermReferenceId)
 -> m (Defns
         (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
         (Map TermReferenceId (Decl Symbol Ann))))
-> (Updated (Set LabeledDependency) -> m (Updated Names))
-> Updated UnconflictedLocalDefnsView
-> Updated (Map NameSegment libdep)
-> Updated DeclNameLookup
-> m (Diffblob libdep)
makeFastForwardDiffblob Updated (DefnsF Set TermReferenceId TermReferenceId)
-> m (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
hydrate Updated (Set LabeledDependency) -> m (Updated Names)
loadNames Updated UnconflictedLocalDefnsView
defns Updated (Map NameSegment libdep)
libdeps Updated DeclNameLookup
declNameLookups = do
  let defnsByName :: Updated (DefnsF (Map Name) Referent TypeReference)
defnsByName = (UnconflictedLocalDefnsView
 -> DefnsF (Map Name) Referent TypeReference)
-> Updated UnconflictedLocalDefnsView
-> Updated (DefnsF (Map Name) Referent TypeReference)
forall a b. (a -> b) -> Updated a -> Updated b
Updated.map (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF (Map Name) Referent TypeReference
forall terms name types.
Defns (BiMultimap terms name) (BiMultimap types name)
-> DefnsF (Map name) terms types
NamesUtils.byName (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
 -> DefnsF (Map Name) Referent TypeReference)
-> (UnconflictedLocalDefnsView
    -> Defns
         (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> UnconflictedLocalDefnsView
-> DefnsF (Map Name) Referent TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.defns)) Updated UnconflictedLocalDefnsView
defns

  let defnsIds :: Updated (DefnsF Set TermReferenceId TypeReferenceId)
      defnsIds :: Updated (DefnsF Set TermReferenceId TermReferenceId)
defnsIds =
        (DefnsF (Map Name) Referent TypeReference
 -> DefnsF Set TermReferenceId TermReferenceId)
-> Updated (DefnsF (Map Name) Referent TypeReference)
-> Updated (DefnsF Set TermReferenceId TermReferenceId)
forall a b. (a -> b) -> Updated a -> Updated b
Updated.map DefnsF (Map Name) Referent TypeReference
-> DefnsF Set TermReferenceId TermReferenceId
toIds Updated (DefnsF (Map Name) Referent TypeReference)
defnsByName

  -- Narrow definitions to those that could have different syntactic hashes
  let narrowedDefns :: Updated (DefnsF (Map Name) Referent TypeReference)
      narrowedDefns :: Updated (DefnsF (Map Name) Referent TypeReference)
narrowedDefns =
        Updated DeclNameLookup
-> Updated (DefnsF (Map Name) Referent TypeReference)
-> Updated (DefnsF (Map Name) Referent TypeReference)
narrowDefnsTotal Updated DeclNameLookup
declNameLookups Updated (DefnsF (Map Name) Referent TypeReference)
defnsByName

  let narrowedDefnsIds :: Updated (DefnsF Set TermReferenceId TypeReferenceId)
      narrowedDefnsIds :: Updated (DefnsF Set TermReferenceId TermReferenceId)
narrowedDefnsIds =
        (DefnsF (Map Name) Referent TypeReference
 -> DefnsF Set TermReferenceId TermReferenceId)
-> Updated (DefnsF (Map Name) Referent TypeReference)
-> Updated (DefnsF Set TermReferenceId TermReferenceId)
forall a b. (a -> b) -> Updated a -> Updated b
Updated.map DefnsF (Map Name) Referent TypeReference
-> DefnsF Set TermReferenceId TermReferenceId
toIds Updated (DefnsF (Map Name) Referent TypeReference)
narrowedDefns

  -- Hydrate only the narrowed definitions
  Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedNarrowedDefns <-
    Updated (DefnsF Set TermReferenceId TermReferenceId)
-> m (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
hydrate Updated (DefnsF Set TermReferenceId TermReferenceId)
narrowedDefnsIds

  -- Load the names of all dependencies hydrated definitions
  Updated Names
dependencyNames <-
    let hydratedNarrowedDefnsList :: Defns
  [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
  [(TermReferenceId, Decl Symbol Ann)]
hydratedNarrowedDefnsList = (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)
 -> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))])
-> (Map TermReferenceId (Decl Symbol Ann)
    -> [(TermReferenceId, Decl Symbol Ann)])
-> Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> Defns
     [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
     [(TermReferenceId, Decl Symbol Ann)]
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)
-> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList Map TermReferenceId (Decl Symbol Ann)
-> [(TermReferenceId, Decl Symbol Ann)]
forall k a. Map k a -> [(k, a)]
Map.toList Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedNarrowedDefns
        f :: Set a -> [(a, b)] -> [(a, b)]
f Set a
refs = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (\(a
ref, b
_) -> a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
ref Set a
refs)
     in Updated (Set LabeledDependency) -> m (Updated Names)
loadNames (Updated (Set LabeledDependency) -> m (Updated Names))
-> Updated (Set LabeledDependency) -> m (Updated Names)
forall a b. (a -> b) -> a -> b
$
          (DefnsF Set TermReferenceId TermReferenceId
 -> Set LabeledDependency)
-> Updated (DefnsF Set TermReferenceId TermReferenceId)
-> Updated (Set LabeledDependency)
forall a b. (a -> b) -> Updated a -> Updated b
Updated.map
            (\DefnsF Set TermReferenceId TermReferenceId
defns -> Defns
  [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
  [(TermReferenceId, Decl Symbol Ann)]
-> Set LabeledDependency
forall (f :: * -> *).
Foldable f =>
DefnsF
  f
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
-> Set LabeledDependency
toLabeledDependencies ((Set TermReferenceId
 -> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
 -> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))])
-> (Set TermReferenceId
    -> [(TermReferenceId, Decl Symbol Ann)]
    -> [(TermReferenceId, Decl Symbol Ann)])
-> DefnsF Set TermReferenceId TermReferenceId
-> Defns
     [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
     [(TermReferenceId, Decl Symbol Ann)]
-> Defns
     [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
     [(TermReferenceId, Decl Symbol Ann)]
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith Set TermReferenceId
-> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
-> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
forall {a} {b}. Ord a => Set a -> [(a, b)] -> [(a, b)]
f Set TermReferenceId
-> [(TermReferenceId, Decl Symbol Ann)]
-> [(TermReferenceId, Decl Symbol Ann)]
forall {a} {b}. Ord a => Set a -> [(a, b)] -> [(a, b)]
f DefnsF Set TermReferenceId TermReferenceId
defns Defns
  [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
  [(TermReferenceId, Decl Symbol Ann)]
hydratedNarrowedDefnsList))
            Updated (DefnsF Set TermReferenceId TermReferenceId)
narrowedDefnsIds

  -- Compute the syntactic hashes of the narrowed+hydrated definitions
  let synhashedNarrowedDefns :: Updated (DefnsF2 (Map Name) Synhashed Referent TypeReference)
      synhashedNarrowedDefns :: GUpdated
  (DefnsF2 (Map Name) Synhashed Referent TypeReference)
  (DefnsF2 (Map Name) Synhashed Referent TypeReference)
synhashedNarrowedDefns =
        ((Term Symbol Ann, Type Symbol Ann) -> Term Symbol Ann)
-> Updated Names
-> Updated DeclNameLookup
-> Updated (DefnsF (Map Name) Referent TypeReference)
-> Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
forall term.
(term -> Term Symbol Ann)
-> Updated Names
-> Updated DeclNameLookup
-> Updated (DefnsF (Map Name) Referent TypeReference)
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
makeSynhashedNarrowedDefnsForFastForward
          (Term Symbol Ann, Type Symbol Ann) -> Term Symbol Ann
forall a b. (a, b) -> a
fst
          Updated Names
dependencyNames
          Updated DeclNameLookup
declNameLookups
          Updated (DefnsF (Map Name) Referent TypeReference)
narrowedDefns
          Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedNarrowedDefns

  -- logger.logSynhashedNarrowedDefns synhashedNarrowedDefns

  -- Identify all renames
  let renames :: DefnsF [] Rename Rename
      renames :: DefnsF [] Rename Rename
renames =
        Updated
  (Defns
     (BiMultimap (Synhashed Referent) Name)
     (BiMultimap (Synhashed TypeReference) Name))
-> DefnsF [] Rename Rename
makeRenames ((DefnsF2 (Map Name) Synhashed Referent TypeReference
 -> Defns
      (BiMultimap (Synhashed Referent) Name)
      (BiMultimap (Synhashed TypeReference) Name))
-> GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> Updated
     (Defns
        (BiMultimap (Synhashed Referent) Name)
        (BiMultimap (Synhashed TypeReference) Name))
forall a b. (a -> b) -> Updated a -> Updated b
Updated.map ((Map Name (Synhashed Referent)
 -> BiMultimap (Synhashed Referent) Name)
-> (Map Name (Synhashed TypeReference)
    -> BiMultimap (Synhashed TypeReference) Name)
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
-> Defns
     (BiMultimap (Synhashed Referent) Name)
     (BiMultimap (Synhashed TypeReference) Name)
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Map Name (Synhashed Referent)
-> BiMultimap (Synhashed Referent) Name
forall a b. (Ord a, Ord b) => Map b a -> BiMultimap a b
BiMultimap.fromRange Map Name (Synhashed TypeReference)
-> BiMultimap (Synhashed TypeReference) Name
forall a b. (Ord a, Ord b) => Map b a -> BiMultimap a b
BiMultimap.fromRange) GUpdated
  (DefnsF2 (Map Name) Synhashed Referent TypeReference)
  (DefnsF2 (Map Name) Synhashed Referent TypeReference)
synhashedNarrowedDefns)

  -- Filter all renames down to just "simple" renames
  let simpleRenames :: Defns SimpleRenames SimpleRenames
      simpleRenames :: Defns SimpleRenames SimpleRenames
simpleRenames =
        DefnsF [] Rename Rename -> Defns SimpleRenames SimpleRenames
makeSimpleRenames DefnsF [] Rename Rename
renames

  -- Diff Alice->Bob
  let (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
diffFromLCA, DefnsF (Map Name) (Updated Referent) (Updated TypeReference)
propagatedUpdates) =
        GUpdated
  (DefnsF2 (Map Name) Synhashed Referent TypeReference)
  (DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
    DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
forall term typ.
(Eq term, Eq typ) =>
Updated (DefnsF2 (Map Name) Synhashed term typ)
-> (DefnsF3 (Map Name) DiffOp Synhashed term typ,
    DefnsF (Map Name) (Updated term) (Updated typ))
diffSynhashedDefns1 GUpdated
  (DefnsF2 (Map Name) Synhashed Referent TypeReference)
  (DefnsF2 (Map Name) Synhashed Referent TypeReference)
synhashedNarrowedDefns

  -- logger.logDiffsFromLCA diffsFromLCA

  -- Combine the LCA->Alice and LCA->Bob diffs together
  let diff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
      diff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff =
        TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
combineDiffs
          TwoWay
            { $sel:alice:TwoWay :: DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
alice = Map Name (DiffOp (Synhashed Referent))
-> Map Name (DiffOp (Synhashed TypeReference))
-> DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
forall terms types. terms -> types -> Defns terms types
Defns Map Name (DiffOp (Synhashed Referent))
forall k a. Map k a
Map.empty Map Name (DiffOp (Synhashed TypeReference))
forall k a. Map k a
Map.empty,
              $sel:bob:TwoWay :: DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
bob = DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
diffFromLCA
            }

  -- logger.logDiff diff

  -- View the combined diff as unconflicted things
  let unconflicts :: DefnsF Unconflicts Referent TypeReference
unconflicts =
        DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> DefnsF Unconflicts Referent TypeReference
assumeUnconflicts DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff

  -- Diff and merge libdeps
  let libdepsDiff :: Map NameSegment (DiffOp libdep)
      libdepsDiff :: Map NameSegment (DiffOp libdep)
libdepsDiff =
        Updated (Map NameSegment libdep) -> Map NameSegment (DiffOp libdep)
forall k v. (Ord k, Eq v) => Updated (Map k v) -> Map k (DiffOp v)
diffLibdeps1 Updated (Map NameSegment libdep)
libdeps

  let libdepsDiffs :: TwoWay (Map NameSegment (DiffOp libdep))
      libdepsDiffs :: TwoWay (Map NameSegment (DiffOp libdep))
libdepsDiffs =
        TwoWay
          { $sel:alice:TwoWay :: Map NameSegment (DiffOp libdep)
alice = Map NameSegment (DiffOp libdep)
forall k a. Map k a
Map.empty,
            $sel:bob:TwoWay :: Map NameSegment (DiffOp libdep)
bob = Map NameSegment (DiffOp libdep)
libdepsDiff
          }

  let mergedLibdeps :: Map NameSegment libdep
      mergedLibdeps :: Map NameSegment libdep
mergedLibdeps =
        (Set NameSegment -> NameSegment -> (NameSegment, NameSegment))
-> ThreeWay (Map NameSegment libdep)
-> Map NameSegment (LibdepDiffOp libdep)
-> Map NameSegment libdep
forall k v.
Ord k =>
(Set k -> k -> (k, k))
-> ThreeWay (Map k v) -> Map k (LibdepDiffOp v) -> Map k v
applyLibdepsDiff
          Set NameSegment -> NameSegment -> (NameSegment, NameSegment)
getTwoFreshLibdepNames
          ThreeWay
            { $sel:lca:ThreeWay :: Map NameSegment libdep
lca = Updated (Map NameSegment libdep)
libdeps.old,
              $sel:alice:ThreeWay :: Map NameSegment libdep
alice = Updated (Map NameSegment libdep)
libdeps.old,
              $sel:bob:ThreeWay :: Map NameSegment libdep
bob = Updated (Map NameSegment libdep)
libdeps.new
            }
          (TwoWay (Map NameSegment (DiffOp libdep))
-> Map NameSegment (LibdepDiffOp libdep)
forall k v.
(Ord k, Eq v) =>
TwoWay (Map k (DiffOp v)) -> Map k (LibdepDiffOp v)
mergeLibdepsDiffs TwoWay (Map NameSegment (DiffOp libdep))
libdepsDiffs)

  pure
    Diffblob
      { $sel:conflicts:Diffblob :: TwoWay (DefnsF (Map Name) TypeReference TypeReference)
conflicts = DefnsF (Map Name) TypeReference TypeReference
-> TwoWay (DefnsF (Map Name) TypeReference TypeReference)
forall a. a -> TwoWay a
TwoWay.bothWays (Map Name TypeReference
-> Map Name TypeReference
-> DefnsF (Map Name) TypeReference TypeReference
forall terms types. terms -> types -> Defns terms types
Defns Map Name TypeReference
forall k a. Map k a
Map.empty Map Name TypeReference
forall k a. Map k a
Map.empty),
        $sel:declNameLookups:Diffblob :: GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups =
          GThreeWay
            { $sel:lca:GThreeWay :: PartialDeclNameLookup
lca = DeclNameLookup -> PartialDeclNameLookup
PartialDeclNameLookup.fromDeclNameLookup Updated DeclNameLookup
declNameLookups.old,
              $sel:alice:GThreeWay :: DeclNameLookup
alice = Updated DeclNameLookup
declNameLookups.old,
              $sel:bob:GThreeWay :: DeclNameLookup
bob = Updated DeclNameLookup
declNameLookups.new
            },
        $sel:defns:Diffblob :: ThreeWay UnconflictedLocalDefnsView
defns = Updated UnconflictedLocalDefnsView
-> ThreeWay UnconflictedLocalDefnsView
forall a. Updated a -> ThreeWay a
updatedToThreeWay Updated UnconflictedLocalDefnsView
defns,
        $sel:defnsIds:Diffblob :: ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
defnsIds = Updated (DefnsF Set TermReferenceId TermReferenceId)
-> ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
forall a. Updated a -> ThreeWay a
updatedToThreeWay Updated (DefnsF Set TermReferenceId TermReferenceId)
defnsIds,
        DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
$sel:diff:Diffblob :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff,
        $sel:diffsFromLCA:Diffblob :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
diffsFromLCA =
          TwoWay
            { $sel:alice:TwoWay :: DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
alice = Map Name (DiffOp (Synhashed Referent))
-> Map Name (DiffOp (Synhashed TypeReference))
-> DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
forall terms types. terms -> types -> Defns terms types
Defns Map Name (DiffOp (Synhashed Referent))
forall k a. Map k a
Map.empty Map Name (DiffOp (Synhashed TypeReference))
forall k a. Map k a
Map.empty,
              $sel:bob:TwoWay :: DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
bob = DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
diffFromLCA
            },
        $sel:libdeps:Diffblob :: Updated (Map NameSegment libdep)
libdeps = Updated {$sel:old:Updated :: Map NameSegment libdep
old = Updated (Map NameSegment libdep)
libdeps.old, $sel:new:Updated :: Map NameSegment libdep
new = Map NameSegment libdep
mergedLibdeps},
        TwoWay (Map NameSegment (DiffOp libdep))
$sel:libdepsDiffs:Diffblob :: TwoWay (Map NameSegment (DiffOp libdep))
libdepsDiffs :: TwoWay (Map NameSegment (DiffOp libdep))
libdepsDiffs,
        Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
$sel:hydratedNarrowedDefns:Diffblob :: Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedNarrowedDefns :: Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedNarrowedDefns,
        $sel:propagatedUpdates:Diffblob :: TwoWay
  (DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
propagatedUpdates =
          TwoWay
            { $sel:alice:TwoWay :: DefnsF (Map Name) (Updated Referent) (Updated TypeReference)
alice = Map Name (Updated Referent)
-> Map Name (Updated TypeReference)
-> DefnsF (Map Name) (Updated Referent) (Updated TypeReference)
forall terms types. terms -> types -> Defns terms types
Defns Map Name (Updated Referent)
forall k a. Map k a
Map.empty Map Name (Updated TypeReference)
forall k a. Map k a
Map.empty,
              $sel:bob:TwoWay :: DefnsF (Map Name) (Updated Referent) (Updated TypeReference)
bob = DefnsF (Map Name) (Updated Referent) (Updated TypeReference)
propagatedUpdates
            },
        $sel:simpleRenames:Diffblob :: TwoWay (Defns SimpleRenames SimpleRenames)
simpleRenames =
          TwoWay
            { $sel:alice:TwoWay :: Defns SimpleRenames SimpleRenames
alice =
                SimpleRenames -> SimpleRenames -> Defns SimpleRenames SimpleRenames
forall terms types. terms -> types -> Defns terms types
Defns
                  (Map Name Name -> Map Name Name -> SimpleRenames
SimpleRenames Map Name Name
forall k a. Map k a
Map.empty Map Name Name
forall k a. Map k a
Map.empty)
                  (Map Name Name -> Map Name Name -> SimpleRenames
SimpleRenames Map Name Name
forall k a. Map k a
Map.empty Map Name Name
forall k a. Map k a
Map.empty),
              $sel:bob:TwoWay :: Defns SimpleRenames SimpleRenames
bob = Defns SimpleRenames SimpleRenames
simpleRenames
            },
        DefnsF Unconflicts Referent TypeReference
$sel:unconflicts:Diffblob :: DefnsF Unconflicts Referent TypeReference
unconflicts :: DefnsF Unconflicts Referent TypeReference
unconflicts
      }
  where
    -- View update as Alice+Bob (where LCA = Alice)
    updatedToThreeWay :: Updated a -> ThreeWay a
    updatedToThreeWay :: forall a. Updated a -> ThreeWay a
updatedToThreeWay Updated {a
$sel:old:Updated :: forall a b. GUpdated a b -> a
old :: a
old, a
$sel:new:Updated :: forall a b. GUpdated a b -> b
new :: a
new} =
      ThreeWay {$sel:lca:ThreeWay :: a
lca = a
old, $sel:alice:ThreeWay :: a
alice = a
old, $sel:bob:ThreeWay :: a
bob = a
new}

toIds :: DefnsF (Map Name) Referent TypeReference -> DefnsF Set TermReferenceId TypeReferenceId
toIds :: DefnsF (Map Name) Referent TypeReference
-> DefnsF Set TermReferenceId TermReferenceId
toIds =
  (Map Name Referent -> Set TermReferenceId)
-> (Map Name TypeReference -> Set TermReferenceId)
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF Set TermReferenceId TermReferenceId
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
    (Getting (Set TermReferenceId) (Map Name Referent) TermReferenceId
-> Map Name Referent -> Set TermReferenceId
forall a s. Getting (Set a) s a -> s -> Set a
setOf (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded @(Map Name) ((Referent -> Const (Set TermReferenceId) Referent)
 -> Map Name Referent
 -> Const (Set TermReferenceId) (Map Name Referent))
-> ((TermReferenceId
     -> Const (Set TermReferenceId) TermReferenceId)
    -> Referent -> Const (Set TermReferenceId) Referent)
-> Getting
     (Set TermReferenceId) (Map Name Referent) TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReference -> Const (Set TermReferenceId) TypeReference)
-> Referent -> Const (Set TermReferenceId) Referent
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p r (f r) -> p (Referent' r) (f (Referent' r))
Referent.termReference_ ((TypeReference -> Const (Set TermReferenceId) TypeReference)
 -> Referent -> Const (Set TermReferenceId) Referent)
-> ((TermReferenceId
     -> Const (Set TermReferenceId) TermReferenceId)
    -> TypeReference -> Const (Set TermReferenceId) TypeReference)
-> (TermReferenceId -> Const (Set TermReferenceId) TermReferenceId)
-> Referent
-> Const (Set TermReferenceId) Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TermReferenceId -> Const (Set TermReferenceId) TermReferenceId)
-> TypeReference -> Const (Set TermReferenceId) TypeReference
Prism' TypeReference TermReferenceId
Reference._DerivedId))
    (Getting
  (Set TermReferenceId) (Map Name TypeReference) TermReferenceId
-> Map Name TypeReference -> Set TermReferenceId
forall a s. Getting (Set a) s a -> s -> Set a
setOf (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded @(Map Name) ((TypeReference -> Const (Set TermReferenceId) TypeReference)
 -> Map Name TypeReference
 -> Const (Set TermReferenceId) (Map Name TypeReference))
-> ((TermReferenceId
     -> Const (Set TermReferenceId) TermReferenceId)
    -> TypeReference -> Const (Set TermReferenceId) TypeReference)
-> Getting
     (Set TermReferenceId) (Map Name TypeReference) TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TermReferenceId -> Const (Set TermReferenceId) TermReferenceId)
-> TypeReference -> Const (Set TermReferenceId) TypeReference
Prism' TypeReference TermReferenceId
Reference._DerivedId))

makeSynhashedNarrowedDefns ::
  (term -> Term Symbol Ann) ->
  ThreeWay Names ->
  GThreeWay PartialDeclNameLookup DeclNameLookup ->
  TwoWay (Updated (DefnsF (Map Name) Referent TypeReference)) ->
  Defns (Map TermReferenceId term) (Map TypeReferenceId (Decl Symbol Ann)) ->
  TwoWay (GUpdated (DefnsF2 (Map Name) Synhashed Referent TypeReference) (DefnsF2 (Map Name) Synhashed Referent TypeReference))
makeSynhashedNarrowedDefns :: forall term.
(term -> Term Symbol Ann)
-> ThreeWay Names
-> GThreeWay PartialDeclNameLookup DeclNameLookup
-> TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> TwoWay
     (GUpdated
        (DefnsF2 (Map Name) Synhashed Referent TypeReference)
        (DefnsF2 (Map Name) Synhashed Referent TypeReference))
makeSynhashedNarrowedDefns term -> Term Symbol Ann
toTerm ThreeWay Names
allNames GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
defns Defns
  (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns =
  DefnsF2 (Map Name) Synhashed Referent TypeReference
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
-> GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
forall a b. a -> b -> GUpdated a b
Updated
    (DefnsF2 (Map Name) Synhashed Referent TypeReference
 -> DefnsF2 (Map Name) Synhashed Referent TypeReference
 -> GUpdated
      (DefnsF2 (Map Name) Synhashed Referent TypeReference)
      (DefnsF2 (Map Name) Synhashed Referent TypeReference))
-> TwoWay (DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> TwoWay
     (DefnsF2 (Map Name) Synhashed Referent TypeReference
      -> GUpdated
           (DefnsF2 (Map Name) Synhashed Referent TypeReference)
           (DefnsF2 (Map Name) Synhashed Referent TypeReference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (Map Name (Synhashed Referent)
 -> Map Name Referent -> Map Name (Synhashed Referent))
-> (Map Name (Synhashed TypeReference)
    -> Map Name TypeReference -> Map Name (Synhashed TypeReference))
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith
            Map Name (Synhashed Referent)
-> Map Name Referent -> Map Name (Synhashed Referent)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection
            Map Name (Synhashed TypeReference)
-> Map Name TypeReference -> Map Name (Synhashed TypeReference)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection
            ( (term -> Term Symbol Ann)
-> PrettyPrintEnv
-> PartialDeclNameLookup
-> DefnsF (Map Name) Referent TypeReference
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
forall term.
HasCallStack =>
(term -> Term Symbol Ann)
-> PrettyPrintEnv
-> PartialDeclNameLookup
-> DefnsF (Map Name) Referent TypeReference
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashLcaDefns
                term -> Term Symbol Ann
toTerm
                PrettyPrintEnv
ppe
                GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups.lca
                (TwoWay (DefnsF (Map Name) Referent TypeReference)
-> DefnsF (Map Name) Referent TypeReference
forall m. Monoid m => TwoWay m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold TwoWay (DefnsF (Map Name) Referent TypeReference)
oldDefns) -- left-biased map union is fine, the maps have equal values at equal keys
                Defns
  (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns
            )
            (DefnsF (Map Name) Referent TypeReference
 -> DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> TwoWay (DefnsF (Map Name) Referent TypeReference)
-> TwoWay (DefnsF2 (Map Name) Synhashed Referent TypeReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF (Map Name) Referent TypeReference)
oldDefns
        )
    TwoWay
  (DefnsF2 (Map Name) Synhashed Referent TypeReference
   -> GUpdated
        (DefnsF2 (Map Name) Synhashed Referent TypeReference)
        (DefnsF2 (Map Name) Synhashed Referent TypeReference))
-> TwoWay (DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> TwoWay
     (GUpdated
        (DefnsF2 (Map Name) Synhashed Referent TypeReference)
        (DefnsF2 (Map Name) Synhashed Referent TypeReference))
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (term -> Term Symbol Ann)
-> PrettyPrintEnv
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> DeclNameLookup
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
forall term.
HasCallStack =>
(term -> Term Symbol Ann)
-> PrettyPrintEnv
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> DeclNameLookup
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashDefns term -> Term Symbol Ann
toTerm PrettyPrintEnv
ppe Defns
  (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns
            (DeclNameLookup
 -> DefnsF (Map Name) Referent TypeReference
 -> DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> TwoWay DeclNameLookup
-> TwoWay
     (DefnsF (Map Name) Referent TypeReference
      -> DefnsF2 (Map Name) Synhashed Referent TypeReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GThreeWay PartialDeclNameLookup DeclNameLookup
-> TwoWay DeclNameLookup
forall a b. GThreeWay a b -> TwoWay b
ThreeWay.gforgetLca GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups
            TwoWay
  (DefnsF (Map Name) Referent TypeReference
   -> DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> TwoWay (DefnsF (Map Name) Referent TypeReference)
-> TwoWay (DefnsF2 (Map Name) Synhashed Referent TypeReference)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoWay (DefnsF (Map Name) Referent TypeReference)
newDefns
        )
  where
    oldDefns :: TwoWay (DefnsF (Map Name) Referent TypeReference)
oldDefns = (.old) (Updated (DefnsF (Map Name) Referent TypeReference)
 -> DefnsF (Map Name) Referent TypeReference)
-> TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
-> TwoWay (DefnsF (Map Name) Referent TypeReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
defns
    newDefns :: TwoWay (DefnsF (Map Name) Referent TypeReference)
newDefns = (.new) (Updated (DefnsF (Map Name) Referent TypeReference)
 -> DefnsF (Map Name) Referent TypeReference)
-> TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
-> TwoWay (DefnsF (Map Name) Referent TypeReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Updated (DefnsF (Map Name) Referent TypeReference))
defns

    ppeds :: ThreeWay PrettyPrintEnvDecl
    ppeds :: ThreeWay PrettyPrintEnvDecl
ppeds =
      ThreeWay Names
allNames ThreeWay Names
-> (Names -> PrettyPrintEnvDecl) -> ThreeWay PrettyPrintEnvDecl
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Names
names ->
        let names1 :: Names
names1 = Names -> Names
canonicalizeNamesForSynhashing Names
names
         in Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Names -> Namer
PPE.namer Names
names1) (Names -> Suffixifier
PPE.suffixifyByHash Names
names1)

    ppe :: PrettyPrintEnv
    ppe :: PrettyPrintEnv
ppe =
      ThreeWay PrettyPrintEnvDecl
ppeds.alice.unsuffixifiedPPE
        PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
`PPE.addFallback` ThreeWay PrettyPrintEnvDecl
ppeds.bob.unsuffixifiedPPE
        PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
`PPE.addFallback` ThreeWay PrettyPrintEnvDecl
ppeds.lca.unsuffixifiedPPE

makeSynhashedNarrowedDefnsForFastForward ::
  (term -> Term Symbol Ann) ->
  Updated Names ->
  Updated DeclNameLookup ->
  Updated (DefnsF (Map Name) Referent TypeReference) ->
  Defns (Map TermReferenceId term) (Map TypeReferenceId (Decl Symbol Ann)) ->
  GUpdated (DefnsF2 (Map Name) Synhashed Referent TypeReference) (DefnsF2 (Map Name) Synhashed Referent TypeReference)
makeSynhashedNarrowedDefnsForFastForward :: forall term.
(term -> Term Symbol Ann)
-> Updated Names
-> Updated DeclNameLookup
-> Updated (DefnsF (Map Name) Referent TypeReference)
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
makeSynhashedNarrowedDefnsForFastForward term -> Term Symbol Ann
toTerm Updated Names
allNames Updated DeclNameLookup
declNameLookups Updated (DefnsF (Map Name) Referent TypeReference)
defns Defns
  (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns =
  (DeclNameLookup
 -> DefnsF (Map Name) Referent TypeReference
 -> DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> Updated DeclNameLookup
-> Updated (DefnsF (Map Name) Referent TypeReference)
-> GUpdated
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
     (DefnsF2 (Map Name) Synhashed Referent TypeReference)
forall a b c. (a -> b -> c) -> Updated a -> Updated b -> Updated c
Updated.zipWith ((term -> Term Symbol Ann)
-> PrettyPrintEnv
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> DeclNameLookup
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
forall term.
HasCallStack =>
(term -> Term Symbol Ann)
-> PrettyPrintEnv
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> DeclNameLookup
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashDefns term -> Term Symbol Ann
toTerm PrettyPrintEnv
ppe Defns
  (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns) Updated DeclNameLookup
declNameLookups Updated (DefnsF (Map Name) Referent TypeReference)
defns
  where
    ppeds :: Updated PrettyPrintEnvDecl
    ppeds :: Updated PrettyPrintEnvDecl
ppeds =
      (Names -> PrettyPrintEnvDecl)
-> Updated Names -> Updated PrettyPrintEnvDecl
forall a b. (a -> b) -> Updated a -> Updated b
Updated.map
        ( \Names
names ->
            let names1 :: Names
names1 = Names -> Names
canonicalizeNamesForSynhashing Names
names
             in Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Names -> Namer
PPE.namer Names
names1) (Names -> Suffixifier
PPE.suffixifyByHash Names
names1)
        )
        Updated Names
allNames

    ppe :: PrettyPrintEnv
    ppe :: PrettyPrintEnv
ppe =
      Updated PrettyPrintEnvDecl
ppeds.old.unsuffixifiedPPE
        PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
`PPE.addFallback` Updated PrettyPrintEnvDecl
ppeds.new.unsuffixifiedPPE

toLabeledDependencies ::
  (Foldable f) =>
  DefnsF f (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) ->
  Set LabeledDependency
toLabeledDependencies :: forall (f :: * -> *).
Foldable f =>
DefnsF
  f
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
-> Set LabeledDependency
toLabeledDependencies DefnsF
  f
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
defns =
  Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Ord a => Set a -> Set a -> Set a
Set.union
    ( DefnsF
  f
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
defns.terms f (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> (f (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
    -> Set LabeledDependency)
-> Set LabeledDependency
forall a b. a -> (a -> b) -> b
& ((TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Set LabeledDependency)
-> f (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> Set LabeledDependency
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \(TermReferenceId
ref, (Term Symbol Ann
term, Type Symbol Ann
typ)) ->
        LabeledDependency -> Set LabeledDependency -> Set LabeledDependency
forall a. Ord a => a -> Set a -> Set a
Set.insert
          (TermReferenceId -> LabeledDependency
LabeledDependency.derivedTerm TermReferenceId
ref)
          (Term Symbol Ann -> Set LabeledDependency
forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set LabeledDependency
Term.labeledDependencies Term Symbol Ann
term Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Semigroup a => a -> a -> a
<> Type Symbol Ann -> Set LabeledDependency
forall v a. Ord v => Type v a -> Set LabeledDependency
Type.labeledDependencies Type Symbol Ann
typ)
    )
    ( DefnsF
  f
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
defns.types f (TermReferenceId, Decl Symbol Ann)
-> (f (TermReferenceId, Decl Symbol Ann) -> Set LabeledDependency)
-> Set LabeledDependency
forall a b. a -> (a -> b) -> b
& ((TermReferenceId, Decl Symbol Ann) -> Set LabeledDependency)
-> f (TermReferenceId, Decl Symbol Ann) -> Set LabeledDependency
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \(TermReferenceId
ref, Decl Symbol Ann
decl) ->
        TypeReference -> Decl Symbol Ann -> Set LabeledDependency
forall v a.
Var v =>
TypeReference -> Decl v a -> Set LabeledDependency
Decl.labeledDeclDependenciesIncludingSelfAndFieldAccessors (TermReferenceId -> TypeReference
forall h t. Id' h -> Reference' t h
Reference.DerivedId TermReferenceId
ref) Decl Symbol Ann
decl
    )

canonicalizeNamesForSynhashing :: Names -> Names
canonicalizeNamesForSynhashing :: Names -> Names
canonicalizeNamesForSynhashing Names
names =
  Relation Name Referent -> Relation Name TypeReference -> Names
Names (Relation Name Referent -> Relation Name Referent
forall ref. Ord ref => Relation Name ref -> Relation Name ref
canonicalizeNames1 Names
names.terms) (Relation Name TypeReference -> Relation Name TypeReference
forall ref. Ord ref => Relation Name ref -> Relation Name ref
canonicalizeNames1 Names
names.types)

canonicalizeNames1 :: forall ref. (Ord ref) => Relation Name ref -> Relation Name ref
canonicalizeNames1 :: forall ref. Ord ref => Relation Name ref -> Relation Name ref
canonicalizeNames1 =
  Map Name (Set ref) -> Relation Name ref
forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
Relation.fromMultimap (Map Name (Set ref) -> Relation Name ref)
-> (Relation Name ref -> Map Name (Set ref))
-> Relation Name ref
-> Relation Name ref
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Name (Set ref) -> Name -> Set ref -> Map Name (Set ref))
-> Map Name (Set ref) -> Map Name (Set ref) -> Map Name (Set ref)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map Name (Set ref) -> Name -> Set ref -> Map Name (Set ref)
f Map Name (Set ref)
forall k a. Map k a
Map.empty (Map Name (Set ref) -> Map Name (Set ref))
-> (Relation Name ref -> Map Name (Set ref))
-> Relation Name ref
-> Map Name (Set ref)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Name ref -> Map Name (Set ref)
forall a b. Relation a b -> Map a (Set b)
Relation.domain
  where
    f :: Map Name (Set ref) -> Name -> Set ref -> Map Name (Set ref)
    f :: Map Name (Set ref) -> Name -> Set ref -> Map Name (Set ref)
f Map Name (Set ref)
acc Name
name Set ref
refs =
      (Set ref -> Set ref -> Set ref)
-> Name -> Set ref -> Map Name (Set ref) -> Map Name (Set ref)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set ref -> Set ref -> Set ref
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Name -> Name
canonicalizeName Name
name) Set ref
refs Map Name (Set ref)
acc

canonicalizeName :: Name -> Name
canonicalizeName :: Name -> Name
canonicalizeName Name
name =
  case Name -> NonEmpty NameSegment
Name.segments Name
name of
    NameSegment
NameSegment.LibSegment List.NonEmpty.:| (NameSegment -> Maybe NameSegment
asCanonicalizedLibname -> Just NameSegment
libname) : [NameSegment]
segments ->
      NonEmpty NameSegment -> Name
Name.fromSegments (NameSegment
NameSegment.libSegment NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
List.NonEmpty.:| NameSegment
libname NameSegment -> [NameSegment] -> [NameSegment]
forall a. a -> [a] -> [a]
: [NameSegment]
segments)
    NonEmpty NameSegment
_ -> Name
name

-- Canonicalize a libname for the purpose of syntactic hashing.
--
-- Currently, we only perform one canonicalization - stripping a suffix that looks like a mangled semver, e.g. "_1_2_3".
-- We could additionally (first) try to strip a suffix like "__2" (two underscores), which we add sometimes when a
-- preferred name isn't available. This is just a hack that we perform to make it more likely that we classify things
-- that are *probably* true propagated updates as such.
asCanonicalizedLibname :: NameSegment -> Maybe NameSegment
asCanonicalizedLibname :: NameSegment -> Maybe NameSegment
asCanonicalizedLibname =
  (Text -> NameSegment) -> Maybe Text -> Maybe NameSegment
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> NameSegment
NameSegment.NameSegment (Maybe Text -> Maybe NameSegment)
-> (NameSegment -> Maybe Text) -> NameSegment -> Maybe NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
asCanonicalizedLibname1 (Text -> Maybe Text)
-> (NameSegment -> Text) -> NameSegment -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
NameSegment.toUnescapedText

-- >>> asCanonicalizedLibname1 "unison_base_1_0_0"
-- Just "unison_base"
--
-- >>> asCanonicalizedLibname1 "foo"
-- Nothing
asCanonicalizedLibname1 :: Text -> Maybe Text
asCanonicalizedLibname1 :: Text -> Maybe Text
asCanonicalizedLibname1 =
  Text -> Maybe Text
removeNumberFromEnd
    (Text -> Maybe Text) -> (Text -> Maybe Text) -> Text -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Maybe Text
removeUnderscoreFromEnd
    (Text -> Maybe Text) -> (Text -> Maybe Text) -> Text -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Maybe Text
removeNumberFromEnd
    (Text -> Maybe Text) -> (Text -> Maybe Text) -> Text -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Maybe Text
removeUnderscoreFromEnd
    (Text -> Maybe Text) -> (Text -> Maybe Text) -> Text -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Maybe Text
removeNumberFromEnd
    (Text -> Maybe Text) -> (Text -> Maybe Text) -> Text -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Maybe Text
removeUnderscoreFromEnd
  where
    removeNumberFromEnd :: Text -> Maybe Text
    removeNumberFromEnd :: Text -> Maybe Text
removeNumberFromEnd Text
s =
      case Identity (Text, Text) -> (Text, Text)
forall a. Identity a -> a
runIdentity ((Char -> Identity Bool) -> Text -> Identity (Text, Text)
forall (m :: * -> *).
Monad m =>
(Char -> m Bool) -> Text -> m (Text, Text)
Text.spanEndM (Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> (Char -> Bool) -> Char -> Identity Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isDigit) Text
s) of
        (Text
s1, Text
n) | Bool -> Bool
not (Text -> Bool
Text.null Text
n) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s1
        (Text, Text)
_ -> Maybe Text
forall a. Maybe a
Nothing

    removeUnderscoreFromEnd :: Text -> Maybe Text
    removeUnderscoreFromEnd :: Text -> Maybe Text
removeUnderscoreFromEnd Text
s
      | Int -> Text -> Text
Text.takeEnd Int
1 Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"_" = Text -> Maybe Text
forall a. a -> Maybe a
Just (Int -> Text -> Text
Text.dropEnd Int
1 Text
s)
      | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing