module Unison.Merge.Diff
  ( nameBasedNamespaceDiff,
    humanizeDiffs,
  )
where

import Data.List.NonEmpty qualified as NEL
import Data.List.NonEmpty qualified as NEList
import Data.Map.Merge.Strict qualified as Map
import Data.Map.Strict qualified as Map
import Data.Semialign (alignWith)
import Data.Set qualified as Set
import Data.Set.NonEmpty qualified as NESet
import Data.These (These (..))
import Data.Zip qualified as Zip
import U.Codebase.Reference (TypeReference)
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as DataDeclaration
import Unison.DeclNameLookup (DeclNameLookup)
import Unison.DeclNameLookup qualified as DeclNameLookup
import Unison.Hash (Hash (Hash))
import Unison.Merge.DiffOp (DiffOp (..), DiffOp2 (..))
import Unison.Merge.HumanDiffOp (HumanDiffOp (..))
import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..))
import Unison.Merge.Synhash qualified as Synhash
import Unison.Merge.Synhashed (Synhashed (..))
import Unison.Merge.Synhashed qualified as Synhashed
import Unison.Merge.ThreeWay (ThreeWay (..))
import Unison.Merge.ThreeWay qualified as ThreeWay
import Unison.Merge.TwoWay (TwoWay (..))
import Unison.Merge.Updated (Updated (..))
import Unison.Name (Name)
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Prelude hiding (catMaybes)
import Unison.PrettyPrintEnv (PrettyPrintEnv (..))
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Reference (Reference' (..), TermReference, TermReferenceId, TypeReferenceId)
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Symbol (Symbol)
import Unison.Syntax.Name qualified as Name
import Unison.Term (Term)
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, unzipDefns, zipDefnsWith)
import Unison.Util.Defns qualified as Defns
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as Rel

-- | @nameBasedNamespaceDiff db declNameLookups defns@ returns Alice's and Bob's name-based namespace diffs, each in the
-- form:
--
-- > terms :: Map Name (DiffOp (Synhashed Referent))
-- > types :: Map Name (DiffOp (Synhashed TypeReference))
--
-- where each name is paired with its diff-op (added, deleted, or updated), relative to the LCA between Alice and Bob's
-- branches. If the hash of a name did not change, it will not appear in the map.
nameBasedNamespaceDiff ::
  (HasCallStack) =>
  TwoWay DeclNameLookup ->
  PartialDeclNameLookup ->
  ThreeWay PPED.PrettyPrintEnvDecl ->
  ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) ->
  Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) ->
  ( -- Core diffs, i.e. adds, deletes, and updates which have different synhashes.
    TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
    -- Propagated updates, i.e. updates which have the same synhash but different Unison hashes.
    TwoWay (DefnsF2 (Map Name) Updated Referent TypeReference)
  )
