-- | @diff.update@ input handler - shows a preview of what `update` would change.
module Unison.Codebase.Editor.HandleInput.DiffUpdate
  ( handleDiffUpdate,
  )
where

import Control.Monad.Reader.Class (ask)
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import U.Codebase.Reference (TermReferenceId, TypeReferenceId)
import Unison.Cli.Monad (Cli, Env (..))
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.UpdateUtils (getNamespaceDependentsOf, hydrateRefs)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.Output qualified as Output
import Unison.DataDeclaration (Decl, DeclOrBuiltin)
import Unison.DeclCoherencyCheck qualified as DeclCoherencyCheck
import Unison.Name (Name)
import Unison.Names (Names (Names))
import Unison.Names qualified as Names
import Unison.OrBuiltin (OrBuiltin (..))
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Symbol (Symbol)
import Unison.Syntax.Name qualified as Name
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.UnconflictedLocalDefnsView (UnconflictedLocalDefnsView (..))
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defns (Defns (..), DefnsF)
import Unison.Util.Relation qualified as Relation

handleDiffUpdate :: Cli ()
handleDiffUpdate :: Cli ()
handleDiffUpdate = do
  Env
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  TypecheckedUnisonFile Symbol Ann
tuf <- Cli (TypecheckedUnisonFile Symbol Ann)
Cli.expectLatestTypecheckedFile
  Branch IO
currentBranch <- Cli (Branch IO)
Cli.getCurrentBranch
  let currentBranch0 :: Branch0 IO
currentBranch0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
currentBranch
  let namesIncludingLibdeps :: Names
namesIncludingLibdeps = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentBranch0

  -- Assert that the namespace doesn't have any conflicted names
  UnconflictedLocalDefnsView