nameBasedNamespaceDiff :: HasCallStack =>
TwoWay DeclNameLookup
-> PartialDeclNameLookup
-> ThreeWay PrettyPrintEnvDecl
-> ThreeWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> (TwoWay
      (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
    TwoWay (DefnsF2 (Map Name) Updated Referent TypeReference))
nameBasedNamespaceDiff TwoWay DeclNameLookup
declNameLookups PartialDeclNameLookup
lcaDeclNameLookup ThreeWay PrettyPrintEnvDecl
ppeds ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
defns Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns =
  TwoWay
  (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
   DefnsF2 (Map Name) Updated Referent TypeReference)
-> (TwoWay
      (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
    TwoWay (DefnsF2 (Map Name) Updated Referent TypeReference))
forall a b. TwoWay (a, b) -> (TwoWay a, TwoWay b)
forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
Zip.unzip (TwoWay
   (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
    DefnsF2 (Map Name) Updated Referent TypeReference)
 -> (TwoWay
       (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
     TwoWay (DefnsF2 (Map Name) Updated Referent TypeReference)))
-> TwoWay
     (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
      DefnsF2 (Map Name) Updated Referent TypeReference)
-> (TwoWay
      (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
    TwoWay (DefnsF2 (Map Name) Updated Referent TypeReference))
forall a b. (a -> b) -> a -> b
$
    DefnsF2 (Map Name) Synhashed Referent TypeReference
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
-> (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
    DefnsF2 (Map Name) Updated Referent TypeReference)
forall term typ.
(Eq term, Eq typ) =>
DefnsF2 (Map Name) Synhashed term typ
-> DefnsF2 (Map Name) Synhashed term typ
-> (DefnsF3 (Map Name) DiffOp Synhashed term typ,
    DefnsF2 (Map Name) Updated term typ)
diffHashedNamespaceDefns (HasCallStack =>
PrettyPrintEnv
-> PartialDeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
PrettyPrintEnv
-> PartialDeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashLcaDefns PrettyPrintEnv
synhashPPE PartialDeclNameLookup
lcaDeclNameLookup ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
defns.lca Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns)
      (DefnsF2 (Map Name) Synhashed Referent TypeReference
 -> (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
     DefnsF2 (Map Name) Updated Referent TypeReference))
-> TwoWay (DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> TwoWay
     (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference,
      DefnsF2 (Map Name) Updated Referent TypeReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HasCallStack =>
PrettyPrintEnv
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
PrettyPrintEnv
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashDefns PrettyPrintEnv
synhashPPE Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns (DeclNameLookup
 -> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
 -> DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> TwoWay DeclNameLookup
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
      -> DefnsF2 (Map Name) Synhashed Referent TypeReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay DeclNameLookup
declNameLookups TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
   -> DefnsF2 (Map Name) Synhashed Referent TypeReference)
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> 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
<*> ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
defns)
  where
    synhashPPE :: PPE.PrettyPrintEnv
    synhashPPE :: PrettyPrintEnv
synhashPPE =
      let ThreeWay {$sel:lca:ThreeWay :: forall a. ThreeWay a -> a
lca = PrettyPrintEnv
lcaPPE, $sel:alice:ThreeWay :: forall a. ThreeWay a -> a
alice = PrettyPrintEnv
alicePPE, $sel:bob:ThreeWay :: forall a. ThreeWay a -> a
bob = PrettyPrintEnv
bobPPE} = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE (PrettyPrintEnvDecl -> PrettyPrintEnv)
-> ThreeWay PrettyPrintEnvDecl -> ThreeWay PrettyPrintEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay PrettyPrintEnvDecl
ppeds
       in PrettyPrintEnv
alicePPE PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
`PPE.addFallback` PrettyPrintEnv
bobPPE PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
`PPE.addFallback` PrettyPrintEnv
lcaPPE

diffHashedNamespaceDefns ::
  (Eq term, Eq typ) =>
  DefnsF2 (Map Name) Synhashed term typ ->
  DefnsF2 (Map Name) Synhashed term typ ->
  ( -- Core diffs, i.e. adds, deletes, and updates which have different synhashes.
    DefnsF3 (Map Name) DiffOp Synhashed term typ,
    -- Propagated updates, i.e. updates which have the same synhash but different Unison hashes.
    DefnsF2 (Map Name) Updated term typ
  )
diffHashedNamespaceDefns :: forall term typ.
(Eq term, Eq typ) =>
DefnsF2 (Map Name) Synhashed term typ
-> DefnsF2 (Map Name) Synhashed term typ
-> (DefnsF3 (Map Name) DiffOp Synhashed term typ,
    DefnsF2 (Map Name) Updated term typ)
diffHashedNamespaceDefns DefnsF2 (Map Name) Synhashed term typ
old DefnsF2 (Map Name) Synhashed term typ
new =
  Defns
  (Map Name (DiffOp (Synhashed term)), Map Name (Updated term))
  (Map Name (DiffOp (Synhashed typ)), Map Name (Updated typ))
-> (Defns
      (Map Name (DiffOp (Synhashed term)))
      (Map Name (DiffOp (Synhashed typ))),
    Defns (Map Name (Updated term)) (Map Name (Updated typ)))
forall tm1 tm2 ty1 ty2.
Defns (tm1, tm2) (ty1, ty2) -> (Defns tm1 ty1, Defns tm2 ty2)
unzipDefns ((Map Name (Synhashed term)
 -> Map Name (Synhashed term)
 -> (Map Name (DiffOp (Synhashed term)), Map Name (Updated term)))
-> (Map Name (Synhashed typ)
    -> Map Name (Synhashed typ)
    -> (Map Name (DiffOp (Synhashed typ)), Map Name (Updated typ)))
-> DefnsF2 (Map Name) Synhashed term typ
-> DefnsF2 (Map Name) Synhashed term typ
-> Defns
     (Map Name (DiffOp (Synhashed term)), Map Name (Updated term))
     (Map Name (DiffOp (Synhashed typ)), Map Name (Updated typ))
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 term)
-> Map Name (Synhashed term)
-> (Map Name (DiffOp (Synhashed term)), Map Name (Updated term))
forall ref.
Eq ref =>
Map Name (Synhashed ref)
-> Map Name (Synhashed ref)
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
f Map Name (Synhashed typ)
-> Map Name (Synhashed typ)
-> (Map Name (DiffOp (Synhashed typ)), Map Name (Updated typ))
forall ref.
Eq ref =>
Map Name (Synhashed ref)
-> Map Name (Synhashed ref)
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
f DefnsF2 (Map Name) Synhashed term typ
old DefnsF2 (Map Name) Synhashed term typ
new)
  where
    f ::
      (Eq ref) =>
      Map Name (Synhashed ref) ->
      Map Name (Synhashed ref) ->
      (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
    f :: forall ref.
Eq ref =>
Map Name (Synhashed ref)
-> Map Name (Synhashed ref)
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
f Map Name (Synhashed ref)
old Map Name (Synhashed ref)
new =
      Map Name (DiffOp2 (Synhashed ref))
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
forall ref.
Map Name (DiffOp2 (Synhashed ref))
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
partitionPropagated (Map Name (Synhashed ref)
-> Map Name (Synhashed ref) -> Map Name (DiffOp2 (Synhashed ref))
forall ref.
Eq ref =>
Map Name (Synhashed ref)
-> Map Name (Synhashed ref) -> Map Name (DiffOp2 (Synhashed ref))
computeDiff Map Name (Synhashed ref)
old Map Name (Synhashed ref)
new)

    -- Compute the diff by comparing old-and-new values, resulting in either an add, delete, update (propagated or not),
    -- or dropping the thing entirely (because old and new have the same hash).
    computeDiff ::
      (Eq ref) =>
      Map Name (Synhashed ref) ->
      Map Name (Synhashed ref) ->
      Map Name (DiffOp2 (Synhashed ref))
    computeDiff :: forall ref.
Eq ref =>
Map Name (Synhashed ref)
-> Map Name (Synhashed ref) -> Map Name (DiffOp2 (Synhashed ref))
computeDiff =
      SimpleWhenMissing Name (Synhashed ref) (DiffOp2 (Synhashed ref))
-> SimpleWhenMissing Name (Synhashed ref) (DiffOp2 (Synhashed ref))
-> SimpleWhenMatched
     Name (Synhashed ref) (Synhashed ref) (DiffOp2 (Synhashed ref))
-> Map Name (Synhashed ref)
-> Map Name (Synhashed ref)
-> Map Name (DiffOp2 (Synhashed ref))
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
        ((Name -> Synhashed ref -> DiffOp2 (Synhashed ref))
-> SimpleWhenMissing Name (Synhashed ref) (DiffOp2 (Synhashed ref))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\Name
_ -> Synhashed ref -> DiffOp2 (Synhashed ref)
forall a. a -> DiffOp2 a
DiffOp2'Delete))
        ((Name -> Synhashed ref -> DiffOp2 (Synhashed ref))
-> SimpleWhenMissing Name (Synhashed ref) (DiffOp2 (Synhashed ref))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\Name
_ -> Synhashed ref -> DiffOp2 (Synhashed ref)
forall a. a -> DiffOp2 a
DiffOp2'Add))
        ( let f :: Synhashed a -> Synhashed a -> Maybe (DiffOp2 (Synhashed a))
f Synhashed a
old Synhashed a
new = do
                let equalSynhashes :: Bool
equalSynhashes = Synhashed a
old Synhashed a -> Synhashed a -> Bool
forall a. Eq a => a -> a -> Bool
== Synhashed a
new
                -- Drop things that haven't changed
                Bool -> Maybe () -> Maybe ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
equalSynhashes do
                  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Synhashed a -> a
forall a. Synhashed a -> a
Synhashed.value Synhashed a
old a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= Synhashed a -> a
forall a. Synhashed a -> a
Synhashed.value Synhashed a
new)
                DiffOp2 (Synhashed a) -> Maybe (DiffOp2 (Synhashed a))
forall a. a -> Maybe a
Just (Updated (Synhashed a) -> Bool -> DiffOp2 (Synhashed a)
forall a. Updated a -> Bool -> DiffOp2 a
DiffOp2'Update Updated {Synhashed a
old :: Synhashed a
$sel:old:Updated :: Synhashed a
old, Synhashed a
new :: Synhashed a
$sel:new:Updated :: Synhashed a
new} Bool
equalSynhashes)
           in (Name
 -> Synhashed ref
 -> Synhashed ref
 -> Maybe (DiffOp2 (Synhashed ref)))
-> SimpleWhenMatched
     Name (Synhashed ref) (Synhashed ref) (DiffOp2 (Synhashed ref))
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched \Name
_ -> Synhashed ref -> Synhashed ref -> Maybe (DiffOp2 (Synhashed ref))
forall {a}.
Eq a =>
Synhashed a -> Synhashed a -> Maybe (DiffOp2 (Synhashed a))
f
        )

    -- Partition add/delete/update/propagated-update into add/delete/update + propagated-update
    partitionPropagated ::
      Map Name (DiffOp2 (Synhashed ref)) ->
      (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
    partitionPropagated :: forall ref.
Map Name (DiffOp2 (Synhashed ref))
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
partitionPropagated =
      (DiffOp2 (Synhashed ref)
 -> Either (DiffOp (Synhashed ref)) (Updated ref))
-> Map Name (DiffOp2 (Synhashed ref))
-> (Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
Map.mapEither \case
        DiffOp2'Add Synhashed ref
ref -> DiffOp (Synhashed ref)
-> Either (DiffOp (Synhashed ref)) (Updated ref)
forall a b. a -> Either a b
Left (Synhashed ref -> DiffOp (Synhashed ref)
forall a. a -> DiffOp a
DiffOp'Add Synhashed ref
ref)
        DiffOp2'Delete Synhashed ref
ref -> DiffOp (Synhashed ref)
-> Either (DiffOp (Synhashed ref)) (Updated ref)
forall a b. a -> Either a b
Left (Synhashed ref -> DiffOp (Synhashed ref)
forall a. a -> DiffOp a
DiffOp'Delete Synhashed ref
ref)
        DiffOp2'Update Updated (Synhashed ref)
refs Bool
propagated
          | Bool
propagated -> Updated ref -> Either (DiffOp (Synhashed ref)) (Updated ref)
forall a b. b -> Either a b
Right (Synhashed ref -> ref
forall a. Synhashed a -> a
Synhashed.value (Synhashed ref -> ref) -> Updated (Synhashed ref) -> Updated ref
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Updated (Synhashed ref)
refs)
          | Bool
otherwise -> DiffOp (Synhashed ref)
-> Either (DiffOp (Synhashed ref)) (Updated ref)
forall a b. a -> Either a b
Left (Updated (Synhashed ref) -> DiffOp (Synhashed ref)
forall a. Updated a -> DiffOp a
DiffOp'Update Updated (Synhashed ref)
refs)

-- | Post-process a diff to identify relationships humans might care about, such as whether a given addition could be
-- interpreted as an alias of an existing definition, or whether an add and deletion could be a rename.
humanizeDiffs ::
  ThreeWay Names ->
  TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) ->
  TwoWay (DefnsF2 (Map Name) Updated Referent TypeReference) ->
  TwoWay (DefnsF2 (Map Name) HumanDiffOp Referent TypeReference)
humanizeDiffs :: ThreeWay Names
-> TwoWay
     (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> TwoWay (DefnsF2 (Map Name) Updated Referent TypeReference)
-> TwoWay (DefnsF2 (Map Name) HumanDiffOp Referent TypeReference)
humanizeDiffs ThreeWay Names
names3 =
  let names3' :: ThreeWay
  (Defns (Relation Name Referent) (Relation Name TypeReference))
names3' = ThreeWay Names
names3 ThreeWay Names
-> (Names
    -> Defns (Relation Name Referent) (Relation Name TypeReference))
-> ThreeWay
     (Defns (Relation Name Referent) (Relation Name TypeReference))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Names
names -> Relation Name Referent
-> Relation Name TypeReference
-> Defns (Relation Name Referent) (Relation Name TypeReference)
forall terms types. terms -> types -> Defns terms types
Defns Names
names.terms Names
names.types
   in (Defns (Relation Name Referent) (Relation Name TypeReference)
 -> DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
 -> DefnsF2 (Map Name) Updated Referent TypeReference
 -> DefnsF2 (Map Name) HumanDiffOp Referent TypeReference)
-> TwoWay
     (Defns (Relation Name Referent) (Relation Name TypeReference))
-> TwoWay
     (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> TwoWay (DefnsF2 (Map Name) Updated Referent TypeReference)
-> TwoWay (DefnsF2 (Map Name) HumanDiffOp Referent TypeReference)
forall (f :: * -> *) a b c d.
Zip f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
zipWith3
        ((Relation Name Referent
 -> Relation Name Referent
 -> Map Name (DiffOp (Synhashed Referent))
 -> Map Name (Updated Referent)
 -> Map Name (HumanDiffOp Referent))
-> (Relation Name TypeReference
    -> Relation Name TypeReference
    -> Map Name (DiffOp (Synhashed TypeReference))
    -> Map Name (Updated TypeReference)
    -> Map Name (HumanDiffOp TypeReference))
-> Defns (Relation Name Referent) (Relation Name TypeReference)
-> Defns (Relation Name Referent) (Relation Name TypeReference)
-> DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
-> DefnsF2 (Map Name) Updated Referent TypeReference
-> DefnsF2 (Map Name) HumanDiffOp Referent TypeReference
forall tm1 tm2 tm3 tm4 tm5 ty1 ty2 ty3 ty4 ty5.
(tm1 -> tm2 -> tm3 -> tm4 -> tm5)
-> (ty1 -> ty2 -> ty3 -> ty4 -> ty5)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
-> Defns tm4 ty4
-> Defns tm5 ty5
Defns.zipDefnsWith4 Relation Name Referent
-> Relation Name Referent
-> Map Name (DiffOp (Synhashed Referent))
-> Map Name (Updated Referent)
-> Map Name (HumanDiffOp Referent)
forall ref.
(Show ref, Ord ref) =>
Relation Name ref
-> Relation Name ref
-> Map Name (DiffOp (Synhashed ref))
-> Map Name (Updated ref)
-> Map Name (HumanDiffOp ref)
computeHumanDiffOp Relation Name TypeReference
-> Relation Name TypeReference
-> Map Name (DiffOp (Synhashed TypeReference))
-> Map Name (Updated TypeReference)
-> Map Name (HumanDiffOp TypeReference)
forall ref.
(Show ref, Ord ref) =>
Relation Name ref
-> Relation Name ref
-> Map Name (DiffOp (Synhashed ref))
-> Map Name (Updated ref)
-> Map Name (HumanDiffOp ref)
computeHumanDiffOp ThreeWay
  (Defns (Relation Name Referent) (Relation Name TypeReference))
names3'.lca)
        (ThreeWay
  (Defns (Relation Name Referent) (Relation Name TypeReference))
-> TwoWay
     (Defns (Relation Name Referent) (Relation Name TypeReference))
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca ThreeWay
  (Defns (Relation Name Referent) (Relation Name TypeReference))
names3')
  where
    zipWith3 :: (Zip.Zip f) => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
    zipWith3 :: forall (f :: * -> *) a b c d.
Zip f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
zipWith3 a -> b -> c -> d
f f a
a f b
b =
      ((a, b) -> c -> d) -> f (a, b) -> f c -> f d
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
Zip.zipWith ((a -> b -> c -> d) -> (a, b) -> c -> d
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> d
f) (f a -> f b -> f (a, b)
forall a b. f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
Zip.zip f a
a f b
b)

    computeHumanDiffOp ::
      forall ref.
      (Show ref, Ord ref) =>
      Relation Name ref ->
      Relation Name ref ->
      Map Name (DiffOp (Synhashed ref)) ->
      Map Name (Updated ref) ->
      Map Name (HumanDiffOp ref)
    computeHumanDiffOp :: forall ref.
(Show ref, Ord ref) =>
Relation Name ref
-> Relation Name ref
-> Map Name (DiffOp (Synhashed ref))
-> Map Name (Updated ref)
-> Map Name (HumanDiffOp ref)
computeHumanDiffOp Relation Name ref
oldNamespace Relation Name ref
newNamespace =
      (These (DiffOp (Synhashed ref)) (Updated ref) -> HumanDiffOp ref)
-> Map Name (DiffOp (Synhashed ref))
-> Map Name (Updated ref)
-> Map Name (HumanDiffOp ref)
forall a b c.
(These a b -> c) -> Map Name a -> Map Name b -> Map Name c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith \case
        This DiffOp (Synhashed ref)
diff -> DiffOp ref -> HumanDiffOp ref
humanizeDiffOp (Synhashed ref -> ref
forall a. Synhashed a -> a
Synhashed.value (Synhashed ref -> ref) -> DiffOp (Synhashed ref) -> DiffOp ref
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiffOp (Synhashed ref)
diff)
        That Updated ref
updated -> Updated ref -> HumanDiffOp ref
forall ref. Updated ref -> HumanDiffOp ref
HumanDiffOp'PropagatedUpdate Updated ref
updated
        These DiffOp (Synhashed ref)
diff Updated ref
updated ->
          [Char] -> HumanDiffOp ref
forall a. HasCallStack => [Char] -> a
error ([Char] -> HumanDiffOp ref) -> [Char] -> HumanDiffOp ref
forall a b. (a -> b) -> a -> b
$
            [Char] -> [Char] -> [Char]
reportBug
              [Char]
"E488729"
              ( [Char]
"The impossible happened, an update in merge was detected as both a propagated AND core update "
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DiffOp (Synhashed ref) -> [Char]
forall a. Show a => a -> [Char]
show DiffOp (Synhashed ref)
diff
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" and "
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Updated ref -> [Char]
forall a. Show a => a -> [Char]
show Updated ref
updated
              )
      where
        humanizeDiffOp :: DiffOp ref -> HumanDiffOp ref
        humanizeDiffOp :: DiffOp ref -> HumanDiffOp ref
humanizeDiffOp = \case
          DiffOp'Add ref
ref ->
            -- This name is newly added. We need to check if it's a new definition, an alias, or a rename.
            case Set Name -> [Name]
forall a. Set a -> [a]
Set.toList (ref -> Relation Name ref -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
Rel.lookupRan ref
ref Relation Name ref
oldNamespace) of
              -- No old names for this ref, so it's a new addition not an alias
              [] -> ref -> HumanDiffOp ref
forall ref. ref -> HumanDiffOp ref
HumanDiffOp'Add ref
ref
              -- There are old names for this ref, but not old refs for this name, so it's
              -- either a new alias or a rename.
              --
              -- If at least one old name for this ref no longer exists, we treat it like a
              -- rename.
              Name
n : [Name]
ns -> do
                let existingNames :: NESet Name
existingNames = NonEmpty Name -> NESet Name
forall a. Ord a => NonEmpty a -> NESet a
NESet.fromList (Name
n Name -> [Name] -> NonEmpty Name
forall a. a -> [a] -> NonEmpty a
NEList.:| [Name]
ns)
                case Set Name -> Maybe (NESet Name)
forall a. Set a -> Maybe (NESet a)
NESet.nonEmptySet (ref -> Relation Name ref -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
Rel.lookupRan ref
ref Relation Name ref
newNamespace) of
                  Maybe (NESet Name)
Nothing -> [Char] -> HumanDiffOp ref
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E458329" ([Char]
"Expected to find at least one name for ref in new namespace, since we found the ref by the name."))
                  Just NESet Name
allNewNames ->
                    case Set Name -> Maybe (NESet Name)
forall a. Set a -> Maybe (NESet a)
NESet.nonEmptySet (NESet Name -> NESet Name -> Set Name
forall a. Ord a => NESet a -> NESet a -> Set a
NESet.difference NESet Name
existingNames NESet Name
allNewNames) of
                      -- If all the old names still exist in the new namespace, it's a new alias.
                      Maybe (NESet Name)
Nothing -> ref -> NESet Name -> HumanDiffOp ref
forall ref. ref -> NESet Name -> HumanDiffOp ref
HumanDiffOp'AliasOf ref
ref NESet Name
existingNames
                      -- Otherwise, treat it as a rename.
                      Just NESet Name
namesWhichDisappeared ->
                        ref -> NESet Name -> HumanDiffOp ref
forall ref. ref -> NESet Name -> HumanDiffOp ref
HumanDiffOp'RenamedFrom ref
ref NESet Name
namesWhichDisappeared
          DiffOp'Delete ref
ref ->
            case [Name] -> Maybe (NonEmpty Name)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty ([Name] -> Maybe (NonEmpty Name))
-> [Name] -> Maybe (NonEmpty Name)
forall a b. (a -> b) -> a -> b
$ Set Name -> [Name]
forall a. Set a -> [a]
Set.toList (ref -> Relation Name ref -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
Rel.lookupRan ref
ref Relation Name ref
newNamespace) of
              -- No names for this ref, it was removed.
              Maybe (NonEmpty Name)
Nothing -> ref -> HumanDiffOp ref
forall ref. ref -> HumanDiffOp ref
HumanDiffOp'Delete ref
ref
              Just NonEmpty Name
newNames -> ref -> NESet Name -> HumanDiffOp ref
forall ref. ref -> NESet Name -> HumanDiffOp ref
HumanDiffOp'RenamedTo ref
ref (NonEmpty Name -> NESet Name
forall a. Ord a => NonEmpty a -> NESet a
NESet.fromList NonEmpty Name
newNames)
          DiffOp'Update Updated {ref
$sel:old:Updated :: forall a. Updated a -> a
old :: ref
old, ref
$sel:new:Updated :: forall a. Updated a -> a
new :: ref
new} -> Updated ref -> HumanDiffOp ref
forall ref. Updated ref -> HumanDiffOp ref
HumanDiffOp'Update Updated {ref
$sel:old:Updated :: ref
old :: ref
old, ref
$sel:new:Updated :: ref
new :: ref
new}

------------------------------------------------------------------------------------------------------------------------
-- Syntactic hashing

synhashLcaDefns ::
  (HasCallStack) =>
  PrettyPrintEnv ->
  PartialDeclNameLookup ->
  Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) ->
  Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) ->
  DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashLcaDefns :: HasCallStack =>
PrettyPrintEnv
-> PartialDeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashLcaDefns PrettyPrintEnv
ppe PartialDeclNameLookup
declNameLookup Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
defns Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns =
  (Name -> Referent -> Hash)
-> (Name -> TypeReference -> Hash)
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
forall term typ.
HasCallStack =>
(Name -> term -> Hash)
-> (Name -> typ -> Hash)
-> Defns (BiMultimap term Name) (BiMultimap typ Name)
-> DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith Name -> Referent -> Hash
hashReferent Name -> TypeReference -> Hash
hashType Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
defns
  where
    -- For the LCA only, if we don't have a name for every constructor, or we don't have a name for a decl, that's okay,
    -- just use a dummy syntactic hash (e.g. where we return `Hash mempty` below in two places).
    --
    -- This is safe and correct; Alice/Bob can't have such a decl (it violates a merge precondition), so there's no risk
    -- that we accidentally get an equal hash and classify a real update as unchanged.

    hashReferent :: Name -> Referent -> Hash
    hashReferent :: Name -> Referent -> Hash
hashReferent Name
name = \case
      Referent.Con (ConstructorReference TypeReference
ref ConstructorId
_) ConstructorType
_ ->
        case Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name PartialDeclNameLookup
declNameLookup.constructorToDecl of
          Maybe Name
Nothing -> ShortByteString -> Hash
Hash ShortByteString
forall a. Monoid a => a
mempty -- see note above
          Just Name
declName -> Name -> TypeReference -> Hash
hashType Name
declName TypeReference
ref
      Referent.Ref TypeReference
ref -> HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Term Symbol Ann) -> TypeReference -> Hash
PrettyPrintEnv
-> Map TermReferenceId (Term Symbol Ann) -> TypeReference -> Hash
synhashTermReference PrettyPrintEnv
ppe Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.terms TypeReference
ref

    hashType :: Name -> TypeReference -> Hash
    hashType :: Name -> TypeReference -> Hash
hashType Name
name = \case
      ReferenceBuiltin Text
builtin -> Text -> Hash
Synhash.synhashBuiltinDecl Text
builtin
      ReferenceDerived TermReferenceId
ref ->
        case [Maybe Name] -> Maybe [Name]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (PartialDeclNameLookup
declNameLookup.declToConstructors Map Name [Maybe Name] -> Name -> [Maybe Name]
forall k a. Ord k => Map k a -> k -> a
Map.! Name
name) of
          Maybe [Name]
Nothing -> ShortByteString -> Hash
Hash ShortByteString
forall a. Monoid a => a
mempty -- see note above
          Just [Name]
names -> HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Decl Symbol Ann)
-> [Name]
-> Name
-> TermReferenceId
-> Hash
PrettyPrintEnv
-> Map TermReferenceId (Decl Symbol Ann)
-> [Name]
-> Name
-> TermReferenceId
-> Hash
synhashDerivedDecl PrettyPrintEnv
ppe Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.types [Name]
names Name
name TermReferenceId
ref

synhashDefns ::
  (HasCallStack) =>
  PrettyPrintEnv ->
  Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) ->
  DeclNameLookup ->
  Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) ->
  DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashDefns :: HasCallStack =>