unconflictedView <-
    Branch0 IO
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     UnconflictedLocalDefnsView
forall (m :: * -> *).
Branch0 m
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     UnconflictedLocalDefnsView
Branch.asUnconflicted Branch0 IO
currentBranch0
      Either
  (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
  UnconflictedLocalDefnsView
-> (Either
      (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
      UnconflictedLocalDefnsView
    -> Cli UnconflictedLocalDefnsView)
-> Cli UnconflictedLocalDefnsView
forall a b. a -> (a -> b) -> b
& (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
 -> Cli UnconflictedLocalDefnsView)
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     UnconflictedLocalDefnsView
-> Cli UnconflictedLocalDefnsView
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft (Output -> Cli UnconflictedLocalDefnsView
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli UnconflictedLocalDefnsView)
-> (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
    -> Output)
-> Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Cli UnconflictedLocalDefnsView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Output
Output.ConflictedDefn)

  -- Assert that the namespace doesn't have any incoherent decls
  DeclNameLookup
_declNameLookup <-
    ((forall void. Output -> Transaction void)
 -> Transaction DeclNameLookup)
-> Cli DeclNameLookup
forall a.
((forall void. Output -> Transaction void) -> Transaction a)
-> Cli a
Cli.runTransactionWithRollback \forall void. Output -> Transaction void
rollback -> do
      Codebase IO Symbol Ann
-> BranchHash
-> UnconflictedLocalDefnsView
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
forall (m :: * -> *) v a.
Codebase m v a
-> BranchHash
-> UnconflictedLocalDefnsView
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
Codebase.getBranchDeclNameLookup Env
env.codebase (Branch IO -> BranchHash
forall (m :: * -> *). Branch m -> BranchHash
Branch.namespaceHash Branch IO
currentBranch) UnconflictedLocalDefnsView
unconflictedView
        Transaction (Either IncoherentDeclReasons DeclNameLookup)
-> (Transaction (Either IncoherentDeclReasons DeclNameLookup)
    -> Transaction DeclNameLookup)
-> Transaction DeclNameLookup
forall a b. a -> (a -> b) -> b
& (IncoherentDeclReasons -> Transaction DeclNameLookup)
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
-> Transaction DeclNameLookup
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM (Output -> Transaction DeclNameLookup
forall void. Output -> Transaction void
rollback (Output -> Transaction DeclNameLookup)
-> (IncoherentDeclReasons -> Output)
-> IncoherentDeclReasons
-> Transaction DeclNameLookup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IncoherentDeclReason -> Output
Output.IncoherentDeclDuringUpdate (IncoherentDeclReason -> Output)
-> (IncoherentDeclReasons -> IncoherentDeclReason)
-> IncoherentDeclReasons
-> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IncoherentDeclReasons -> IncoherentDeclReason
DeclCoherencyCheck.asOneRandomIncoherentDeclReason)

  -- Get namespace bindings from the file (terms and types being added/updated)
  let namespaceBindings :: DefnsF Set Name Name
      namespaceBindings :: DefnsF Set Name Name
namespaceBindings =
        (Set Symbol -> Set Name)
-> (Set Symbol -> Set Name)
-> Defns (Set Symbol) (Set Symbol)
-> DefnsF Set Name 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 ((Symbol -> Name) -> Set Symbol -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar) ((Symbol -> Name) -> Set Symbol -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar) (TypecheckedUnisonFile Symbol Ann -> Defns (Set Symbol) (Set Symbol)
forall v a. Ord v => TypecheckedUnisonFile v a -> DefnsF Set v v
UF.namespaceBindings TypecheckedUnisonFile Symbol Ann
tuf)

  -- Compute new vs updated definitions
  let existingTermNames :: Set Name
existingTermNames = BiMultimap Referent Name -> Set Name
forall a b. BiMultimap a b -> Set b
BiMultimap.ran UnconflictedLocalDefnsView
unconflictedView.defns.terms
  let existingTypeNames :: Set Name
existingTypeNames = BiMultimap TypeReference Name -> Set Name
forall a b. BiMultimap a b -> Set b
BiMultimap.ran UnconflictedLocalDefnsView
unconflictedView.defns.types

  let newTermNames :: Set Name
newTermNames = Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.difference DefnsF Set Name Name
namespaceBindings.terms Set Name
existingTermNames
  let newTypeNames :: Set Name
newTypeNames = Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.difference DefnsF Set Name Name
namespaceBindings.types Set Name
existingTypeNames
  let updatedTermNames :: Set Name
updatedTermNames = Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection DefnsF Set Name Name
namespaceBindings.terms Set Name
existingTermNames
  let updatedTypeNames :: Set Name
updatedTypeNames = Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection DefnsF Set Name Name
namespaceBindings.types Set Name
existingTypeNames

  -- Get dependents that would need retypechecking
  DefnsF (Map Name) TermReferenceId TermReferenceId
dependents <-
    Transaction (DefnsF (Map Name) TermReferenceId TermReferenceId)
-> Cli (DefnsF (Map Name) TermReferenceId TermReferenceId)
forall a. Transaction a -> Cli a
Cli.runTransaction do
      DefnsF (Map Name) TermReferenceId TermReferenceId
dependents0 <-
        Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF Set TypeReference TypeReference
-> Transaction (DefnsF (Map Name) TermReferenceId TermReferenceId)
getNamespaceDependentsOf
          UnconflictedLocalDefnsView
unconflictedView.defns
          ( Names -> DefnsF Set TypeReference TypeReference
Names.references
              Names
                { $sel:terms:Names :: Relation Name Referent
terms = Set Name -> Relation Name Referent -> Relation Name Referent
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
Relation.restrictDom DefnsF Set Name Name
namespaceBindings.terms UnconflictedLocalDefnsView
unconflictedView.names.terms,
                  $sel:types:Names :: Relation Name TypeReference
types = Set Name
-> Relation Name TypeReference -> Relation Name TypeReference
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
Relation.restrictDom DefnsF Set Name Name
namespaceBindings.types UnconflictedLocalDefnsView
unconflictedView.names.types
                }
          )

      -- Remove dependents that are also being updated directly by the file,
      -- since they'll already appear in the "updated definitions" section
      let dependents1 :: DefnsF (Map Name) TermReferenceId TypeReferenceId
          dependents1 :: DefnsF (Map Name) TermReferenceId TermReferenceId
dependents1 =
            (Map Name TermReferenceId -> Map Name TermReferenceId)
-> (Map Name TermReferenceId -> Map Name TermReferenceId)
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> DefnsF (Map Name) 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
              (Map Name TermReferenceId -> Set Name -> Map Name TermReferenceId
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` DefnsF Set Name Name
namespaceBindings.terms)
              (Map Name TermReferenceId -> Set Name -> Map Name TermReferenceId
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` DefnsF Set Name Name
namespaceBindings.types)
              DefnsF (Map Name) TermReferenceId TermReferenceId
dependents0

      DefnsF (Map Name) TermReferenceId TermReferenceId
-> Transaction (DefnsF (Map Name) TermReferenceId TermReferenceId)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DefnsF (Map Name) TermReferenceId TermReferenceId
dependents1

  -- Get the terms (body + type + refId) for new and updated terms from the typechecked file
  -- hashTermsId returns: (ann, TermReferenceId, Maybe WatchKind, Term v a, Type v a)
  let fileTermsWithRefIds :: Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
      fileTermsWithRefIds :: Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
fileTermsWithRefIds =
        [(Name, (TermReferenceId, Term Symbol Ann, Type Symbol Ann))]
-> Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
var, (TermReferenceId
refId, Term Symbol Ann
term, Type Symbol Ann
typ))
            | (Symbol
var, (Ann
_, TermReferenceId
refId, Maybe WatchKind
_, Term Symbol Ann
term, Type Symbol Ann
typ)) <- Map
  Symbol
  (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
   Type Symbol Ann)