PrettyPrintEnv
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashDefns PrettyPrintEnv
ppe Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns DeclNameLookup
declNameLookup =
  (Name -> Referent -> Hash)
-> (Name -> TypeReference -> Hash)
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
forall term typ.
HasCallStack =>
(Name -> term -> Hash)
-> (Name -> typ -> Hash)
-> Defns (BiMultimap term Name) (BiMultimap typ Name)
-> DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith Name -> Referent -> Hash
hashReferent Name -> TypeReference -> Hash
hashType
  where
    hashReferent :: Name -> Referent -> Hash
    hashReferent :: Name -> Referent -> Hash
hashReferent Name
name = \case
      -- We say that a referent constructor *in the namespace* (distinct from a referent that is in a term body) has a
      -- synhash that is simply equal to the synhash of its type declaration. This is because the type declaration and
      -- constructors are changed in lock-step: it is not possible to change one, but not the other.
      --
      -- For example, if Alice updates `type Foo = Bar Nat` to `type Foo = Bar Nat Nat`, we want different synhashes on
      -- both the type (Foo) and the constructor (Foo.Bar).
      Referent.Con (ConstructorReference TypeReference
ref ConstructorId
_) ConstructorType
_ -> Name -> TypeReference -> Hash
hashType (HasCallStack => DeclNameLookup -> Name -> Name
DeclNameLookup -> Name -> Name
DeclNameLookup.expectDeclName DeclNameLookup
declNameLookup Name
name) TypeReference
ref
      Referent.Ref TypeReference
ref -> HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Term Symbol Ann) -> TypeReference -> Hash
PrettyPrintEnv
-> Map TermReferenceId (Term Symbol Ann) -> TypeReference -> Hash
synhashTermReference PrettyPrintEnv
ppe Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.terms TypeReference
ref

    hashType :: Name -> TypeReference -> Hash
    hashType :: Name -> TypeReference -> Hash
hashType Name
name = \case
      ReferenceBuiltin Text
builtin -> Text -> Hash
Synhash.synhashBuiltinDecl Text
builtin
      ReferenceDerived TermReferenceId
ref ->
        HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Decl Symbol Ann)
-> [Name]
-> Name
-> TermReferenceId
-> Hash
PrettyPrintEnv
-> Map TermReferenceId (Decl Symbol Ann)
-> [Name]
-> Name
-> TermReferenceId
-> Hash
synhashDerivedDecl PrettyPrintEnv
ppe Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.types (HasCallStack => DeclNameLookup -> Name -> [Name]
DeclNameLookup -> Name -> [Name]
DeclNameLookup.expectConstructorNames DeclNameLookup
declNameLookup Name
name) Name
name TermReferenceId
ref

synhashDerivedDecl ::
  (HasCallStack) =>
  PrettyPrintEnv ->
  Map TypeReferenceId (Decl Symbol Ann) ->
  [Name] ->
  Name ->
  TypeReferenceId ->
  Hash