-> [(Symbol,
     (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
      Type Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
      Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, TermReferenceId, Maybe WatchKind, Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile Symbol Ann
tuf)
          ]

  let fileTerms :: Map Name (Term Symbol Ann, Type Symbol Ann)
      fileTerms :: Map Name (Term Symbol Ann, Type Symbol Ann)
fileTerms = ((TermReferenceId, Term Symbol Ann, Type Symbol Ann)
 -> (Term Symbol Ann, Type Symbol Ann))
-> Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
-> Map Name (Term Symbol Ann, Type Symbol Ann)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(TermReferenceId
_, Term Symbol Ann
term, Type Symbol Ann
typ) -> (Term Symbol Ann
term, Type Symbol Ann
typ)) Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
fileTermsWithRefIds

  let newTerms :: Map Name (Term Symbol Ann, Type Symbol Ann)
      newTerms :: Map Name (Term Symbol Ann, Type Symbol Ann)
newTerms = Map Name (Term Symbol Ann, Type Symbol Ann)
-> Set Name -> Map Name (Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Name (Term Symbol Ann, Type Symbol Ann)
fileTerms Set Name
newTermNames

  -- Terms from the file that are updates to existing codebase definitions (with new ref IDs)
  let updatedFileTerms :: Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
      updatedFileTerms :: Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
updatedFileTerms = Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
-> Set Name
-> Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
fileTermsWithRefIds Set Name
updatedTermNames

  -- Get the old terms from the codebase for updated definitions
  -- First, get the term reference IDs for the updated names
  let updatedTermRefIds :: Map Name TermReferenceId
      updatedTermRefIds :: Map Name TermReferenceId
updatedTermRefIds =
        [(Name, TermReferenceId)] -> Map Name TermReferenceId
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (Name
name, TermReferenceId
refId)
            | Name
name <- Set Name -> [Name]
forall a. Set a -> [a]
Set.toList Set Name
updatedTermNames,
              Just Referent
referent <- [Name -> Map Name Referent -> Maybe Referent
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (BiMultimap Referent Name -> Map Name Referent
forall a b. BiMultimap a b -> Map b a
BiMultimap.range UnconflictedLocalDefnsView
unconflictedView.defns.terms)],
              Just TermReferenceId
refId <- [Referent -> Maybe TermReferenceId
Referent.toTermReferenceId Referent
referent]
          ]

  -- Fetch the old terms from the codebase
  Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)
oldTerms <- Transaction
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
-> Cli (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction do
    let refIdSet :: Set TermReferenceId
refIdSet = [TermReferenceId] -> Set TermReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList (Map Name TermReferenceId -> [TermReferenceId]
forall k a. Map k a -> [a]
Map.elems Map Name TermReferenceId
updatedTermRefIds)
    Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedTerms <- Codebase IO Symbol Ann
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
forall (m :: * -> *) v a.
Codebase m v a
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction
     (Defns
        (Map TermReferenceId (Term v a, Type v a))
        (Map TermReferenceId (Decl v a)))
hydrateRefs Env
env.codebase (Set TermReferenceId
-> Set TermReferenceId
-> DefnsF Set TermReferenceId TermReferenceId
forall terms types. terms -> types -> Defns terms types
Defns Set TermReferenceId
refIdSet Set TermReferenceId
forall a. Set a
Set.empty)
    Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)