synhashDerivedDecl :: HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Decl Symbol Ann)
-> [Name]
-> Name
-> TermReferenceId
-> Hash
synhashDerivedDecl PrettyPrintEnv
ppe Map TermReferenceId (Decl Symbol Ann)
declsById [Name]
names Name
name TermReferenceId
ref =
  Map TermReferenceId (Decl Symbol Ann)
declsById
    Map TermReferenceId (Decl Symbol Ann)
-> (Map TermReferenceId (Decl Symbol Ann) -> Decl Symbol Ann)
-> Decl Symbol Ann
forall a b. a -> (a -> b) -> b
& HasCallStack =>
TermReferenceId
-> Map TermReferenceId (Decl Symbol Ann) -> Decl Symbol Ann
TermReferenceId
-> Map TermReferenceId (Decl Symbol Ann) -> Decl Symbol Ann
expectDecl TermReferenceId
ref
    Decl Symbol Ann
-> (Decl Symbol Ann -> Decl Symbol Ann) -> Decl Symbol Ann
forall a b. a -> (a -> b) -> b
& [Symbol] -> Decl Symbol Ann -> Decl Symbol Ann
forall v a. [v] -> Decl v a -> Decl v a
DataDeclaration.setConstructorNames ((Name -> Symbol) -> [Name] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Symbol
forall v. Var v => Name -> v
Name.toVar [Name]
names)
    Decl Symbol Ann -> (Decl Symbol Ann -> Hash) -> Hash