-> Transaction
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedTerms.terms

  -- Intersect old and new terms to find updated definitions
  -- Only include terms where the reference ID actually changed
  let updatedTerms :: Map Name ((Term Symbol Ann, Type Symbol Ann), (Term Symbol Ann, Type Symbol Ann))
      updatedTerms :: Map
  Name
  ((Term Symbol Ann, Type Symbol Ann),
   (Term Symbol Ann, Type Symbol Ann))
updatedTerms =
        (Maybe
   ((Term Symbol Ann, Type Symbol Ann),
    (Term Symbol Ann, Type Symbol Ann))
 -> Maybe
      ((Term Symbol Ann, Type Symbol Ann),
       (Term Symbol Ann, Type Symbol Ann)))
-> Map
     Name
     (Maybe
        ((Term Symbol Ann, Type Symbol Ann),
         (Term Symbol Ann, Type Symbol Ann)))
-> Map
     Name
     ((Term Symbol Ann, Type Symbol Ann),
      (Term Symbol Ann, Type Symbol Ann))
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe
  ((Term Symbol Ann, Type Symbol Ann),
   (Term Symbol Ann, Type Symbol Ann))
-> Maybe
     ((Term Symbol Ann, Type Symbol Ann),
      (Term Symbol Ann, Type Symbol Ann))
forall a. a -> a
id (Map
   Name
   (Maybe
      ((Term Symbol Ann, Type Symbol Ann),
       (Term Symbol Ann, Type Symbol Ann)))
 -> Map
      Name
      ((Term Symbol Ann, Type Symbol Ann),
       (Term Symbol Ann, Type Symbol Ann)))
-> Map
     Name
     (Maybe
        ((Term Symbol Ann, Type Symbol Ann),
         (Term Symbol Ann, Type Symbol Ann)))
-> Map
     Name
     ((Term Symbol Ann, Type Symbol Ann),
      (Term Symbol Ann, Type Symbol Ann))
forall a b. (a -> b) -> a -> b
$
          (TermReferenceId
 -> (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
 -> Maybe
      ((Term Symbol Ann, Type Symbol Ann),
       (Term Symbol Ann, Type Symbol Ann)))
-> Map Name TermReferenceId
-> Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
-> Map
     Name
     (Maybe
        ((Term Symbol Ann, Type Symbol Ann),
         (Term Symbol Ann, Type Symbol Ann)))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
            ( \TermReferenceId
oldRefId (TermReferenceId
newRefId, Term Symbol Ann
newTerm, Type Symbol Ann
newTyp) ->
                -- Skip terms where the hash hasn't changed (they're not actually updated)
                if TermReferenceId
oldRefId TermReferenceId -> TermReferenceId -> Bool
forall a. Eq a => a -> a -> Bool
== TermReferenceId
newRefId
                  then Maybe
  ((Term Symbol Ann, Type Symbol Ann),
   (Term Symbol Ann, Type Symbol Ann))
forall a. Maybe a
Nothing
                  else case TermReferenceId
-> Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)
-> Maybe (Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReferenceId
oldRefId Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)
oldTerms of
                    Just (Term Symbol Ann, Type Symbol Ann)
oldTerm -> ((Term Symbol Ann, Type Symbol Ann),
 (Term Symbol Ann, Type Symbol Ann))
-> Maybe
     ((Term Symbol Ann, Type Symbol Ann),
      (Term Symbol Ann, Type Symbol Ann))
forall a. a -> Maybe a
Just ((Term Symbol Ann, Type Symbol Ann)
oldTerm, (Term Symbol Ann
newTerm, Type Symbol Ann
newTyp))
                    Maybe (Term Symbol Ann, Type Symbol Ann)
Nothing -> Maybe
  ((Term Symbol Ann, Type Symbol Ann),
   (Term Symbol Ann, Type Symbol Ann))
forall a. Maybe a
Nothing
            )
            Map Name TermReferenceId
updatedTermRefIds
            Map Name (TermReferenceId, Term Symbol Ann, Type Symbol Ann)
updatedFileTerms

  -- Get type declarations from the file (including reference IDs)
  let fileDataDecls :: Map Name (DeclOrBuiltin Symbol Ann)
      fileDataDecls :: Map Name (DeclOrBuiltin Symbol Ann)
fileDataDecls =
        [(Name, DeclOrBuiltin Symbol Ann)]
-> Map Name (DeclOrBuiltin Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
var, Decl Symbol Ann -> DeclOrBuiltin Symbol Ann
forall a b. b -> OrBuiltin a b
NotBuiltin (DataDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. b -> Either a b
Right DataDeclaration Symbol Ann
decl))
            | (Symbol
var, (TermReferenceId
_, DataDeclaration Symbol Ann
decl)) <- Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile Symbol Ann
tuf)
          ]

  let fileEffectDecls :: Map Name (DeclOrBuiltin Symbol Ann)
      fileEffectDecls :: Map Name (DeclOrBuiltin Symbol Ann)
fileEffectDecls =
        [(Name, DeclOrBuiltin Symbol Ann)]
-> Map Name (DeclOrBuiltin Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
var, Decl Symbol Ann -> DeclOrBuiltin Symbol Ann
forall a b. b -> OrBuiltin a b
NotBuiltin (EffectDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. a -> Either a b
Left EffectDeclaration Symbol Ann
decl))
            | (Symbol
var, (TermReferenceId
_, EffectDeclaration Symbol Ann
decl)) <- Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile Symbol Ann
tuf)
          ]

  let fileTypeDecls :: Map Name (DeclOrBuiltin Symbol Ann)
      fileTypeDecls :: Map Name (DeclOrBuiltin Symbol Ann)
fileTypeDecls = Map Name (DeclOrBuiltin Symbol Ann)
-> Map Name (DeclOrBuiltin Symbol Ann)
-> Map Name (DeclOrBuiltin Symbol Ann)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Name (DeclOrBuiltin Symbol Ann)
fileDataDecls Map Name (DeclOrBuiltin Symbol Ann)
fileEffectDecls

  -- File types with their reference IDs (for updated types rendering)
  let fileTypeDeclsWithRefIds :: Map Name (TypeReferenceId, Decl Symbol Ann)
      fileTypeDeclsWithRefIds :: Map Name (TermReferenceId, Decl Symbol Ann)
fileTypeDeclsWithRefIds =
        [(Name, (TermReferenceId, Decl Symbol Ann))]
-> Map Name (TermReferenceId, Decl Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, (TermReferenceId, Decl Symbol Ann))]
 -> Map Name (TermReferenceId, Decl Symbol Ann))
-> [(Name, (TermReferenceId, Decl Symbol Ann))]
-> Map Name (TermReferenceId, Decl Symbol Ann)
forall a b. (a -> b) -> a -> b
$
          [ (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
var, (TermReferenceId
refId, DataDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. b -> Either a b
Right DataDeclaration Symbol Ann
decl))
            | (Symbol
var, (TermReferenceId
refId, DataDeclaration Symbol Ann
decl)) <- Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile Symbol Ann
tuf)
          ]
            [(Name, (TermReferenceId, Decl Symbol Ann))]
-> [(Name, (TermReferenceId, Decl Symbol Ann))]
-> [(Name, (TermReferenceId, Decl Symbol Ann))]
forall a. [a] -> [a] -> [a]
++ [ (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
var, (TermReferenceId
refId, EffectDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. a -> Either a b
Left EffectDeclaration Symbol Ann
decl))
                 | (Symbol
var, (TermReferenceId
refId, EffectDeclaration Symbol Ann
decl)) <- Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile Symbol Ann
tuf)
               ]

  let newTypes :: Map Name (DeclOrBuiltin Symbol Ann)
      newTypes :: Map Name (DeclOrBuiltin Symbol Ann)
newTypes = Map Name (DeclOrBuiltin Symbol Ann)
-> Set Name -> Map Name (DeclOrBuiltin Symbol Ann)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Name (DeclOrBuiltin Symbol Ann)
fileTypeDecls Set Name
newTypeNames

  -- Types from the file that are updates to existing codebase definitions
  let updatedFileTypes :: Map Name (TypeReferenceId, Decl Symbol Ann)
      updatedFileTypes :: Map Name (TermReferenceId, Decl Symbol Ann)
updatedFileTypes = Map Name (TermReferenceId, Decl Symbol Ann)
-> Set Name -> Map Name (TermReferenceId, Decl Symbol Ann)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Name (TermReferenceId, Decl Symbol Ann)
fileTypeDeclsWithRefIds Set Name
updatedTypeNames

  -- Get the old types from the codebase for updated definitions
  -- First, get the type reference IDs for the updated names
  let updatedTypeRefIds :: Map Name TypeReferenceId
      updatedTypeRefIds :: Map Name TermReferenceId