forall a b. a -> (a -> b) -> b
& PrettyPrintEnv -> Name -> Decl Symbol Ann -> Hash
forall v a. Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash
Synhash.synhashDerivedDecl PrettyPrintEnv
ppe Name
name

synhashTermReference :: (HasCallStack) => PrettyPrintEnv -> Map TermReferenceId (Term Symbol Ann) -> TermReference -> Hash
synhashTermReference :: HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Term Symbol Ann) -> TypeReference -> Hash
synhashTermReference PrettyPrintEnv
ppe Map TermReferenceId (Term Symbol Ann)
termsById = \case
  ReferenceBuiltin Text
builtin -> Text -> Hash
Synhash.synhashBuiltinTerm Text
builtin
  ReferenceDerived TermReferenceId
ref -> PrettyPrintEnv -> Term Symbol Ann -> Hash
forall v a. Var v => PrettyPrintEnv -> Term v a -> Hash
Synhash.synhashDerivedTerm PrettyPrintEnv
ppe (HasCallStack =>
TermReferenceId
-> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann
TermReferenceId
-> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann
expectTerm TermReferenceId
ref Map TermReferenceId (Term Symbol Ann)
termsById)

synhashDefnsWith ::
  (HasCallStack) =>
  (Name -> term -> Hash) ->
  (Name -> typ -> Hash) ->
  Defns (BiMultimap term Name) (BiMultimap typ Name) ->
  DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith :: forall term typ.