updatedTypeRefIds =
        [(Name, TermReferenceId)] -> Map Name TermReferenceId
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (Name
name, TermReferenceId
refId)
            | Name
name <- Set Name -> [Name]
forall a. Set a -> [a]
Set.toList Set Name
updatedTypeNames,
              Just TypeReference
typeRef <- [Name -> Map Name TypeReference -> Maybe TypeReference
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (BiMultimap TypeReference Name -> Map Name TypeReference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range UnconflictedLocalDefnsView
unconflictedView.defns.types)],
              Just TermReferenceId
refId <- [TypeReference -> Maybe TermReferenceId
Reference.toId TypeReference
typeRef]
          ]

  -- Fetch the old types from the codebase
  Map TermReferenceId (Decl Symbol Ann)
oldTypes <- Transaction (Map TermReferenceId (Decl Symbol Ann))
-> Cli (Map TermReferenceId (Decl Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction do
    let refIdSet :: Set TermReferenceId
refIdSet = [TermReferenceId] -> Set TermReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList (Map Name TermReferenceId -> [TermReferenceId]
forall k a. Map k a -> [a]
Map.elems Map Name TermReferenceId
updatedTypeRefIds)
    Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedTypes <- Codebase IO Symbol Ann
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
forall (m :: * -> *) v a.
Codebase m v a
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction
     (Defns
        (Map TermReferenceId (Term v a, Type v a))
        (Map TermReferenceId (Decl v a)))
hydrateRefs Env
env.codebase (Set TermReferenceId
-> Set TermReferenceId
-> DefnsF Set TermReferenceId TermReferenceId
forall terms types. terms -> types -> Defns terms types
Defns Set TermReferenceId
forall a. Set a
Set.empty Set TermReferenceId
refIdSet)
    Map TermReferenceId (Decl Symbol Ann)
-> Transaction (Map TermReferenceId (Decl Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedTypes.types

  -- Intersect old and new types to find updated definitions
  -- Only include types where the reference ID actually changed
  -- Result: Map Name ((old refId, old decl), (new refId, new decl))
  let updatedTypes :: Map Name ((TypeReferenceId, Decl Symbol Ann), (TypeReferenceId, Decl Symbol Ann))
      updatedTypes :: Map
  Name
  ((TermReferenceId, Decl Symbol Ann),
   (TermReferenceId, Decl Symbol Ann))
updatedTypes =
        (Maybe
   ((TermReferenceId, Decl Symbol Ann),
    (TermReferenceId, Decl Symbol Ann))
 -> Maybe
      ((TermReferenceId, Decl Symbol Ann),
       (TermReferenceId, Decl Symbol Ann)))
-> Map
     Name
     (Maybe
        ((TermReferenceId, Decl Symbol Ann),
         (TermReferenceId, Decl Symbol Ann)))
-> Map
     Name
     ((TermReferenceId, Decl Symbol Ann),
      (TermReferenceId, Decl Symbol Ann))
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe
  ((TermReferenceId, Decl Symbol Ann),
   (TermReferenceId, Decl Symbol Ann))
-> Maybe
     ((TermReferenceId, Decl Symbol Ann),
      (TermReferenceId, Decl Symbol Ann))
forall a. a -> a
id (Map
   Name
   (Maybe
      ((TermReferenceId, Decl Symbol Ann),
       (TermReferenceId, Decl Symbol Ann)))
 -> Map
      Name
      ((TermReferenceId, Decl Symbol Ann),
       (TermReferenceId, Decl Symbol Ann)))
-> Map
     Name
     (Maybe
        ((TermReferenceId, Decl Symbol Ann),
         (TermReferenceId, Decl Symbol Ann)))
-> Map
     Name
     ((TermReferenceId, Decl Symbol Ann),
      (TermReferenceId, Decl Symbol Ann))
forall a b. (a -> b) -> a -> b
$
          (TermReferenceId
 -> (TermReferenceId, Decl Symbol Ann)
 -> Maybe
      ((TermReferenceId, Decl Symbol Ann),
       (TermReferenceId, Decl Symbol Ann)))
-> Map Name TermReferenceId
-> Map Name (TermReferenceId, Decl Symbol Ann)
-> Map
     Name
     (Maybe
        ((TermReferenceId, Decl Symbol Ann),
         (TermReferenceId, Decl Symbol Ann)))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
            ( \TermReferenceId
oldRefId (TermReferenceId
newRefId, Decl Symbol Ann
newDecl) ->
                -- Skip types where the hash hasn't changed (they're not actually updated)
                if TermReferenceId
oldRefId TermReferenceId -> TermReferenceId -> Bool
forall a. Eq a => a -> a -> Bool
== TermReferenceId
newRefId
                  then Maybe
  ((TermReferenceId, Decl Symbol Ann),
   (TermReferenceId, Decl Symbol Ann))
forall a. Maybe a
Nothing
                  else 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
oldRefId Map TermReferenceId (Decl Symbol Ann)
oldTypes of
                    Just Decl Symbol Ann
oldDecl -> ((TermReferenceId, Decl Symbol Ann),
 (TermReferenceId, Decl Symbol Ann))
-> Maybe
     ((TermReferenceId, Decl Symbol Ann),
      (TermReferenceId, Decl Symbol Ann))
forall a. a -> Maybe a
Just ((TermReferenceId
oldRefId, Decl Symbol Ann
oldDecl), (TermReferenceId
newRefId, Decl Symbol Ann
newDecl))
                    Maybe (Decl Symbol Ann)
Nothing -> Maybe
  ((TermReferenceId, Decl Symbol Ann),
   (TermReferenceId, Decl Symbol Ann))
forall a. Maybe a
Nothing
            )
            Map Name TermReferenceId
updatedTypeRefIds
            Map Name (TermReferenceId, Decl Symbol Ann)
updatedFileTypes

  -- Build the PPEs:
  -- - ppedNew: for new definitions (file names shadowing namespace names)
  -- - ppedOld: for old definitions (just namespace names, so old refs resolve properly)
  let fileNames :: Names
fileNames = TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames TypecheckedUnisonFile Symbol Ann
tuf
  let allNames :: Names
allNames = Names
fileNames Names -> Names -> Names
`Names.shadowing` Names
namesIncludingLibdeps
  let ppedNew :: PrettyPrintEnvDecl
ppedNew =
        Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED
          (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
allNames)
          (Names -> Suffixifier
PPE.suffixifyByHash Names
allNames)
  let ppedOld :: PrettyPrintEnvDecl
ppedOld =
        Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED
          (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
namesIncludingLibdeps)
          (Names -> Suffixifier
PPE.suffixifyByHash Names
namesIncludingLibdeps)

  -- Respond with the diff
  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$
    PrettyPrintEnvDecl
-> PrettyPrintEnvDecl
-> Defns
     (Map Name (Term Symbol Ann, Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann))
-> Defns
     (Map
        Name
        ((Term Symbol Ann, Type Symbol Ann),
         (Term Symbol Ann, Type Symbol Ann)))
     (Map
        Name
        ((TermReferenceId, Decl Symbol Ann),
         (TermReferenceId, Decl Symbol Ann)))
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> Output
Output.ShowUpdateDiff
      PrettyPrintEnvDecl
ppedNew
      PrettyPrintEnvDecl
ppedOld
      Defns {$sel:terms:Defns :: Map Name (Term Symbol Ann, Type Symbol Ann)
terms = Map Name (Term Symbol Ann, Type Symbol Ann)
newTerms, $sel:types:Defns :: Map Name (DeclOrBuiltin Symbol Ann)
types = Map Name (DeclOrBuiltin Symbol Ann)
newTypes}
      Defns {$sel:terms:Defns :: Map
  Name
  ((Term Symbol Ann, Type Symbol Ann),
   (Term Symbol Ann, Type Symbol Ann))
terms = Map
  Name
  ((Term Symbol Ann, Type Symbol Ann),
   (Term Symbol Ann, Type Symbol Ann))
updatedTerms, $sel:types:Defns :: Map
  Name
  ((TermReferenceId, Decl Symbol Ann),
   (TermReferenceId, Decl Symbol Ann))
types = Map
  Name
  ((TermReferenceId, Decl Symbol Ann),
   (TermReferenceId, Decl Symbol Ann))
updatedTypes}
      DefnsF (Map Name) TermReferenceId TermReferenceId
dependents