HasCallStack =>
(Name -> term -> Hash)
-> (Name -> typ -> Hash)
-> Defns (BiMultimap term Name) (BiMultimap typ Name)
-> DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith Name -> term -> Hash
hashTerm Name -> typ -> Hash
hashType = do
  (BiMultimap term Name -> Map Name (Synhashed term))
-> (BiMultimap typ Name -> Map Name (Synhashed typ))
-> Defns (BiMultimap term Name) (BiMultimap typ Name)
-> DefnsF2 (Map Name) Synhashed term typ
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
    ((Name -> term -> Synhashed term)
-> Map Name term -> Map Name (Synhashed term)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Name -> term -> Synhashed term
hashTerm1 (Map Name term -> Map Name (Synhashed term))
-> (BiMultimap term Name -> Map Name term)
-> BiMultimap term Name
-> Map Name (Synhashed term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BiMultimap term Name -> Map Name term
forall a b. BiMultimap a b -> Map b a
BiMultimap.range)
    ((Name -> typ -> Synhashed typ)
-> Map Name typ -> Map Name (Synhashed typ)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Name -> typ -> Synhashed typ
hashType1 (Map Name typ -> Map Name (Synhashed typ))
-> (BiMultimap typ Name -> Map Name typ)
-> BiMultimap typ Name
-> Map Name (Synhashed typ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BiMultimap typ Name -> Map Name typ
forall a b. BiMultimap a b -> Map b a
BiMultimap.range)
  where
    hashTerm1 :: Name -> term -> Synhashed term
hashTerm1 Name
name term
term =
      Hash -> term -> Synhashed term
forall a. Hash -> a -> Synhashed a
Synhashed (Name -> term -> Hash
hashTerm Name
name term
term) term
term

    hashType1 :: Name -> typ -> Synhashed typ
hashType1 Name
name typ
typ =
      Hash -> typ -> Synhashed typ
forall a. Hash -> a -> Synhashed a
Synhashed (Name -> typ -> Hash
hashType Name
name typ
typ) typ
typ

------------------------------------------------------------------------------------------------------------------------
-- Looking up terms and decls that we expect to be there

expectTerm :: (HasCallStack) => TermReferenceId -> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann
expectTerm :: HasCallStack =>
TermReferenceId
-> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann
expectTerm TermReferenceId
ref Map TermReferenceId (Term Symbol Ann)
termsById =
  case TermReferenceId
-> Map TermReferenceId (Term Symbol Ann) -> Maybe (Term Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReferenceId
ref Map TermReferenceId (Term Symbol Ann)
termsById of
    Maybe (Term Symbol Ann)
Nothing -> [Char] -> Term Symbol Ann
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E488229" ([Char]
"term ref " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TermReferenceId -> [Char]
forall a. Show a => a -> [Char]
show TermReferenceId
ref [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found in map " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Map TermReferenceId (Term Symbol Ann) -> [Char]
forall a. Show a => a -> [Char]
show Map TermReferenceId (Term Symbol Ann)
termsById))
    Just Term Symbol Ann
term -> Term Symbol Ann
term

expectDecl :: (HasCallStack) => TypeReferenceId -> Map TypeReferenceId (Decl Symbol Ann) -> Decl Symbol Ann
expectDecl :: HasCallStack =>
TermReferenceId
-> Map TermReferenceId (Decl Symbol Ann) -> Decl Symbol Ann
expectDecl TermReferenceId
ref Map TermReferenceId (Decl Symbol Ann)
declsById =
  case TermReferenceId
-> Map TermReferenceId (Decl Symbol Ann) -> Maybe (Decl Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReferenceId
ref Map TermReferenceId (Decl Symbol Ann)
declsById of
    Maybe (Decl Symbol Ann)
Nothing -> [Char] -> Decl Symbol Ann
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E663160" ([Char]
"type ref " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TermReferenceId -> [Char]
forall a. Show a => a -> [Char]
show TermReferenceId
ref [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found in map " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Map TermReferenceId (Decl Symbol Ann) -> [Char]
forall a. Show a => a -> [Char]
show Map TermReferenceId (Decl Symbol Ann)
declsById))
    Just Decl Symbol Ann
decl -> Decl Symbol Ann
decl